From 40e5a5811c6ffce9b0974e93cdd927cbcf60c157 Mon Sep 17 00:00:00 2001
From: Joe Hunkeler <jhunkeler@gmail.com>
Date: Tue, 11 Aug 2015 16:51:37 -0400
Subject: Repatch (from linux) of OSX IRAF

---
 sys/fio/close.x | 70 +++++++++++++++++++++++++++++++++++++++++++++++++++++++++
 1 file changed, 70 insertions(+)
 create mode 100644 sys/fio/close.x

(limited to 'sys/fio/close.x')

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
-- 
cgit