Repatch (from linux) of OSX IRAF

11 files changed, 327 insertions, 0 deletions

diff --git a/sys/imio/iki/plf/README b/sys/imio/iki/plf/README
new file mode 100644
index 00000000..0a2065c7
--- /dev/null
+++ b/sys/imio/iki/plf/README
@@ -0,0 +1,5 @@
+PLF -- Partial, IKI mini-driver for the pixel list (PLIO) image format.
+
+Only part of the IKI routines are implemented here.  The open/close, header
+access, and i/o functions are handled as a special case directly in the
+IMIO code (see the impm*.x routines, and im[rd|wr]px.x).
diff --git a/sys/imio/iki/plf/mkpkg b/sys/imio/iki/plf/mkpkg
new file mode 100644
index 00000000..4253544e
--- /dev/null
+++ b/sys/imio/iki/plf/mkpkg
@@ -0,0 +1,17 @@
+# Make the PLF image kernel (PLIO mask image kernel).
+
+$checkout libex.a lib$
+$update   libex.a
+$checkin  libex.a lib$
+$exit
+
+libex.a:
+	plfaccess.x	plf.h
+	plfclose.x	<imhdr.h> <imio.h> <plset.h>
+	plfcopy.x	plf.h <error.h>
+	plfdelete.x	<error.h>
+	plfnull.x	
+	plfopen.x	<imhdr.h> <imio.h> <plio.h> <pmset.h>
+	plfrename.x	plf.h <error.h>
+	plfupdhdr.x	<imhdr.h> <imio.h> <plset.h>
+	;
diff --git a/sys/imio/iki/plf/plf.h b/sys/imio/iki/plf/plf.h
new file mode 100644
index 00000000..7fc666a9
--- /dev/null
+++ b/sys/imio/iki/plf/plf.h
@@ -0,0 +1,4 @@
+# PLF.H -- IKI/PLF internal definitions.
+
+define	PLF_EXTN	"pl"		# image header filename extension
+define	MAX_LENEXTN	3		# max length imagefile extension
diff --git a/sys/imio/iki/plf/plfaccess.x b/sys/imio/iki/plf/plfaccess.x
new file mode 100644
index 00000000..bf4ed5a9
--- /dev/null
+++ b/sys/imio/iki/plf/plfaccess.x
@@ -0,0 +1,44 @@
+# Copyright(c) 1986 Association of Universities for Research in Astronomy Inc.
+
+include	"plf.h"
+
+# PLF_ACCESS -- Test the accessibility or existence of an existing image,
+# or the legality of the name of a new image.
+
+procedure plf_access (kernel, root, extn, acmode, status)
+
+int	kernel			#I IKI kernel
+char	root[ARB]		#I root filename
+char	extn[ARB]		#U extension (SET on output if none specified)
+int	acmode			#I access mode (0 to test only existence)
+int	status			#O ok or err
+
+pointer	sp, fname
+int	btoi(), access(), iki_validextn()
+string	plf_extn PLF_EXTN
+
+begin
+	call smark (sp)
+	call salloc (fname, SZ_PATHNAME, TY_CHAR)
+
+	# If new image, test only the legality of the given extension.
+	# This is used to select a kernel given the imagefile extension.
+
+	status = NO
+	if (extn[1] != EOS)
+	    status = btoi (iki_validextn (kernel, extn) > 0)
+
+	if (acmode != NEW_IMAGE && acmode != NEW_COPY) {
+	    if (extn[1] == EOS) {
+		call iki_mkfname (root, plf_extn, Memc[fname], SZ_PATHNAME)
+		status = access (Memc[fname], acmode, 0)
+		if (status != NO)
+		    call strcpy (plf_extn, extn, MAX_LENEXTN)
+	    } else if (status != NO) {
+		call iki_mkfname (root, extn, Memc[fname], SZ_PATHNAME)
+		status = access (Memc[fname], acmode, 0)
+	    }
+	}
+
+	call sfree (sp)
+end
diff --git a/sys/imio/iki/plf/plfclose.x b/sys/imio/iki/plf/plfclose.x
new file mode 100644
index 00000000..2d2454e0
--- /dev/null
+++ b/sys/imio/iki/plf/plfclose.x
@@ -0,0 +1,21 @@
+# Copyright(c) 1986 Association of Universities for Research in Astronomy Inc.
+
+include <imhdr.h>
+include <imio.h>
+include <plset.h>
+
+# PLF_CLOSE -- Close a mask image.
+
+procedure plf_close (im, status)
+
+pointer	im			#I image descriptor
+int	status			#O output status
+
+begin
+	if (IM_PFD(im) != NULL)
+	    call close (IM_PFD(im))
+	if (and (IM_PLFLAGS(im), PL_CLOSEPL) != 0)
+	    call pl_close (IM_PL(im))
+
+	IM_PL(im) = NULL
+end
diff --git a/sys/imio/iki/plf/plfcopy.x b/sys/imio/iki/plf/plfcopy.x
new file mode 100644
index 00000000..4cfb2b6e
--- /dev/null
+++ b/sys/imio/iki/plf/plfcopy.x
@@ -0,0 +1,38 @@
+# Copyright(c) 1986 Association of Universities for Research in Astronomy Inc.
+
+include	<error.h>
+include	"plf.h"
+
+# PLF_COPY -- Copy an image.  A special operator is provided for fast, blind
+# copies of entire images.
+
+procedure plf_copy (kernel, old_root, old_extn, new_root, new_extn, status)
+
+int	kernel			#I IKI kernel
+char	old_root[ARB]		#I old image root name
+char	old_extn[ARB]		#I old image extn
+char	new_root[ARB]		#I new image root name
+char	new_extn[ARB]		#I new extn
+int	status			#O output status
+
+pointer	sp
+pointer	oldname, newname
+
+begin
+	call smark (sp)
+	call salloc (oldname, SZ_PATHNAME, TY_CHAR)
+	call salloc (newname, SZ_PATHNAME, TY_CHAR)
+
+	# Get filename of old and new images.
+	call iki_mkfname (old_root, old_extn, Memc[oldname], SZ_PATHNAME)
+	call iki_mkfname (new_root, PLF_EXTN, Memc[newname], SZ_PATHNAME)
+
+	# Copy the PLIO mask save file.
+	iferr (call fcopy (Memc[oldname], Memc[newname])) {
+	    call erract (EA_WARN)
+	    status = ERR
+	} else
+	    status = OK
+
+	call sfree (sp)
+end
diff --git a/sys/imio/iki/plf/plfdelete.x b/sys/imio/iki/plf/plfdelete.x
new file mode 100644
index 00000000..4fad68aa
--- /dev/null
+++ b/sys/imio/iki/plf/plfdelete.x
@@ -0,0 +1,29 @@
+# Copyright(c) 1986 Association of Universities for Research in Astronomy Inc.
+
+include	<error.h>
+
+# PLF_DELETE -- Delete a PLIO mask savefile (mask image).
+
+procedure plf_delete (kernel, root, extn, status)
+
+int	kernel			#I IKI kernel
+char	root[ARB]		#I root filename
+char	extn[ARB]		#I extension
+int	status			#O output status
+
+pointer	sp, fname
+errchk	delete
+
+begin
+	call smark (sp)
+	call salloc (fname, SZ_PATHNAME, TY_CHAR)
+
+	call iki_mkfname (root, extn, Memc[fname], SZ_PATHNAME)
+	iferr (call delete (Memc[fname])) {
+	    call erract (EA_WARN)
+	    status = ERR
+	} else
+	    status = OK
+
+	call sfree (sp)
+end
diff --git a/sys/imio/iki/plf/plfnull.x b/sys/imio/iki/plf/plfnull.x
new file mode 100644
index 00000000..83ec77cd
--- /dev/null
+++ b/sys/imio/iki/plf/plfnull.x
@@ -0,0 +1,9 @@
+# Copyright(c) 1986 Association of Universities for Research in Astronomy Inc.
+
+# PLF_NULL -- Null driver entry point.
+
+procedure plf_null()
+
+begin
+	call error (1, "PLF image kernel abort - null driver entry point")
+end
diff --git a/sys/imio/iki/plf/plfopen.x b/sys/imio/iki/plf/plfopen.x
new file mode 100644
index 00000000..ec65d647
--- /dev/null
+++ b/sys/imio/iki/plf/plfopen.x
@@ -0,0 +1,90 @@
+# Copyright(c) 1986 Association of Universities for Research in Astronomy Inc.
+
+include	<syserr.h>
+include	<imhdr.h>
+include	<imio.h>
+include	<pmset.h>
+include	<plio.h>
+
+
+# PLF_OPEN -- Open a PMIO mask on an image descriptor.
+
+procedure plf_open (kernel, im, o_im,
+	root, extn, ksection, cl_index, cl_size, acmode, status)
+
+int	kernel			#I IKI kernel
+pointer	im			#I image descriptor
+pointer	o_im			#I [not used]
+char	root[ARB]		#I root image name
+char	extn[ARB]		#I filename extension
+char	ksection[ARB]		#I QPIO filter expression
+int	cl_index		#I [not used]
+int	cl_size			#I [not used]
+int	acmode			#I [not used]
+int	status			#O ok|err
+
+pointer	sp, fname, hp, pl
+int	naxes, axlen[IM_MAXDIM], depth
+bool	envgetb(), fnullfile()
+pointer	pl_open()
+int	access()
+errchk	imerr
+
+begin
+	call smark (sp)
+	call salloc (fname, SZ_PATHNAME, TY_CHAR)
+	call salloc (hp, IM_LENHDRMEM(im), TY_CHAR)
+
+	# The only valid cl_index for a PL image is -1 (none specified) or 1.
+	if (!(cl_index < 0 || cl_index == 1)) {
+	    call sfree (sp)
+	    status = ERR
+	    return
+	}
+
+	# Get mask file name.
+	call iki_mkfname (root, extn, Memc[fname], SZ_PATHNAME)
+	call aclrc (IM_HDRFILE(im), SZ_IMHDRFILE)
+	call strcpy (Memc[fname], IM_HDRFILE(im), SZ_IMHDRFILE)
+
+	# Open an empty mask.
+	pl = pl_open (NULL)
+
+	if (acmode == NEW_IMAGE || acmode == NEW_COPY) {
+	    # Check that we will not be clobbering an existing mask.
+	    if (!fnullfile(Memc[fname]) && access (Memc[fname], 0, 0) == YES)
+		if (envgetb ("imclobber")) {
+		    iferr (call delete (Memc[fname]))
+			;
+		} else {
+		    call pl_close (pl)
+		    call imerr (IM_NAME(im), SYS_IKICLOB)
+		}
+	} else {
+	    # Load the named mask if opening an existing mask image.
+	    iferr (call pl_loadf (pl,Memc[fname],Memc[hp],IM_LENHDRMEM(im))) {
+		call pl_close (pl)
+		call sfree (sp)
+		status = ERR
+		return
+	    }
+
+	    # Set the image size.
+	    call pl_gsize (pl, naxes, axlen, depth)
+
+	    IM_NDIM(im) = naxes
+	    call amovl (axlen, IM_LEN(im,1), IM_MAXDIM)
+	    call imioff (im, 1, YES, 1)
+
+	    # Restore the header cards.
+	    call im_pmldhdr (im, hp)
+	}
+
+	# More set up of the image descriptor.
+	IM_PL(im)	= pl
+	IM_PLFLAGS(im)	= PL_CLOSEPL
+	IM_PIXTYPE(im)  = TY_INT
+
+	status = OK
+	call sfree (sp)
+end
diff --git a/sys/imio/iki/plf/plfrename.x b/sys/imio/iki/plf/plfrename.x
new file mode 100644
index 00000000..1ab47507
--- /dev/null
+++ b/sys/imio/iki/plf/plfrename.x
@@ -0,0 +1,37 @@
+# Copyright(c) 1986 Association of Universities for Research in Astronomy Inc.
+
+include	<error.h>
+include	"plf.h"
+
+# PLF_RENAME -- Rename a PLIO mask savefile (mask image).
+
+procedure plf_rename (kernel, old_root, old_extn, new_root, new_extn, status)
+
+int	kernel			#I IKI kernel
+char	old_root[ARB]		#I old image root name
+char	old_extn[ARB]		#I old image extn
+char	new_root[ARB]		#I new image root name
+char	new_extn[ARB]		#I old image extn
+int	status			#O output status
+
+pointer	sp, oldname, newname
+errchk	rename
+
+begin
+	call smark (sp)
+	call salloc (oldname, SZ_PATHNAME, TY_CHAR)
+	call salloc (newname, SZ_PATHNAME, TY_CHAR)
+
+	# Get filenames of old and new datafiles.
+	call iki_mkfname (old_root, old_extn, Memc[oldname], SZ_PATHNAME)
+	call iki_mkfname (new_root, PLF_EXTN, Memc[newname], SZ_PATHNAME)
+
+	# Rename the datafile.
+	iferr (call rename (Memc[oldname], Memc[newname])) {
+	    call erract (EA_WARN)
+	    status = ERR
+	} else
+	    status = OK
+
+	call sfree (sp)
+end
diff --git a/sys/imio/iki/plf/plfupdhdr.x b/sys/imio/iki/plf/plfupdhdr.x
new file mode 100644
index 00000000..e8cb8784
--- /dev/null
+++ b/sys/imio/iki/plf/plfupdhdr.x
@@ -0,0 +1,33 @@
+# Copyright(c) 1986 Association of Universities for Research in Astronomy Inc.
+
+include	<imhdr.h>
+include	<imio.h>
+include	<plset.h>
+
+# PLF_UPDHDR -- Update the image header.
+
+procedure plf_updhdr (im, status)
+
+pointer	im			#I image descriptor
+int	status			#O output status
+
+pointer	bp
+int	nchars, flags, sz_buf
+int	im_pmsvhdr()
+
+begin
+	status = OK
+
+	flags = 0
+	if (IM_ACMODE(im) == READ_WRITE)
+	    flags = PL_UPDATE
+
+	bp = NULL
+	iferr {
+	    nchars = im_pmsvhdr (im, bp, sz_buf)
+	    call pl_savef (IM_PL(im), IM_HDRFILE(im), Memc[bp], flags)
+	} then
+	    status = ERR
+
+	call mfree (bp, TY_CHAR)
+end