aboutsummaryrefslogtreecommitdiff
path: root/sys/fio
diff options
context:
space:
mode:
Diffstat (limited to 'sys/fio')
-rw-r--r--sys/fio/README10
-rw-r--r--sys/fio/access.x58
-rw-r--r--sys/fio/aread.x24
-rw-r--r--sys/fio/areadb.x83
-rw-r--r--sys/fio/await.x56
-rw-r--r--sys/fio/awaitb.x39
-rw-r--r--sys/fio/awrite.x24
-rw-r--r--sys/fio/awriteb.x90
-rw-r--r--sys/fio/close.x70
-rw-r--r--sys/fio/delete.x110
-rw-r--r--sys/fio/deletefg.x37
-rw-r--r--sys/fio/diropen.x289
-rw-r--r--sys/fio/doc/fio.hd54
-rw-r--r--sys/fio/doc/fio.hlp1912
-rw-r--r--sys/fio/doc/fio.men50
-rw-r--r--sys/fio/doc/vfn.hlp1028
-rw-r--r--sys/fio/falloc.x73
-rw-r--r--sys/fio/fcache.x733
-rw-r--r--sys/fio/fcanpb.x39
-rw-r--r--sys/fio/fchdir.x57
-rw-r--r--sys/fio/fclobber.x42
-rw-r--r--sys/fio/fcopy.x83
-rw-r--r--sys/fio/fdebug.x163
-rw-r--r--sys/fio/fdevbf.x37
-rw-r--r--sys/fio/fdevblk.x42
-rw-r--r--sys/fio/fdevtx.x39
-rw-r--r--sys/fio/fdirname.x46
-rw-r--r--sys/fio/fexbuf.x46
-rw-r--r--sys/fio/ffault.x127
-rw-r--r--sys/fio/ffilbf.x37
-rw-r--r--sys/fio/ffilsz.x54
-rw-r--r--sys/fio/fflsbf.x27
-rw-r--r--sys/fio/fgdevpar.x88
-rw-r--r--sys/fio/fgetfd.x135
-rw-r--r--sys/fio/filbuf.x113
-rw-r--r--sys/fio/filerr.x16
-rw-r--r--sys/fio/filopn.x164
-rw-r--r--sys/fio/finfo.x46
-rw-r--r--sys/fio/finit.x70
-rw-r--r--sys/fio/fioclean.x130
-rw-r--r--sys/fio/flsbuf.x69
-rw-r--r--sys/fio/flush.x59
-rw-r--r--sys/fio/fmapfn.x47
-rw-r--r--sys/fio/fmkbfs.x61
-rw-r--r--sys/fio/fmkcopy.x92
-rw-r--r--sys/fio/fmkdir.x60
-rw-r--r--sys/fio/fmkpbbuf.x34
-rw-r--r--sys/fio/fnextn.x21
-rw-r--r--sys/fio/fnldir.x22
-rw-r--r--sys/fio/fnroot.x21
-rw-r--r--sys/fio/fntgfn.x1004
-rw-r--r--sys/fio/fnullfile.x38
-rw-r--r--sys/fio/fopnbf.x16
-rw-r--r--sys/fio/fopntx.x16
-rw-r--r--sys/fio/fowner.x20
-rw-r--r--sys/fio/fpathname.x38
-rw-r--r--sys/fio/fputtx.x22
-rw-r--r--sys/fio/freadp.x55
-rw-r--r--sys/fio/fredir.x62
-rw-r--r--sys/fio/frename.x122
-rw-r--r--sys/fio/frmbfs.x38
-rw-r--r--sys/fio/frmdir.x48
-rw-r--r--sys/fio/frtnfd.x19
-rw-r--r--sys/fio/fseti.x403
-rw-r--r--sys/fio/fsfopen.x82
-rw-r--r--sys/fio/fstati.x147
-rw-r--r--sys/fio/fstatl.x31
-rw-r--r--sys/fio/fstats.x29
-rw-r--r--sys/fio/fstdfile.x37
-rw-r--r--sys/fio/fstrfp.x27
-rw-r--r--sys/fio/fsvtfn.x81
-rw-r--r--sys/fio/fswapfd.x37
-rw-r--r--sys/fio/fsymlink.x53
-rw-r--r--sys/fio/funlink.x33
-rw-r--r--sys/fio/futime.x34
-rw-r--r--sys/fio/fwatio.x50
-rw-r--r--sys/fio/fwritep.x63
-rw-r--r--sys/fio/fwtacc.x120
-rw-r--r--sys/fio/getc.x27
-rw-r--r--sys/fio/getchar.x12
-rw-r--r--sys/fio/getci.x27
-rw-r--r--sys/fio/getline.x85
-rw-r--r--sys/fio/getlline.x42
-rw-r--r--sys/fio/glongline.x73
-rw-r--r--sys/fio/isdir.x73
-rw-r--r--sys/fio/mkpkg123
-rw-r--r--sys/fio/mktemp.x48
-rw-r--r--sys/fio/mmap.inc8
-rw-r--r--sys/fio/ndopen.x94
-rw-r--r--sys/fio/note.x29
-rw-r--r--sys/fio/nowhite.x35
-rw-r--r--sys/fio/nullfile.x251
-rw-r--r--sys/fio/open.x99
-rw-r--r--sys/fio/osfnlock.x417
-rw-r--r--sys/fio/poll.x250
-rw-r--r--sys/fio/protect.x61
-rw-r--r--sys/fio/putc.x38
-rw-r--r--sys/fio/putcc.x25
-rw-r--r--sys/fio/putci.x26
-rw-r--r--sys/fio/putline.x101
-rw-r--r--sys/fio/read.x62
-rw-r--r--sys/fio/rename.x38
-rw-r--r--sys/fio/reopen.x55
-rw-r--r--sys/fio/seek.x69
-rw-r--r--sys/fio/stropen.x151
-rw-r--r--sys/fio/ungetc.x69
-rw-r--r--sys/fio/ungetci.x69
-rw-r--r--sys/fio/ungetline.x75
-rw-r--r--sys/fio/unread.x65
-rw-r--r--sys/fio/vfnmap.x899
-rw-r--r--sys/fio/vfntrans.x937
-rw-r--r--sys/fio/write.x40
-rw-r--r--sys/fio/xerputc.x37
-rw-r--r--sys/fio/zfiott.com35
-rw-r--r--sys/fio/zfiott.x1256
-rw-r--r--sys/fio/zzdebug.x625
116 files changed, 15978 insertions, 0 deletions
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