Initial commit

30 files changed, 1329 insertions, 0 deletions

diff --git a/sys/imio/dbc/README b/sys/imio/dbc/README
new file mode 100644
index 00000000..4e6a89ac
--- /dev/null
+++ b/sys/imio/dbc/README
@@ -0,0 +1,29 @@
+October 4, 2004
+
+These routines represent an extension to the imio header routines manipulation.
+Most of them have a new parameter which is the FITS header comment field. 
+The routine names have changed slighly to avoid collision and to have some 
+meaning; e.g. the ending 'c' for comment.
+
+There are a couple of new routines to handle only comments.
+
+Nelson Zarate
+
+
+imakbc.x:# IMAKBC -- Add a new field to the image header and initialize to the value
+imakdc.x:# IMAKDC -- Add a new field to the image header and initialize to the value
+imakic.x:# IMAKIC -- Add a new field to the image header and initialize to the value
+imaklc.x:# IMAKLC -- Add a new field to the image header and initialize to the value
+imakrc.x:# IMAKRC -- Add a new field to the image header and initialize to the value
+imaksc.x:# IMAKSC -- Add a new field to the image header and initialize to the value
+imastrc.x:# IMASTRC -- Add a new field to the image header and initialize to the value
+imgcom.x:# IMGCOM -- Get the comment field for a keyword.
+impcom.x:# IMPCOM -- Change the comment field for a keyword.
+impkbc.x:# IMPKBC -- Put an image header parameter of type boolean.
+impkdc.x:# IMPKDDC -- Put an image header parameter of type double.
+impkic.x:# IMPKIC -- Put an image header parameter of type integer.
+impklc.x:# IMPKLC -- Put an image header parameter of type long integer.
+impkrc.x:# IMPKRC -- Put an image header parameter of type real.
+imdrmcom.x:# IMDRMCOM -- Remove the comment field for a keyword.
+impksc.x:# IMPKSC -- Put an image header parameter of type short integer.
+impstrc.x:# IMPSTRC -- Put an image header parameter of type string.  If the named
diff --git a/sys/imio/dbc/idbc.h b/sys/imio/dbc/idbc.h
new file mode 100644
index 00000000..3c254469
--- /dev/null
+++ b/sys/imio/dbc/idbc.h
@@ -0,0 +1,27 @@
+# IDB.H -- Image header database interface.  In this version of the interface
+# the standard image header fields are maintained in binary in a fixed
+# structure and the user fields are maintained in FITS format (text) in the
+# a string buffer following the binary image header.
+
+define	IDB_RECLEN		80		# length of a FITS record (card)
+define	IDB_STARTVALUE		10		# first column of value field
+define	IDB_ENDVALUE		30		# last  column of value field
+define	IDB_LENNUMERICRECORD	80		# length of new numeric records
+define	IDB_LENSTRINGRECORD	80		# length of new string records
+define	IDB_SZFITSKEY		8		# max length FITS keyword
+
+# Standard header keywords accessible via the database interface.
+
+define	I_CTIME			1
+define	I_HISTORY		2
+define	I_LIMTIME		3
+define	I_MAXPIXVAL		4
+define	I_MINPIXVAL		5
+define	I_MTIME			6
+define	I_NAXIS			7
+define	I_PIXFILE		8
+define	I_PIXTYPE		9
+define	I_TITLE			10
+
+define  BEFORE                  1
+define  AFTER			2
diff --git a/sys/imio/dbc/imakbc.x b/sys/imio/dbc/imakbc.x
new file mode 100644
index 00000000..2871370d
--- /dev/null
+++ b/sys/imio/dbc/imakbc.x
@@ -0,0 +1,20 @@
+# Copyright(c) 1986 Association of Universities for Research in Astronomy Inc.
+
+# IMAKBC -- Add a new field to the image header and initialize to the value
+# given.  It is not an error if the parameter already exists.
+
+procedure imakbc (im, key, value, comment)
+
+pointer	im			# image descriptor
+char	key[ARB]		# parameter or field value
+bool	value			# new or initial value of parameter
+char	comment[ARB]		# comment
+
+int	imaccf()
+errchk	imaccf, imaddf
+
+begin
+	if (imaccf (im, key) == NO)
+	    call imaddf (im, key, "b")
+	call impkbc (im, key, value, comment)
+end
diff --git a/sys/imio/dbc/imakbci.x b/sys/imio/dbc/imakbci.x
new file mode 100644
index 00000000..3fe64116
--- /dev/null
+++ b/sys/imio/dbc/imakbci.x
@@ -0,0 +1,23 @@
+# Copyright(c) 1986 Association of Universities for Research in Astronomy Inc.
+
+# IMAKBCI -- Insert a new field to the image header after the given keyword 
+# and initialize to the value
+# given.  It is not an error if the parameter already exists.
+
+procedure imakbci (im, key, value, comment, pkey, baf)
+
+pointer	im			# image descriptor
+char	key[ARB]		# parameter or field value
+bool	value			# new or initial value of parameter
+char	comment[ARB]		# comment
+char    pkey[ARB]               # Pivot keyword to insert 'key'
+int     baf                     # I Insert BEFORE or AFTER
+
+int	imaccf()
+errchk	imaccf, iminfi
+
+begin
+	if (imaccf (im, key) == NO)
+	    call iminfi (im, key, pkey, "b", baf)
+	call impkbc (im, key, value, comment)
+end
diff --git a/sys/imio/dbc/imakdc.x b/sys/imio/dbc/imakdc.x
new file mode 100644
index 00000000..787c496d
--- /dev/null
+++ b/sys/imio/dbc/imakdc.x
@@ -0,0 +1,20 @@
+# Copyright(c) 1986 Association of Universities for Research in Astronomy Inc.
+
+# IMAKDC -- Add a new field to the image header and initialize to the value
+# given.  It is not an error if the parameter already exists.
+
+procedure imakdc (im, key, value, comment)
+
+pointer	im			# image descriptor
+char	key[ARB]		# parameter or field value
+double	value			# new or initial value of parameter
+char	comment[ARB]		# comment
+
+int	imaccf()
+errchk	imaccf, imaddf
+
+begin
+	if (imaccf (im, key) == NO)
+	    call imaddf (im, key, "d")
+	call impkdc (im, key, value, comment)
+end
diff --git a/sys/imio/dbc/imakdci.x b/sys/imio/dbc/imakdci.x
new file mode 100644
index 00000000..c63a9a5a
--- /dev/null
+++ b/sys/imio/dbc/imakdci.x
@@ -0,0 +1,23 @@
+# Copyright(c) 1986 Association of Universities for Research in Astronomy Inc.
+
+# IMAKDCI -- Insert a new field to the image header  after the given keyword 
+# and initialize to the value
+# given.  It is not an error if the parameter already exists.
+
+procedure imakdci (im, key, value, comment, pkey, baf)
+
+pointer	im			# image descriptor
+char	key[ARB]		# parameter or field value
+double	value			# new or initial value of parameter
+char	comment[ARB]		# comment
+char    pkey[ARB]               # Pivot keyword to insert 'key'
+int     baf                     # I Insert BEFORE or AFTER
+
+int	imaccf()
+errchk	imaccf, iminfi
+
+begin
+	if (imaccf (im, key) == NO)
+	    call iminfi (im, key, pkey, "d", baf)
+	call impkdc (im, key, value, comment)
+end
diff --git a/sys/imio/dbc/imakic.x b/sys/imio/dbc/imakic.x
new file mode 100644
index 00000000..10594d2a
--- /dev/null
+++ b/sys/imio/dbc/imakic.x
@@ -0,0 +1,20 @@
+# Copyright(c) 1986 Association of Universities for Research in Astronomy Inc.
+
+# IMAKIC -- Add a new field to the image header and initialize to the value
+# given.  It is not an error if the parameter already exists.
+
+procedure imakic (im, key, value, comment)
+
+pointer	im			# image descriptor
+char	key[ARB]		# parameter or field value
+int	value			# new or initial value of parameter
+char	comment[ARB]
+
+int	imaccf()
+errchk	imaccf, imaddf
+
+begin
+	if (imaccf (im, key) == NO)
+	    call imaddf (im, key, "i")
+	call impkic (im, key, value, comment)
+end
diff --git a/sys/imio/dbc/imakici.x b/sys/imio/dbc/imakici.x
new file mode 100644
index 00000000..02177184
--- /dev/null
+++ b/sys/imio/dbc/imakici.x
@@ -0,0 +1,23 @@
+# Copyright(c) 1986 Association of Universities for Research in Astronomy Inc.
+
+# IMAKICI -- Insert a new field to the image header after the given keyword
+# and initialize to the value given.  It is not an error if the parameter
+# already exists.
+
+procedure imakici (im, key, value, comment, pkey, baf)
+
+pointer im                      # image descriptor
+char    key[ARB]                # parameter or field value
+int     value                   # new or initial value of parameter
+char    comment[ARB]
+char    pkey[ARB]               # Pivot keyword to insert 'key'
+int     baf                     # I Insert BEFORE or AFTER
+
+int     imaccf()
+errchk  imaccf, iminfi
+
+begin
+        if (imaccf (im, key) == NO)
+            call iminfi (im, key, pkey, "i", baf)
+        call impkic (im, key, value, comment)
+end
diff --git a/sys/imio/dbc/imaklc.x b/sys/imio/dbc/imaklc.x
new file mode 100644
index 00000000..3cb323c1
--- /dev/null
+++ b/sys/imio/dbc/imaklc.x
@@ -0,0 +1,20 @@
+# Copyright(c) 1986 Association of Universities for Research in Astronomy Inc.
+
+# IMAKLC -- Add a new field to the image header and initialize to the value
+# given.  It is not an error if the parameter already exists.
+
+procedure imaklc (im, key, value, comment)
+
+pointer	im			# image descriptor
+char	key[ARB]		# parameter or field value
+long	value			# new or initial value of parameter
+char	comment[ARB]
+
+int	imaccf()
+errchk	imaccf, imaddf
+
+begin
+	if (imaccf (im, key) == NO)
+	    call imaddf (im, key, "l")
+	call impklc (im, key, value, comment)
+end
diff --git a/sys/imio/dbc/imaklci.x b/sys/imio/dbc/imaklci.x
new file mode 100644
index 00000000..9b74c82f
--- /dev/null
+++ b/sys/imio/dbc/imaklci.x
@@ -0,0 +1,23 @@
+# Copyright(c) 1986 Association of Universities for Research in Astronomy Inc.
+
+# IMAKLCI -- Insert a new field to the image header after the given keyword
+# and initialize to the value
+# given.  It is not an error if the parameter already exists.
+
+procedure imaklci (im, key, value, comment, pkey, baf)
+
+pointer	im			# image descriptor
+char	key[ARB]		# parameter or field value
+long	value			# new or initial value of parameter
+char	comment[ARB]
+char    pkey[ARB]               # Pivot keyword to insert 'key'
+int     baf                     # I Insert BEFORE or AFTER
+
+int	imaccf()
+errchk	imaccf, iminfi
+
+begin
+	if (imaccf (im, key) == NO)
+	    call iminfi (im, key, pkey, "l", baf)
+	call impklc (im, key, value, comment)
+end
diff --git a/sys/imio/dbc/imakrc.x b/sys/imio/dbc/imakrc.x
new file mode 100644
index 00000000..ff13efdf
--- /dev/null
+++ b/sys/imio/dbc/imakrc.x
@@ -0,0 +1,20 @@
+# Copyright(c) 1986 Association of Universities for Research in Astronomy Inc.
+
+# IMAKRC -- Add a new field to the image header and initialize to the value
+# given.  It is not an error if the parameter already exists.
+
+procedure imakrc (im, key, value, comment)
+
+pointer	im			# image descriptor
+char	key[ARB]		# parameter or field value
+real	value			# new or initial value of parameter
+char	comment[ARB]		
+
+int	imaccf()
+errchk	imaccf, imaddf
+
+begin
+	if (imaccf (im, key) == NO)
+	    call imaddf (im, key, "r")
+	call impkrc (im, key, value, comment)
+end
diff --git a/sys/imio/dbc/imakrci.x b/sys/imio/dbc/imakrci.x
new file mode 100644
index 00000000..74114d90
--- /dev/null
+++ b/sys/imio/dbc/imakrci.x
@@ -0,0 +1,23 @@
+# Copyright(c) 1986 Association of Universities for Research in Astronomy Inc.
+
+# IMAKRCI -- Insert a new field to the image header after the given keyword
+# and initialize to the value
+# given.  It is not an error if the parameter already exists.
+
+procedure imakrci (im, key, value, comment, pkey, baf)
+
+pointer	im			# image descriptor
+char	key[ARB]		# parameter or field value
+real	value			# new or initial value of parameter
+char	comment[ARB]		
+char    pkey[ARB]               # Pivot keyword to insert 'key'
+int     baf                     # I Insert BEFORE or AFTER
+
+int	imaccf()
+errchk	imaccf, iminfi
+
+begin
+	if (imaccf (im, key) == NO)
+	    call iminfi (im, key, pkey, "r", baf)
+	call impkrc (im, key, value, comment)
+end
diff --git a/sys/imio/dbc/imaksc.x b/sys/imio/dbc/imaksc.x
new file mode 100644
index 00000000..e6f2c4ac
--- /dev/null
+++ b/sys/imio/dbc/imaksc.x
@@ -0,0 +1,20 @@
+# Copyright(c) 1986 Association of Universities for Research in Astronomy Inc.
+
+# IMAKSC -- Add a new field to the image header and initialize to the value
+# given.  It is not an error if the parameter already exists.
+
+procedure imaksc (im, key, value, comment)
+
+pointer	im			# image descriptor
+char	key[ARB]		# parameter or field value
+short	value			# new or initial value of parameter
+char	comment[ARB]		
+
+int	imaccf()
+errchk	imaccf, imaddf
+
+begin
+	if (imaccf (im, key) == NO)
+	    call imaddf (im, key, "s")
+	call impksc (im, key, value, comment)
+end
diff --git a/sys/imio/dbc/imaksci.x b/sys/imio/dbc/imaksci.x
new file mode 100644
index 00000000..2bed12b0
--- /dev/null
+++ b/sys/imio/dbc/imaksci.x
@@ -0,0 +1,23 @@
+# Copyright(c) 1986 Association of Universities for Research in Astronomy Inc.
+
+# IMAKSCI -- Insert a new field to the image header after the given keyword
+# and initialize to the value
+# given.  It is not an error if the parameter already exists.
+
+procedure imaksci (im, key, value, comment, pkey, baf)
+
+pointer	im			# image descriptor
+char	key[ARB]		# parameter or field value
+short	value			# new or initial value of parameter
+char	comment[ARB]		
+char    pkey[ARB]               # Pivot keyword to insert 'key'
+int     baf                     # I Insert BEFORE or AFTER
+
+int	imaccf()
+errchk	imaccf, iminfi
+
+begin
+	if (imaccf (im, key) == NO)
+	    call iminfi (im, key, pkey, "s", baf)
+	call impksc (im, key, value, comment)
+end
diff --git a/sys/imio/dbc/imastrc.x b/sys/imio/dbc/imastrc.x
new file mode 100644
index 00000000..4620db46
--- /dev/null
+++ b/sys/imio/dbc/imastrc.x
@@ -0,0 +1,20 @@
+# Copyright(c) 1986 Association of Universities for Research in Astronomy Inc.
+
+# IMASTRC -- Add a new field to the image header and initialize to the value
+# given.  It is not an error if the parameter already exists.
+
+procedure imastrc (im, key, value, comment)
+
+pointer	im			# image descriptor
+char	key[ARB]		# parameter or field value
+char	value[ARB]		# new or initial value of parameter
+char	comment[ARB]		# 
+
+int	imaccf()
+errchk	imaccf, imaddf
+
+begin
+	if (imaccf (im, key) == NO)
+	    call imaddf (im, key, "c")
+	call impstrc (im, key, value, comment)
+end
diff --git a/sys/imio/dbc/imastrci.x b/sys/imio/dbc/imastrci.x
new file mode 100644
index 00000000..f5154906
--- /dev/null
+++ b/sys/imio/dbc/imastrci.x
@@ -0,0 +1,23 @@
+# Copyright(c) 1986 Association of Universities for Research in Astronomy Inc.
+
+# IMASTRCI -- Insert a new field to the image header after the given keyword
+# and initialize to the value
+# given.  It is not an error if the parameter already exists.
+
+procedure imastrci (im, key, value, comment, pkey, baf)
+
+pointer	im			# image descriptor
+char	key[ARB]		# parameter or field value
+char	value[ARB]		# new or initial value of parameter
+char	comment[ARB]		# 
+char    pkey[ARB]               # Pivot keyword to insert 'key'
+int     baf                     # I Insert BEFORE or AFTER
+
+int	imaccf()
+errchk	imaccf, iminfi
+
+begin
+	if (imaccf (im, key) == NO)
+	    call iminfi (im, key, pkey, "c", baf)
+	call impstrc (im, key, value, comment)
+end
diff --git a/sys/imio/dbc/imdrmcom.x b/sys/imio/dbc/imdrmcom.x
new file mode 100644
index 00000000..4a10f2df
--- /dev/null
+++ b/sys/imio/dbc/imdrmcom.x
@@ -0,0 +1,96 @@
+# Copyright(c) 1986 Association of Universities for Research in Astronomy Inc.
+
+include	<syserr.h>
+include	"idbc.h"
+
+# IMDRMCOM -- Remove the comment field for a keyword.
+
+procedure imdrmcom (im, key)
+
+pointer	im			#I image descriptor
+char	key[ARB]		#I parameter to be set
+
+bool	string_valued
+int	ch, i, ti, j, n
+pointer	rp, ip, op, sp, val, start, text, cmmt
+int	idb_findrecord()
+errchk	syserrs
+
+begin
+	call smark (sp)
+	call salloc (val, SZ_LINE, TY_CHAR)
+	call salloc (text, SZ_LINE, TY_CHAR)
+	call salloc (cmmt, SZ_LINE, TY_CHAR)
+
+	# Find the record.
+	if (idb_findrecord (im, key, rp) == 0)
+	    call syserrs (SYS_IDBKEYNF, key)
+
+	for (i=0; i<SZ_LINE; i=i+1)
+	    Memc[text+i] = ' '
+	Memc[text+SZ_LINE] = EOS
+
+	# Determine the actual datatype of the parameter.  String valued
+	# parameters will have an apostrophe in the first nonblank column
+	# of the value field.
+
+	string_valued = false
+	ti = text
+	for (ip=IDB_STARTVALUE;  ip <= IDB_ENDVALUE;  ip=ip+1) {
+	    # Skip leading whitespace.
+	    for (; Memc[rp+ip-1] == ' '; ip=ip+1) {
+		Memc[ti] = Memc[rp+ip-1]
+		ti = ti + 1
+	    }
+	    if (Memc[rp+ip-1] == '\'') {
+		# Get string value.
+	        Memc[ti] = Memc[rp+ip-1]
+		ti = ti + 1
+		do i = ip, IDB_RECLEN {
+		    ch = Memc[rp+i]
+		    Memc[ti] = ch
+		    ti = ti + 1
+		    if (ch == '\n')
+			break
+		    if (ch == '\'')
+			break
+		}
+		break
+
+	    } else {
+		# Numeric value.
+		do i = ip, IDB_RECLEN {
+		    ch = Memc[rp+i-1]
+		    Memc[ti] = ch
+		    ti = ti + 1
+		    if (ch == '\n' || ch == ' ' || ch == '/')
+			break
+		}
+#		if (ch == ' ')
+#		    ti = ti - 1
+		break
+	    }
+	}
+
+	n = 0
+	do j = i, IDB_RECLEN {
+	   ch = Memc[rp+j]
+	   Memc[cmmt+n] = ch
+	   n = n + 1
+	   if (ch == '\n') {
+	       n = n - 1
+	       break
+	   }
+	}
+	Memc[cmmt+n] = EOS 
+
+	# Update the parameter value.
+	op = rp + IDB_STARTVALUE + ti-text - 1 
+	start = op
+	for (ip=ti;  Memc[ip] != EOS && Memc[op] != '\n';  ip=ip+1) {
+	    Memc[op] = Memc[ip]
+	    op = op + 1
+	}
+
+	call sfree (sp)
+end
diff --git a/sys/imio/dbc/imgcom.x b/sys/imio/dbc/imgcom.x
new file mode 100644
index 00000000..504c0c55
--- /dev/null
+++ b/sys/imio/dbc/imgcom.x
@@ -0,0 +1,66 @@
+# Copyright(c) 1986 Association of Universities for Research in Astronomy Inc.
+
+include	<syserr.h>
+include <ctype.h>
+include	"idbc.h"
+
+# IMGCOM -- Get the comment field for a keyword.
+
+procedure imgcom (im, key, comment)
+
+pointer	im			#I image descriptor
+char	key[ARB]		#I parameter to be set
+char	comment[ARB]		#O comment string
+
+bool	string_valued
+int	ch, i, n, j, ic, op
+pointer	rp, ip, sp, buf
+int	idb_findrecord(), ctowrd(), stridx(), idb_getstring()
+errchk	syserrs
+
+define  end_ 91
+begin
+	call smark (sp)
+	call salloc (buf, SZ_LINE, TY_CHAR)
+
+        # Special fields do not have comment.
+        if (key[1] == 'i' && key[2] == '_') {  
+	    comment[1] = EOS
+	    return
+        }
+
+	# Find the record.
+	if (idb_findrecord (im, key, rp) == 0)
+	    call syserrs (SYS_IDBKEYNF, key)
+
+        ip = IDB_STARTVALUE
+        if (ctowrd (Memc[rp], ip, Memc[buf], SZ_LINE) <= 0) {
+	    comment[1] = EOS
+	    goto end_
+        }
+ 
+	# Look for '/'
+        while (ip < IDB_RECLEN && (Memc[rp+ip] != '/'))
+             ip = ip + 1
+        if (ip == IDB_RECLEN) {
+	   comment[1] = EOS
+	   goto end_
+        }
+        op = rp+ip+1
+        while (op < IDB_RECLEN+rp && (IS_WHITE(Memc[op]) || Memc[op] == '\n'))
+             op = op + 1
+
+        # Copy comment section
+        for (i = 1; Memc[op] != '\n' && op < IDB_RECLEN+rp; op=op+1) {
+            comment[i] = Memc[op]
+            i = i + 1
+        }
+        # Trim
+	i = i - 1
+        while (i >= 1 && IS_WHITE(comment[i]))
+	   i = i - 1
+
+        comment[i+1] = EOS
+end_
+	call sfree (sp)
+end
diff --git a/sys/imio/dbc/iminfi.x b/sys/imio/dbc/iminfi.x
new file mode 100644
index 00000000..0ddfb540
--- /dev/null
+++ b/sys/imio/dbc/iminfi.x
@@ -0,0 +1,111 @@
+# Copyright(c) 1986 Association of Universities for Research in Astronomy Inc.
+
+include	<syserr.h>
+include	<fset.h>
+include	<imhdr.h>
+include	<imio.h>
+include	"idbc.h"
+
+# IMADDFI -- Insert a user field in the image header after the specified 
+# keyword.  It is an error if the named field already exists.
+
+#procedure imaddfi (im, key, pkey, datatype, baf)
+procedure iminfi (im, key, pkey, datatype, baf)
+
+pointer	im			#I image descriptor
+char	key[ARB]		#I name of the new parameter
+char	pkey[ARB]		#I 'key' will be inserted bef/after pkey
+char	datatype[ARB]		#I string permits generalization to domains
+int     baf			# I Insert BEFORE or AFTER
+
+pointer	rp, sp, keyname, ua, ip
+int	fd, max_lenuserarea, curlen, buflen, nchars, piv
+int	idb_kwlookup(), idb_findrecord()
+int	strlen(), idb_filstr(), nowhite()
+char	card[IDB_RECLEN+1]
+errchk	syserrs, sprintf, pargstr, pargi
+
+begin
+	call smark (sp)
+	call salloc (keyname, SZ_FNAME, TY_CHAR)
+
+	nchars = idb_filstr (key, Memc[keyname], IDB_SZFITSKEY)
+	nchars = nowhite (Memc[keyname], Memc[keyname], IDB_SZFITSKEY)
+	call strupr (Memc[keyname])
+
+	# Check for a redefinition.
+	if ((idb_kwlookup (key) > 0) || (idb_findrecord (im, key, rp) > 0))
+	    call syserrs (SYS_IDBREDEF, key)
+	
+	# Open the user area string for appending.  'buflen' is the malloc-ed
+	# buffer length in struct units; IMU is the struct offset to the user
+	# area, i.e., the size of that part of the image descriptor preceding
+	# the user area. 
+
+	ua = IM_USERAREA(im)
+	curlen = strlen (Memc[ua])
+	buflen = LEN_IMDES + IM_LENHDRMEM(im)
+	max_lenuserarea = (buflen - IMU) * SZ_STRUCT - 1
+
+	if (curlen+81 >= max_lenuserarea) {
+	    IM_HDRLEN(im)  = LEN_IMHDR  + 
+	            (curlen + 10*36*81 + SZ_STRUCT-1) / SZ_STRUCT
+	    IM_LENHDRMEM(im) = IM_HDRLEN(im)  + (SZ_UAPAD / SZ_STRUCT)
+	    call realloc (im, IM_LENHDRMEM(im) + LEN_IMDES, TY_STRUCT)
+	    buflen = LEN_IMDES + IM_LENHDRMEM(im)
+	    max_lenuserarea = (buflen - IMU) * SZ_STRUCT - 1
+	}
+
+	# If the user area is not empty the last character must be the newline
+	# record delimiter, else the new record we add will be invalid.
+
+	if (curlen > 0 && Memc[ua+curlen-1] != '\n')
+	    if (curlen >= max_lenuserarea) {
+		call syserrs (SYS_IDBOVFL, key)
+	    } else {
+		Memc[ua+curlen] = '\n'
+		curlen = curlen + 1
+		Memc[ua+curlen] = EOS
+	    }
+
+        # Find keyw_after
+	if (idb_findrecord (im, pkey, rp) == 0) {
+	    # Keyw not found. Append the new keyword.
+	    rp = ua+curlen
+	    baf = BEFORE
+        } else {
+            # Shift cards after pivot or before pivot
+	    if (baf == AFTER)
+	        piv = rp
+            else
+	        piv = rp - IDB_RECLEN - 1
+	    for (ip= ua+curlen-IDB_RECLEN-1; ip>=piv; ip=ip-IDB_RECLEN-1) {
+	        call amovc (Memc[ip], Memc[ip+IDB_RECLEN+1], IDB_RECLEN)
+            }
+	}
+        Memc[ua+curlen+IDB_RECLEN]='\n'
+	Memc[ua+curlen+IDB_RECLEN+1]=EOS
+
+	# Form a card with keyword name and placeholder for value.
+	call sprintf (card, IDB_RECLEN+10, "%-8s= %s%*t\n")
+	    call pargstr (Memc[keyname])
+	    if (datatype[1] == 'c') {
+	        call pargstr ("'        '")
+		call pargi (IDB_LENSTRINGRECORD + 1)
+	    } else {
+		call pargstr ("")
+		call pargi (IDB_LENNUMERICRECORD + 1)
+	    }
+
+        # Replace keyword at the position rp+81.
+	if (baf == AFTER)
+            call amovc (card, Memc[rp+IDB_RECLEN+1], IDB_RECLEN)
+        else
+            call amovc (card, Memc[rp], IDB_RECLEN)
+
+#for (ip=1; ip<5; ip=ip+1) {
+#call eprintf("<%40.40s>\n")
+#   call pargstr(Memc[rp-(2-ip)*(IDB_RECLEN+1)])
+#}
+	call sfree (sp)
+end
diff --git a/sys/imio/dbc/impcom.x b/sys/imio/dbc/impcom.x
new file mode 100644
index 00000000..b110536e
--- /dev/null
+++ b/sys/imio/dbc/impcom.x
@@ -0,0 +1,97 @@
+# Copyright(c) 1986 Association of Universities for Research in Astronomy Inc.
+
+include	<syserr.h>
+include	"idbc.h"
+
+# IMPCOM -- Change the comment field for a keyword.
+
+procedure impcom (im, key, comment)
+
+pointer	im			#I image descriptor
+char	key[ARB]		#I parameter to be set
+char	comment[ARB]		#I comment string
+
+bool	string_valued
+int	ch, i, ti, j
+pointer	rp, ip, op, sp, val, start, text, cmmt
+int	idb_findrecord()
+errchk	syserrs
+
+begin
+	call smark (sp)
+	call salloc (val, SZ_LINE, TY_CHAR)
+	call salloc (text, SZ_LINE, TY_CHAR)
+	call salloc (cmmt, SZ_LINE, TY_CHAR)
+
+	# Find the record.
+	if (idb_findrecord (im, key, rp) == 0)
+	    call syserrs (SYS_IDBKEYNF, key)
+
+	# Determine the actual datatype of the parameter.  String valued
+	# parameters will have an apostrophe in the first nonblank column
+	# of the value field.
+
+	string_valued = false
+	ti = text
+	for (ip=IDB_STARTVALUE;  ip <= IDB_ENDVALUE;  ip=ip+1) {
+	    # Skip leading whitespace.
+	    for (; Memc[rp+ip-1] == ' '; ip=ip+1) {
+		Memc[ti] = Memc[rp+ip-1]
+		ti = ti + 1
+	    }
+	    if (Memc[rp+ip-1] == '\'') {
+		# Get string value.
+	        Memc[ti] = Memc[rp+ip-1]
+		ti = ti + 1
+		do i = ip, IDB_RECLEN {
+		    ch = Memc[rp+i]
+		    Memc[ti] = ch
+		    ti = ti + 1
+		    if (ch == '\n')
+			break
+		    if (ch == '\'')
+			break
+		}
+		do j = i, IDB_ENDVALUE-2 {
+	           Memc[ti] = ' ' ; ti=ti+1
+	        }
+		break
+
+	    } else {
+		# Skip numeric value.
+		do i = ip, IDB_RECLEN {
+		    ch = Memc[rp+i-1]
+		    Memc[ti] = ch
+		    ti = ti + 1
+		    if (ch == '\n' || ch == ' ' || ch == '/')
+			break
+		}
+		if (ch == ' ')
+		    ti = ti - 1
+		do j = i, IDB_ENDVALUE {
+	           Memc[ti] = ' ' ; ti=ti+1
+	        }
+		break
+	    }
+	}
+	Memc[ti]=EOS
+        if (comment[1] != EOS) {
+	    call strcat (" / ", Memc[ti], SZ_LINE)
+            for (i=1; comment[i] == ' '; i=i+1)
+                ;
+            call strcat (comment[i], Memc[ti], SZ_LINE)
+        } else {
+	    do j = i, IDB_RECLEN {
+	       Memc[ti] = ' ' ; ti=ti+1
+	    }
+	}
+	# Update the parameter value.
+	op = rp + IDB_STARTVALUE + ti-text - 1 
+	start = op
+	for (ip=ti;  Memc[ip] != EOS && Memc[op] != '\n';  ip=ip+1) {
+	    Memc[op] = Memc[ip]
+	    op = op + 1
+	}
+
+	call sfree (sp)
+end
diff --git a/sys/imio/dbc/impkbc.x b/sys/imio/dbc/impkbc.x
new file mode 100644
index 00000000..fb28eacd
--- /dev/null
+++ b/sys/imio/dbc/impkbc.x
@@ -0,0 +1,21 @@
+# Copyright(c) 1986 Association of Universities for Research in Astronomy Inc.
+
+# IMPKBC -- Put an image header parameter of type boolean.
+
+procedure impkbc (im, key, bval, comment)
+
+pointer	im			# image descriptor
+char	key[ARB]		# parameter to be set
+bool	bval			# parameter value
+char	comment[ARB]		# 
+char	sval[2]
+
+begin
+	if (bval)
+	    sval[1] = 'T'
+	else
+	    sval[1] = 'F'
+	sval[2] = EOS
+
+	call impstrc (im, key, sval, comment)
+end
diff --git a/sys/imio/dbc/impkdc.x b/sys/imio/dbc/impkdc.x
new file mode 100644
index 00000000..6eb671f3
--- /dev/null
+++ b/sys/imio/dbc/impkdc.x
@@ -0,0 +1,39 @@
+# Copyright(c) 1986 Association of Universities for Research in Astronomy Inc.
+
+include	<mach.h>
+
+# IMPKDDC -- Put an image header parameter of type double.
+
+procedure impkdc (im, key, dval, comment)
+
+pointer	im			# image descriptor
+char	key[ARB]		# parameter to be set
+double	dval			# double precision value
+char	comment[ARB]		# 
+
+pointer	sp, sval
+int	i, strlen()
+
+begin
+	call smark (sp)
+	call salloc (sval, SZ_FNAME, TY_CHAR)
+
+	# Reduce the precision of the encoded value if necessary to fit in
+	# the FITS value field.  Start with NDIGITS_DP-1 as the precision
+	# estimate NDIGITS_DP is only approximate, and if we make up half a
+	# digit of precision the result can be 1.00000000000000001 instead
+	# of 1.0.
+
+	for (i=NDIGITS_DP-1;  i >= NDIGITS_RP;  i=i-1) {
+	    call sprintf (Memc[sval], SZ_FNAME, "%0.*g")
+		call pargi (i)
+		call pargd (dval)
+	    if (strlen (Memc[sval]) < 20)
+		break
+	}
+
+	# Write the new value to the header.
+	call impstrc (im, key, Memc[sval], comment)
+
+	call sfree (sp)
+end
diff --git a/sys/imio/dbc/impkic.x b/sys/imio/dbc/impkic.x
new file mode 100644
index 00000000..3acb0fbd
--- /dev/null
+++ b/sys/imio/dbc/impkic.x
@@ -0,0 +1,22 @@
+# Copyright(c) 1986 Association of Universities for Research in Astronomy Inc.
+
+# IMPKIC -- Put an image header parameter of type integer.
+
+procedure impkic (im, key, ival, comment)
+
+pointer	im			# image descriptor
+char	key[ARB]		# parameter to be set
+int	ival			# parameter value
+char	comment[ARB]		# 
+pointer	sp, sval
+
+begin
+	call smark (sp)
+	call salloc (sval, SZ_FNAME, TY_CHAR)
+
+	call sprintf (Memc[sval], SZ_FNAME, "%d")
+	    call pargi (ival)
+	call impstrc (im, key, Memc[sval], comment)
+
+	call sfree (sp)
+end
diff --git a/sys/imio/dbc/impklc.x b/sys/imio/dbc/impklc.x
new file mode 100644
index 00000000..7ef227ff
--- /dev/null
+++ b/sys/imio/dbc/impklc.x
@@ -0,0 +1,22 @@
+# Copyright(c) 1986 Association of Universities for Research in Astronomy Inc.
+
+# IMPKLC -- Put an image header parameter of type long integer.
+
+procedure impklc (im, key, lval, comment)
+
+pointer	im			# image descriptor
+char	key[ARB]		# parameter to be set
+long	lval			# parameter value
+char	comment[ARB]		# 
+pointer	sp, sval
+
+begin
+	call smark (sp)
+	call salloc (sval, SZ_FNAME, TY_CHAR)
+
+	call sprintf (Memc[sval], SZ_FNAME, "%d")
+	    call pargl (lval)
+	call impstrc (im, key, Memc[sval], comment)
+
+	call sfree (sp)
+end
diff --git a/sys/imio/dbc/impkrc.x b/sys/imio/dbc/impkrc.x
new file mode 100644
index 00000000..1f1459dd
--- /dev/null
+++ b/sys/imio/dbc/impkrc.x
@@ -0,0 +1,25 @@
+# Copyright(c) 1986 Association of Universities for Research in Astronomy Inc.
+
+include	<mach.h>
+
+# IMPKRC -- Put an image header parameter of type real.
+
+procedure impkrc (im, key, rval, comment)
+
+pointer	im			# image descriptor
+char	key[ARB]		# parameter to be set
+real	rval			# parameter value
+char	comment[ARB]		# 
+pointer	sp, sval
+
+begin
+	call smark (sp)
+	call salloc (sval, SZ_FNAME, TY_CHAR)
+
+	call sprintf (Memc[sval], SZ_FNAME, "%0.*g")
+	    call pargi (NDIGITS_RP)
+	    call pargr (rval)
+	call impstrc (im, key, Memc[sval], comment)
+
+	call sfree (sp)
+end
diff --git a/sys/imio/dbc/impksc.x b/sys/imio/dbc/impksc.x
new file mode 100644
index 00000000..0a74d0f0
--- /dev/null
+++ b/sys/imio/dbc/impksc.x
@@ -0,0 +1,22 @@
+# Copyright(c) 1986 Association of Universities for Research in Astronomy Inc.
+
+# IMPKSC -- Put an image header parameter of type short integer.
+
+procedure impksc (im, key, value, comment)
+
+pointer	im			# image descriptor
+char	key[ARB]		# parameter to be set
+short	value			# parameter value
+char	comment[ARB]		# 
+pointer	sp, sval
+
+begin
+	call smark (sp)
+	call salloc (sval, SZ_FNAME, TY_CHAR)
+
+	call sprintf (Memc[sval], SZ_FNAME, "%d")
+	    call pargs (value)
+	call impstrc (im, key, Memc[sval], comment)
+
+	call sfree (sp)
+end
diff --git a/sys/imio/dbc/impstrc.x b/sys/imio/dbc/impstrc.x
new file mode 100644
index 00000000..0a11782e
--- /dev/null
+++ b/sys/imio/dbc/impstrc.x
@@ -0,0 +1,117 @@
+# Copyright(c) 1986 Association of Universities for Research in Astronomy Inc.
+
+include	<syserr.h>
+include	"idbc.h"
+
+# IMPSTRC -- Put an image header parameter of type string.  If the named
+# parameter is a standard parameter of type other than string, decode the
+# string and set the binary value of the parameter.  If the parameter is
+# a nonstandard one we can do a simple string edit, since user parameters
+# are stored in the user area in string form.  The datatype of the parameter
+# must be preserved by the edit, i.e., parameters of actual datatype string
+# must be quoted and left justified and other parameters must be unquoted
+# and right justified in the value field.
+
+procedure impstrc (im, key, value, comment)
+
+pointer	im			#I image descriptor
+char	key[ARB]		#I parameter to be set
+char	value[ARB]		#I new parameter value
+char	comment[ARB]		#I comment string
+
+bool	string_valued
+int	nchars, ch, i
+pointer	rp, ip, op, sp, val, start, text, cmmt, slen
+int	idb_putstring(), idb_findrecord(), idb_filstr(), strlen()
+errchk	syserrs
+
+begin
+	call smark (sp)
+	call salloc (val, SZ_LINE, TY_CHAR)
+	call salloc (text, SZ_LINE, TY_CHAR)
+	call salloc (cmmt, SZ_LINE, TY_CHAR)
+
+	# Filter the value string to remove any undesirable characters.
+	nchars = idb_filstr (value, Memc[text], SZ_LINE)
+
+	# Check for a standard header parameter first.
+	if (idb_putstring (im, key, Memc[text]) != ERR) {
+	    call sfree (sp)
+	    return
+	}
+
+	# Find the record.
+	if (idb_findrecord (im, key, rp) == 0)
+	    call syserrs (SYS_IDBKEYNF, key)
+
+	# Determine the actual datatype of the parameter.  String valued
+	# parameters will have an apostrophe in the first nonblank column
+	# of the value field.  Skip the value and treat the rest of
+	# the line as a comment to be preserved.
+
+	string_valued = false
+	for (ip=IDB_STARTVALUE;  ip <= IDB_ENDVALUE;  ip=ip+1) {
+	    # Skip leading whitespace.
+	    for (; Memc[rp+ip-1] == ' '; ip=ip+1)
+		;
+
+	    if (Memc[rp+ip-1] == '\'') {
+		# Skip string value.
+		do i = ip, IDB_RECLEN {
+		    ch = Memc[rp+i]
+		    if (ch == '\n')
+			break
+		    Memc[rp+i] = ' '
+		    if (ch == '\'')
+			break
+		}
+
+		string_valued = true
+		break
+
+	    } else {
+		# Skip numeric value.
+		do i = ip, IDB_RECLEN {
+		    ch = Memc[rp+i-1]
+		    if (ch == '\n' || ch == ' ' || ch == '/')
+			break
+		    Memc[rp+i-1] = ' '
+		}
+		break
+	    }
+	}
+
+	# Skip whitespace before any comment.
+	for (ip = i; Memc[rp+ip-1] == ' '; ip=ip+1)
+	    ;
+
+	call strcpy (" / ", Memc[cmmt], IDB_RECLEN)
+	call strcat (comment, Memc[cmmt], IDB_RECLEN)
+
+	# Put enough blanks to erase the old comment.
+        slen = strlen(Memc[cmmt])
+	for (i=slen+1; i<=71-slen; i=i+1)
+	    Memc[cmmt+i-1] = ' '
+	Memc[cmmt+i-1] = EOS
+
+	# Encode the new value of the parameter.
+	if (string_valued) {
+	   call sprintf (Memc[val], SZ_LINE, " '%-0.68s%11t'%22t%-0.68s")
+		call pargstr (Memc[text])
+		call pargstr (Memc[cmmt])
+	} else {
+	    call sprintf (Memc[val], SZ_LINE, "%21s%-0.68s")
+		call pargstr (Memc[text])
+		call pargstr (Memc[cmmt])
+	}
+
+	# Update the parameter value.
+	op = rp + IDB_STARTVALUE - 1
+	start = op
+	for (ip=val;  Memc[ip] != EOS && Memc[op] != '\n';  ip=ip+1) {
+	    Memc[op] = Memc[ip]
+	    op = op + 1
+	}
+
+	call sfree (sp)
+end
diff --git a/sys/imio/dbc/imputextf.x b/sys/imio/dbc/imputextf.x
new file mode 100644
index 00000000..151f13e4
--- /dev/null
+++ b/sys/imio/dbc/imputextf.x
@@ -0,0 +1,185 @@
+# Copyright(c) 1986 Association of Universities for Research in Astronomy Inc.
+
+include	<syserr.h>
+include	<ctype.h>
+include	<imhdr.h>
+include	<imio.h>
+include	"idbc.h"
+
+define	LEN_HISTSTR	71	# length of a history string on a FITS card
+define  CLEN            81
+
+# IMPUTXTF -- Insert a text file in the user area with HISTORY card.
+# The file cannot have control characters in it; only the FITS standard
+# character set is supported.  The text is broken in records long enough
+# to fit words; i.e. it tries not to split words. The file can have 
+# imbedded tabs and they will be expanded.
+
+procedure imputextf (im, file, pkey, baf)
+
+pointer	im			#I image descriptor
+char	file[ARB]		#I the text file to be inserted and appended
+char    pkey[ARB]               #I Pivot keyword to insert 'key'
+int     baf                     #I Insert BEFORE or AFTER
+
+pointer	ua, rp, piv, ip, op
+int	max_lenuserarea, curlen, buflen, jump, nlines
+int	old_curlen, k, nshift
+char    blk
+
+int	strlen(), idb_findrecord()
+errchk	syserrs
+
+begin
+	# FITS format requires that the keyword name be upper case.
+
+	ua = IM_USERAREA(im)
+	curlen = strlen (Memc[ua])
+	buflen = LEN_IMDES + IM_LENHDRMEM(im)
+	max_lenuserarea = (buflen - IMU) * SZ_STRUCT - 1
+
+	# Determine the number of lines before inserting into the UA
+	call imrartxt (ua, file, nlines, NO)
+
+        old_curlen=curlen
+        curlen = curlen + nlines*CLEN
+        if (curlen+81 >= max_lenuserarea) {
+            IM_HDRLEN(im)  = LEN_IMHDR  +
+                    (curlen + 10*36*CLEN + SZ_STRUCT-1) / SZ_STRUCT
+            IM_LENHDRMEM(im) = IM_HDRLEN(im)  + (SZ_UAPAD / SZ_STRUCT)
+            call realloc (im, IM_LENHDRMEM(im) + LEN_IMDES, TY_STRUCT)
+            buflen = LEN_IMDES + IM_LENHDRMEM(im)
+            max_lenuserarea = (buflen - IMU) * SZ_STRUCT - 1
+	    ua = IM_USERAREA(im)
+        }
+
+	blk=' '
+	# Find pivot keyword 
+        if (idb_findrecord (im, pkey, rp) == 0) {
+            # Keyw not found. Append the new keywords.
+            piv = ua + old_curlen
+        } else {
+            # Shift cards after or before pivot.
+            if (baf == AFTER)
+                piv = rp + CLEN
+            else
+                piv = rp 
+        
+            jump=nlines*CLEN
+
+	    # Shift cards down from the pivot point. 
+	    nshift = (ua+old_curlen - piv)/CLEN 
+	    ip = ua + old_curlen 
+            do k = 1, nshift {
+	        ip = ip - CLEN
+		op = jump + ip
+		call amovc (Memc[ip], Memc[op], CLEN)
+	    }
+        }
+
+	# Append the HISTORY records to the user area.
+	call imrartxt (piv, file, nlines, YES)
+
+end
+
+
+# IMRARTXT -- Internal routines to count the number of lines transfered to the
+# UA as HISTORY records.
+
+procedure imrartxt (piv, fname, nlines, insert)
+
+pointer piv	#I UA address to start inserting kw
+char	fname[ARB]
+int	nlines
+int	insert
+
+char	line[IDB_RECLEN+1], blk, lf
+pointer	sp, ln, buf, urp
+int 	ip, op, fd, in_last_blank, out_last_blank, blen, len, w, k
+int	save_ip
+int	open(), getline(), strlen()
+
+begin
+	call smark(sp)
+	call salloc (ln, SZ_LINE, TY_CHAR)
+	call salloc (buf, SZ_LINE, TY_CHAR)
+
+	fd = open(fname, READ_ONLY, TEXT_FILE)
+        nlines= 0
+	blk=' '
+	lf='\12'
+	call strcpy ("HISTORY  ", Memc[buf], 9)
+	Memc[buf+IDB_LENSTRINGRECORD]='\n'
+	Memc[buf+IDB_LENSTRINGRECORD+1]=EOS
+        urp = piv
+	while(getline(fd, Memc[ln]) != EOF) {
+		for (ip=1;  Memc[ln+ip-1] != EOS;  ) {
+		    # If no blanks are found in HISTORY string, make sure
+		    # all of it gets output anyway.
+
+		    in_last_blank = ip + LEN_HISTSTR - 1
+		    out_last_blank = LEN_HISTSTR
+
+		    # Copy the string to the output buffer, marking the
+		    # last blank found.
+
+		    for (op=1; op <= LEN_HISTSTR; op=op+1) {
+			if (Memc[ln+ip-1] == lf) {
+			    ip=ip+1
+			}    
+			if (IS_WHITE (Memc[ln+ip-1])) {
+			    # Detab input text.
+			    if (Memc[ln+ip-1] == '\t') {
+				if(ip-save_ip == 1)
+				   w=8
+				else
+				   w=9-op+(op/9)*8
+				for(k=0;k<w;k=k+1) {
+				    line[op+k] = blk
+				}
+				save_ip=ip
+				op = op + w - 1
+				ip = ip + 1
+				in_last_blank = ip
+				out_last_blank = op
+				next
+			    }
+			    in_last_blank = ip
+			    out_last_blank = op
+			} else if (Memc[ln+ip-1] == EOS) 
+			    break
+			line[op] = Memc[ln+ip-1]
+			ip = ip + 1
+		    }
+		    # The output string is full; close it off properly
+		    # and get ready for the next round (if any).
+		    line[op] = EOS
+		    if (Memc[ln+ip-1] != EOS) {
+			# Break at last word boundary if in a word.
+			if (!IS_WHITE (Memc[ln+ip-1])) {
+			    line[out_last_blank+1] = EOS
+			    ip = in_last_blank + 1
+			}
+
+			# Skip leading whitespace on next line.
+			while (IS_WHITE(Memc[ln+ip-1]))
+			    ip = ip + 1
+		    }
+		    nlines = nlines + 1
+
+		    if (insert == YES) {
+			# Write out the FITS HISTORY card.
+			len = strlen(line)
+			blen = IDB_LENSTRINGRECORD - len - 9 
+			call amovc (line, Memc[buf+9], len)
+			call amovkc (blk, Memc[buf+9+len], blen)
+
+			call amovc (Memc[buf], Memc[urp], IDB_RECLEN+1)
+			urp = urp + IDB_RECLEN + 1
+		    }
+		}
+	}
+
+        call close(fd)
+        call sfree(sp)
+end
diff --git a/sys/imio/dbc/imputhi.x b/sys/imio/dbc/imputhi.x
new file mode 100644
index 00000000..0d1de5a9
--- /dev/null
+++ b/sys/imio/dbc/imputhi.x
@@ -0,0 +1,113 @@
+# Copyright(c) 1986 Association of Universities for Research in Astronomy Inc.
+
+include	<syserr.h>
+include	<fset.h>
+include	<imhdr.h>
+include	<imio.h>
+include	"idbc.h"
+
+# IMPHIS -- Insert a user field in the image header after the specified 
+# keyword.  It is an error if the named field already exists.
+
+procedure imphis (im, key, text, pkey, baf)
+
+pointer	im			#I image descriptor
+char	key[ARB]		#I name of the new parameter
+char    text[ARB]               #I the history string to be added
+char	pkey[ARB]		#I 'key' will be inserted bef/after pkey
+int     baf			# I Insert BEFORE or AFTER
+
+pointer	rp, sp, keyname, ua, ip, instr
+int	max_lenuserarea, curlen, buflen, nchars, piv
+int	idb_findrecord()
+bool    streq()
+int	strlen(), idb_filstr(), nowhite()
+char	card[IDB_RECLEN+1]
+errchk	syserrs, sprintf, pargstr, pargi
+
+begin
+	call smark (sp)
+	call salloc (keyname, SZ_FNAME, TY_CHAR)
+	call salloc (instr, SZ_LINE, TY_CHAR)
+
+	nchars = idb_filstr (key, Memc[keyname], IDB_SZFITSKEY)
+	nchars = nowhite (Memc[keyname], Memc[keyname], IDB_SZFITSKEY)
+	call strupr (Memc[keyname])
+
+	# Only standard FITS HISTORY keywords are allowed.
+        if (!(streq(Memc[keyname],"HISTORY") ||
+            streq(Memc[keyname],"COMMENT") ||
+            streq(Memc[keyname],"ADD_BLAN"))) {
+            call sfree (sp)
+            return
+        }
+
+        if (streq(Memc[keyname],"ADD_BLAN")) {
+           call strcpy ("        ", Memc[keyname],  SZ_FNAME)
+	}
+	   
+	# Open the user area string for appending.  'buflen' is the malloc-ed
+	# buffer length in struct units; IMU is the struct offset to the user
+	# area, i.e., the size of that part of the image descriptor preceding
+	# the user area. 
+
+	ua = IM_USERAREA(im)
+	curlen = strlen (Memc[ua])
+	buflen = LEN_IMDES + IM_LENHDRMEM(im)
+	max_lenuserarea = (buflen - IMU) * SZ_STRUCT - 1
+
+	if (curlen+81 >= max_lenuserarea) {
+	    IM_HDRLEN(im)  = LEN_IMHDR  + 
+	            (curlen + 10*36*81 + SZ_STRUCT-1) / SZ_STRUCT
+	    IM_LENHDRMEM(im) = IM_HDRLEN(im)  + (SZ_UAPAD / SZ_STRUCT)
+	    call realloc (im, IM_LENHDRMEM(im) + LEN_IMDES, TY_STRUCT)
+	    buflen = LEN_IMDES + IM_LENHDRMEM(im)
+	    max_lenuserarea = (buflen - IMU) * SZ_STRUCT - 1
+	}
+
+	# If the user area is not empty the last character must be the newline
+	# record delimiter, else the new record we add will be invalid.
+
+	if (curlen > 0 && Memc[ua+curlen-1] != '\n')
+	    if (curlen >= max_lenuserarea) {
+		call syserrs (SYS_IDBOVFL, key)
+	    } else {
+		Memc[ua+curlen] = '\n'
+		curlen = curlen + 1
+		Memc[ua+curlen] = EOS
+	    }
+
+        # Find keyw_after
+	if (idb_findrecord (im, pkey, rp) == 0) {
+            # Keyw not found. Append the new keyword.
+            rp = ua+curlen
+            baf = BEFORE
+        } else {
+            # Shift cards after pivot or before pivot
+	    if (baf == AFTER)
+	        piv = rp
+            else
+	        piv = rp - IDB_RECLEN - 1
+	    for (ip= ua+curlen-IDB_RECLEN-1; ip>=piv; ip=ip-IDB_RECLEN-1) {
+	        call amovc (Memc[ip], Memc[ip+IDB_RECLEN+1], IDB_RECLEN)
+            }
+        }
+        Memc[ua+curlen+IDB_RECLEN]='\n'
+	Memc[ua+curlen+IDB_RECLEN+1]=EOS
+
+        # Filter the input string to remove any undesirable characters.
+        nchars = idb_filstr (text, Memc[instr], SZ_LINE)
+
+	# Form a card with keyword name and placeholder for value.
+	call sprintf (card, IDB_RECLEN+10, "%-8s %-71s\n")
+	    call pargstr (Memc[keyname])
+	    call pargstr (Memc[instr])
+
+        # Replace keyword at the position rp+81.
+	if (baf == AFTER)
+            call amovc (card, Memc[rp+IDB_RECLEN+1], IDB_RECLEN)
+        else
+            call amovc (card, Memc[rp], IDB_RECLEN)
+
+	call sfree (sp)
+end
diff --git a/sys/imio/dbc/mkpkg b/sys/imio/dbc/mkpkg
new file mode 100644
index 00000000..1997f6b6
--- /dev/null
+++ b/sys/imio/dbc/mkpkg
@@ -0,0 +1,36 @@
+# Update the image header database interface.
+
+$checkout libex.a lib$
+$update   libex.a
+$checkin  libex.a lib$
+$exit
+
+libex.a:
+	imakbc.x
+	imakbci.x
+	imakdc.x
+	imakdci.x
+	imakic.x
+	imakici.x
+	imaklc.x
+	imaklci.x
+	imakrc.x
+	imakrci.x
+	imaksc.x
+	imaksci.x
+	imastrc.x
+	imastrci.x
+	imgcom.x        idbc.h <ctype.h>
+	iminfi.x        idbc.h <fset.h> <imhdr.h> <imio.h>
+	impcom.x        idbc.h
+	impkbc.x
+	impkdc.x        <mach.h>
+	impkic.x
+	impklc.x
+	impkrc.x        <mach.h>
+	impksc.x
+	imdrmcom.x      idbc.h
+	impstrc.x       idbc.h
+	imputextf.x     idbc.h <ctype.h> <imhdr.h> <imio.h>
+	imputhi.x       idbc.h <fset.h> <imhdr.h> <imio.h>
+	;