Repatch (from linux) of OSX IRAF

1 files changed, 112 insertions, 0 deletions

diff --git a/noao/digiphot/lib/pttables/ptgetop.x b/noao/digiphot/lib/pttables/ptgetop.x
new file mode 100644
index 00000000..c2697767
--- /dev/null
+++ b/noao/digiphot/lib/pttables/ptgetop.x
@@ -0,0 +1,112 @@
+include <evexpr.h>
+include "../ptkeysdef.h"
+
+# PT_GETOP -- Procedure to fetch an apphot operand for evexpr.
+
+procedure pt_getop (operand, o)
+
+char	operand[ARB]	# operand name
+pointer	o		# operand output
+
+pointer	apkey
+common	/kycommon/ apkey
+errchk	pt_getfield()
+
+begin
+	call pt_getfield (apkey, operand, o)
+end
+
+
+# PT_APSET -- Porcedure to pass the apphot structure in a common block.
+
+procedure pt_apset (key)
+
+pointer	key	# apphot strucuture
+
+pointer	apkey
+common	/kycommon/ apkey
+
+begin
+	apkey = key	
+end
+
+
+# PT_GETFIELD -- Procedure to select an apphot field.
+
+procedure pt_getfield (key, field, o)
+
+pointer	key		# pointer to select strucuture
+char	field[ARB]	# field to evaluated
+pointer	o		# operand
+
+int	type, maxnelems, nelems
+pointer	sp, root, ranges, list
+bool	pt_kybool()
+int	pt_kytype(), pt_kyinteger(), decode_ranges()
+real	pt_kyreal()
+errchk	pt_kytype(), pt_kybool(), pt_kyreal(), pt_kystr()
+
+begin
+	call smark (sp)
+	call salloc (root, SZ_FNAME, TY_CHAR)
+	call salloc (ranges, SZ_FNAME, TY_CHAR)
+	call salloc (list, 3 * KY_MAXNRANGES + 1, TY_INT)
+
+	# Select the field.
+	call strupr (field)
+	type = pt_kytype (key, field, Memc[root], Memc[ranges], maxnelems)
+	if (Memc[ranges] == EOS) {
+	    nelems = 1
+	    Memi[list] = 1
+	} else if (decode_ranges (Memc[ranges], Memi[list], KY_MAXNRANGES,
+	    nelems) == ERR) {
+	    call sfree (sp)
+	    call error (0, "Cannot decode range string")
+	}
+
+	# Decode the value.
+	switch (type) {
+	case TY_BOOL:
+	    if (nelems == 1) {
+	        call xev_initop (o, 0, TY_BOOL)
+	        O_VALB(o) = pt_kybool (key, Memc[root], Memi[list])
+	    } else {
+		call sfree (sp)
+		call eprintf ("Error decoding boolean field array: %s\n")
+		    call pargstr (field)
+		call error (0, "Boolean arrays not allowed in expressions.")
+	    }
+	case TY_INT:
+	    if (nelems == 1) {
+	        call xev_initop (o, 0, TY_INT)
+	        O_VALI(o) = pt_kyinteger (key, Memc[root], Memi[list])
+	    } else {
+		call sfree (sp)
+		call eprintf ("Error decoding integer field array: %s\n")
+		    call pargstr (field)
+		call error (0, "Integer arrays not allowed in expressions.")
+	    }
+	case TY_REAL:
+	    if (nelems == 1) {
+		call xev_initop (o, 0, TY_REAL)
+	        O_VALR(o) = pt_kyreal (key, Memc[root], Memi[list])
+	    } else {
+		call sfree (sp)
+		call eprintf ("Error decoding real array field: %s\n")
+		    call pargstr (field)
+		call error (0, "Real arrays not allowed in expressions.")
+	    }
+	default:
+	    if (nelems == 1) {
+	        call xev_initop (o, SZ_LINE, TY_CHAR)
+	        call pt_kystr (key, Memc[root], Memi[list], O_VALC(o), SZ_LINE)
+	    } else {
+		call eprintf ("Error decoding char array field: %s\n")
+		call sfree (sp)
+		    call pargstr (field)
+		call error (0, "Character arrays not allowed in expressions.")
+	    }
+	}
+
+	call sfree (sp)
+end