Initial commit

1 files changed, 615 insertions, 0 deletions

diff --git a/noao/digiphot/lib/pttables/ptkeywords.x b/noao/digiphot/lib/pttables/ptkeywords.x
new file mode 100644
index 00000000..c636b8fd
--- /dev/null
+++ b/noao/digiphot/lib/pttables/ptkeywords.x
@@ -0,0 +1,615 @@
+include "../ptkeysdef.h"
+
+# PT_KYINIT -- Initilize the keyword structure.
+
+procedure pt_kyinit (key)
+
+pointer	key	# pointer to the keys structure
+
+begin
+	# Allocate space for structure and initialize constants.
+	call malloc (key, LEN_KEYSTRUCT, TY_STRUCT)
+	KY_NKEYS(key) = 0
+	KY_NPKEYS(key) = 0
+	KY_NSTORE(key) = KY_NPARS
+	LEN_KWORDS(key) = 0
+
+	# Allocate space for the string buffers.
+	call malloc (KY_WORDS(key), KY_SZPAR * KY_NPARS, TY_CHAR)
+	call malloc (KY_VALUES(key), KY_SZPAR * KY_NPARS, TY_CHAR)
+	call malloc (KY_UNITS(key), KY_SZPAR * KY_NPARS, TY_CHAR)
+	call malloc (KY_FORMATS(key), KY_SZPAR * KY_NPARS, TY_CHAR)
+
+	# Allocate space for the indices buffers and initialize.
+	call malloc (KY_PTRS(key), KY_NPARS, TY_INT)
+	call malloc (KY_KINDICES(key), KY_NPARS, TY_INT)
+	call malloc (KY_UINDICES(key), KY_NPARS, TY_INT)
+	call malloc (KY_FINDICES(key), KY_NPARS + 1, TY_INT)
+	call calloc (KY_NELEMS(key), KY_NPARS, TY_INT)
+	call malloc (KY_TYPES(key), KY_NPARS, TY_INT)
+	call calloc (KY_NPLINE(key), KY_NLINES, TY_INT)
+	call calloc (KY_NCONTINUE(key), KY_NLINES, TY_INT)
+	Memi[KY_PTRS(key)] = KY_VALUES(key)
+	call amovki (NULL, Memi[KY_PTRS(key)+1], KY_NPARS - 1)
+
+	# Initialize the select buffers.
+	KY_SELECT(key) = NULL
+	KY_ELEM_SELECT(key) = NULL
+	KY_LEN_SELECT(key) = NULL
+	KY_NAME_SELECT(key) = NULL
+	KY_UNIT_SELECT(key) = NULL
+	KY_FMT_SELECT(key) = NULL
+
+	# Initilize the strings.
+	Memc[KY_WORDS(key)] = EOS
+	Memc[KY_VALUES(key)] = EOS
+	Memc[KY_UNITS(key)] = EOS
+	Memc[KY_FORMATS(key)] = EOS
+end
+
+
+# PT_KYFREE -- Procedure to free the keywords structure.
+
+procedure pt_kyfree (key)
+
+pointer	key		# pointer to keyword structure
+
+int	i
+pointer	ptr
+
+begin
+	# Free the string buffers.
+	if (KY_WORDS(key) != NULL)
+	    call mfree (KY_WORDS(key), TY_CHAR)
+	if (KY_VALUES(key) != NULL)
+	    call mfree (KY_VALUES(key), TY_CHAR)
+	if (KY_UNITS(key) != NULL)
+	    call mfree (KY_UNITS(key), TY_CHAR)
+	if (KY_FORMATS(key) != NULL)
+	    call mfree (KY_FORMATS(key), TY_CHAR)
+
+	# Free the indices buffers.
+	if (KY_TYPES(key) != NULL)
+	    call mfree (KY_TYPES(key), TY_INT)
+	if (KY_KINDICES(key) != NULL)
+	    call mfree (KY_KINDICES(key), TY_INT)
+	if (KY_UINDICES(key) != NULL)
+	    call mfree (KY_UINDICES(key), TY_INT)
+	if (KY_FINDICES(key) != NULL)
+	    call mfree (KY_FINDICES(key), TY_INT)
+	if (KY_PTRS(key) != NULL) {
+	    do i = 1, KY_NSTORE(key) {
+		ptr = Memi[KY_PTRS(key)+i-1]
+		if (ptr != NULL && Memi[KY_NELEMS(key)+i-1] > 1)
+		    call mfree (ptr, TY_CHAR)
+	    }
+	    call mfree (KY_PTRS(key), TY_INT)
+	}
+	if (KY_NELEMS(key) != NULL)
+	    call mfree (KY_NELEMS(key), TY_INT)
+	if (KY_NPLINE(key) != NULL)
+	    call mfree (KY_NPLINE(key), TY_INT)
+	if (KY_NCONTINUE(key) != NULL)
+	    call mfree (KY_NCONTINUE(key), TY_INT)
+
+	# Free the select buffers.
+	if (KY_SELECT(key) != NULL)
+	    call mfree (KY_SELECT(key), TY_INT)
+	if (KY_ELEM_SELECT(key) != NULL)
+	    call mfree (KY_ELEM_SELECT(key), TY_INT)
+	if (KY_LEN_SELECT(key) != NULL)
+	    call mfree (KY_LEN_SELECT(key), TY_INT)
+	if (KY_NAME_SELECT(key) != NULL)
+	    call mfree (KY_NAME_SELECT(key), TY_CHAR)
+	if (KY_UNIT_SELECT(key) != NULL)
+	    call mfree (KY_UNIT_SELECT(key), TY_CHAR)
+	if (KY_FMT_SELECT(key) != NULL)
+	    call mfree (KY_FMT_SELECT(key), TY_CHAR)
+
+	call mfree (key, TY_STRUCT)
+end
+
+
+# PT_KYADD -- Procedure to add a parameter to the keyword structure.
+
+procedure pt_kyadd (key, line, nchars)
+
+pointer	key		# pointer to keyword structure
+char	line[ARB]	# line to be decoded
+int	nchars		# number of characters in the line
+
+int	index, onstore
+long	optr
+pointer	sp, id, keyword, equals, value, units, format, temp 
+int	nscan(), strdic()
+
+begin
+	# Check the buffer sizes.
+	onstore = KY_NSTORE(key)
+	optr = KY_VALUES(key)
+	if ((KY_NKEYS(key) + 1) > KY_NSTORE(key)) {
+	    KY_NSTORE(key) = KY_NSTORE(key) + KY_NPARS
+	    call realloc (KY_WORDS(key), KY_NSTORE(key) * KY_SZPAR, TY_CHAR)
+	    call realloc (KY_VALUES(key), KY_NSTORE(key) * KY_SZPAR, TY_CHAR)
+	    call realloc (KY_UNITS(key), KY_NSTORE(key) * KY_SZPAR, TY_CHAR)
+	    call realloc (KY_FORMATS(key), KY_NSTORE(key) * KY_SZPAR, TY_CHAR)
+	    call realloc (KY_NELEMS(key), KY_NSTORE(key), TY_INT)
+	    call aclri (Memi[KY_NELEMS(key)+onstore], KY_NSTORE(key) - onstore)
+	    call realloc (KY_PTRS(key), KY_NSTORE(key), TY_INT)
+	    call aaddki (Memi[KY_PTRS(key)], KY_VALUES(key) - optr,
+	        Memi[KY_PTRS(key)], onstore)
+	    call amovki (NULL, Memi[KY_PTRS(key)+onstore], KY_NSTORE(key) -
+	        onstore)
+	    call realloc (KY_TYPES(key), KY_NSTORE(key), TY_INT)
+	    call realloc (KY_KINDICES(key), KY_NSTORE(key), TY_INT)
+	    call realloc (KY_UINDICES(key), KY_NSTORE(key), TY_INT)
+	    call realloc (KY_FINDICES(key), KY_NSTORE(key) + 1, TY_INT)
+	}
+
+	# Allocate space for the keywords.
+	call smark (sp)
+	call salloc (id, KY_SZPAR, TY_CHAR)
+	call salloc (keyword, KY_SZPAR, TY_CHAR)
+	call salloc (equals, KY_SZPAR, TY_CHAR)
+	call salloc (value, KY_SZPAR, TY_CHAR)
+	call salloc (units, KY_SZPAR, TY_CHAR)
+	call salloc (format, KY_SZPAR, TY_CHAR)
+	call salloc (temp, KY_SZPAR, TY_CHAR)
+
+	# Scan the string and decode the elements.
+	call sscan (line)
+	    call gargwrd (Memc[id], KY_SZPAR)
+	    call gargwrd (Memc[keyword], KY_SZPAR)
+	    call gargwrd (Memc[equals], KY_SZPAR)
+	    call gargwrd (Memc[value], KY_SZPAR)
+	    call gargwrd (Memc[units], KY_SZPAR)
+	    call gargwrd (Memc[format], KY_SZPAR)
+
+	# Return if insufficient number of elements.
+	if (nscan() < 6) {
+	    call sfree (sp)
+	    return
+	}
+
+	# Add the parameters.
+	index = strdic (Memc[keyword], Memc[temp], KY_SZPAR,
+	    Memc[KY_WORDS(key)])
+	if (index == 0) {
+	    KY_NPKEYS(key) = KY_NPKEYS(key) + 1
+	    KY_NKEYS(key) = KY_NKEYS(key) + 1
+	    Memi[KY_NELEMS(key)+KY_NKEYS(key)-1] = 1 
+	    call pt_kykeywrd (Memc[keyword], KY_SZPAR, LEN_KWORDS(key),
+	        Memc[KY_WORDS(key)])
+	    call pt_kyunits (Memc[units], KY_SZPAR, Memc[KY_UNITS(key)],
+	        Memi[KY_UINDICES(key)], KY_NKEYS(key))
+	    call pt_kyformat (Memc[format], KY_SZPAR, Memc[KY_FORMATS(key)],
+	        Memi[KY_FINDICES(key)], Memi[KY_TYPES(key)], Memi[KY_PTRS(key)],
+		Memi[KY_KINDICES(key)], KY_NKEYS(key))
+	    call pt_kyvalue (Memc[value], KY_SZPAR, Memc[KY_VALUES(key)],
+	        Memi[KY_PTRS(key)], Memi[KY_KINDICES(key)], KY_NKEYS(key))
+        } else
+	    call pt_kyaddval (Memc[value], KY_SZPAR, Memc[KY_VALUES(key)],
+		Memi[KY_PTRS(key)], Memi[KY_KINDICES(key)], index)
+
+	call sfree (sp)
+end
+
+
+# PT_KYKEYWRD -- Procedure to encode a single keyword into the keyword
+# dictionary.
+
+procedure pt_kykeywrd (keyword, maxch, klength, kdic)
+
+char	keyword[ARB]	# the keyword to be added to the list
+int	maxch		# maximum length of keyword
+int	klength		# the current length of the dictionary
+char	kdic[ARB]	# the keyword dictionary
+
+int	kp, ip
+
+begin
+	# Insert leading , for record delimiter.
+	kp = klength + 1
+	if (kp == 1) {
+	    kdic[kp] = ','
+	    kp = kp + 1
+	}
+
+	# Copy the keyword.
+	for (ip = 1; ip <= maxch && keyword[ip] != EOS; ip = ip + 1) {
+	    kdic[kp] = keyword[ip]
+	    kp = kp + 1
+	}
+	kdic[kp] = ','
+	kdic[kp+1] = EOS
+
+	klength = kp
+end
+
+
+# PT_KYUNITS -- Procedure to add a units name to the units string.
+
+procedure pt_kyunits (ustr, maxch, units, uindices, nkey)
+
+char	ustr[ARB]	# units string
+int	maxch		# max length of units string
+char	units[ARB]	# units string
+int	uindices[ARB]	# units indices
+int	nkey		# current unit
+
+int	ip, up
+
+begin
+	# Get initial position.
+	if (nkey == 1)
+	    up = 1
+	else
+	    up = uindices[nkey-1] + 1
+
+	# Copy the units string.
+	for (ip = 1; ip <= maxch && ustr[ip] != EOS; ip = ip + 1) {
+	    units[up] = ustr[ip]
+	    up = up + 1
+	}
+	units[up] = EOS
+
+	uindices[nkey] = up - 1
+end
+
+
+# PT_KYFORMAT -- Procedure to encode the formats and field widths.
+
+procedure pt_kyformat (fstr, maxch, formats, findices, types, ptrs, fields,
+	key)
+
+char	fstr[ARB]		# format string
+int	maxch			# maximum number of characters
+char	formats[ARB]		# format string
+int	findices[ARB]		# string pointers
+int	types[ARB]		# data type of key
+pointer	ptrs[ARB]		# array of pointers
+int	fields[ARB]		# integer field widths
+int	key			# key number
+
+char	cjunk
+int	ip, fp, fwidth, junk, ftype
+int	pt_kyfstr(), strlen()
+
+begin
+	# Set the pointer.
+	if (key > 1)
+	    ptrs[key] = ptrs[key-1] + fields[key-1]
+
+	# Find the initial position.
+	if (key == 1)
+	    fp = 1
+	else
+	    fp = findices[key-1] + 1
+
+	# Crack the format string.
+	if (pt_kyfstr (fstr, fwidth, junk, ftype, cjunk) == ERR) {
+	    fields[key] = KY_SZPAR
+	    types[key] = TY_CHAR
+	    #if (key > 1)
+		#ptrs[key] = ptrs[key-1] + fwidth
+	    call sprintf (formats[fp], maxch, "%s%ds")
+		call pargstr ("%")
+		call pargi (-KY_SZPAR)
+	    fp = fp + strlen (formats[fp])
+	} else {
+	    fields[key] = fwidth
+	    types[key] = ftype
+	    #if (key > 1)
+		#ptrs[key] = ptrs[key-1] + fields[key-1]
+	    for (ip = 1; ip <= maxch && fstr[ip] != EOS; ip = ip + 1) {
+	        formats[fp] = fstr[ip]
+	        fp = fp + 1
+	    }
+	    formats[fp] = EOS
+	}
+
+	findices[key] = fp - 1
+end
+
+
+# PT_KYVALUE -- Procedure to store the parameter value.
+
+procedure pt_kyvalue (vstr, maxch, values, ptrs, kindices, key)
+
+char	vstr[ARB]	# value string
+int	maxch		# maximum number of characters
+char	values[ARB]	# values string
+pointer	ptrs[ARB]	# array of pointers
+int	kindices[ARB]	# storage points in the string
+int	key		# parameter
+
+int	ip, vp
+
+begin
+	# Find the initial position.
+	if (key == 1)
+	    vp = 1
+	else
+	    vp = ptrs[key] - ptrs[1] + 1
+
+	# Copy the value string.
+	for (ip = 1; ip <= maxch && vstr[ip] != EOS; ip = ip + 1) {
+	    values[vp] = vstr[ip]
+	    vp = vp + 1
+	}
+	for (; ip <= kindices[key]; ip = ip + 1) {
+	    values[vp] = ' '
+	    vp = vp + 1
+	}
+	values[vp] = EOS
+end
+
+
+# PT_KYADDVAL -- Change the value of an existing keyword.
+
+procedure pt_kyaddval (vstr, maxch, values, ptrs, kindices, key)
+
+char	vstr[ARB]	# value string
+int	maxch		# maximum number of characters
+char	values[ARB]	# values string
+pointer	ptrs[ARB]	# array of pointers
+int	kindices[ARB]	# storage points in the string
+int	key		# parameter
+
+int	ip, vp
+
+begin
+	# Find the initial position.
+	if (key == 1)
+	    vp = 1
+	else
+	    vp = ptrs[key] - ptrs[1] + 1
+
+	# Insert the new value.
+	for (ip = 1; ip <= maxch && vstr[ip] != EOS; ip = ip + 1) {
+	    values[vp] = vstr[ip]
+	    vp = vp + 1
+	}
+	for (; ip <= kindices[key]; ip = ip + 1) {
+	    values[vp] = ' '
+	    vp = vp + 1
+	}
+end
+
+
+# PT_KYFSTR -- Procedure to decode the format string.
+
+int procedure pt_kyfstr (fstr, width, precision, type, ctype)
+
+char	fstr[ARB]	# format string
+int	width		# field width
+int	precision	# precision
+int	type		# data type
+char	ctype		# char format type
+
+int	ip
+int	ctoi
+
+begin
+	if (fstr[1] != '%')
+	    return (ERR)
+
+	# Get the field width.
+	ip = 2
+	if (ctoi (fstr, ip, width) == ERR)
+	    return (ERR)
+	width = abs (width)
+
+	# Get the precision.
+	if (fstr[ip] == '.')
+	    ip = ip + 1
+	if (ctoi (fstr, ip, precision) == ERR)
+	    precision = 0
+	
+	# Get the datatype.
+	if (fstr[ip] == 'f' || fstr[ip] == 'g') {
+	    type = TY_REAL
+	    ctype = fstr[ip]
+	} else if (fstr[ip] == 'd') {
+	    type = TY_INT
+	    ctype = 'd'
+	} else if (fstr[ip] == 's') {
+	    type = TY_CHAR
+	    ctype = 's'
+	} else if (fstr[ip] == 'b') {
+	    type = TY_BOOL
+	    ctype = 'b'
+	} else
+	    return (ERR)
+	return (OK)
+end
+
+
+# PT_KYTYPE -- Procedure to get the data type of a field.
+
+int procedure pt_kytype (key, field, root, ranges, maxels)
+
+pointer	key		# pointer to field strucuture
+char	field[ARB]	# field for which type is to be extracted
+char	root[ARB]	# root variable name
+char	ranges[ARB]	# range of selected elements
+int	maxels		# maximum number of elements
+
+char	left_bkt, right_bkt
+int	findex, lindex, index
+pointer	sp, temp
+int	stridx(), strdic()
+data	left_bkt /'['/, right_bkt /']'/
+
+begin
+	# Allocate working space.
+	call smark (sp)
+	call salloc (temp, SZ_FNAME, TY_CHAR)
+	root[1] = EOS
+	ranges[1] = EOS
+
+	# Get the root name.
+	findex = stridx (left_bkt, field)
+	if (findex == 0)
+	    call strcpy (field, root, SZ_FNAME)
+	else
+	    call strcpy (field, root, findex - 1)
+
+	# Find the appropriate keyword.
+        index = strdic (root, Memc[temp], SZ_LINE, Memc[KY_WORDS(key)])
+	call sfree (sp)
+
+	# Return the root, ranges and type.
+	if (index != 0) {
+	    maxels = Memi[KY_NELEMS(key)+index-1]
+	    lindex = stridx (right_bkt, field)
+	    if ((lindex - findex - 1) > 0)
+		call strcpy (field[findex+1], ranges, lindex - findex - 1)
+	    if (ranges[1] == EOS && maxels > 1)
+		call sprintf (ranges, SZ_FNAME, "1-%d")
+		    call pargi (maxels)
+	    return (Memi[KY_TYPES(key)+index-1])
+	} else
+	    call error (0, "Unknown keyword in expression")
+end
+
+
+# PT_KYBOOL -- Procedure to get a boolean parameter.
+
+bool procedure pt_kybool (key, field, element)
+
+pointer	key		# pointer to keys structure
+char	field[ARB]	# parameter name
+int	element		# element of int array
+
+int	index
+pointer	sp, temp, ptr
+int	strmatch()
+pointer	strdic()
+
+begin
+	call smark (sp)
+	call salloc (temp, SZ_LINE, TY_CHAR)
+	index = strdic (field, Memc[temp], SZ_LINE, Memc[KY_WORDS(key)])
+	call sfree (sp)
+
+	if (index != 0) {
+	    if (Memi[KY_NELEMS(key)+index-1] == 1)
+		ptr = Memi[KY_PTRS(key)+index-1]
+	    else
+		ptr = Memi[KY_PTRS(key)+index-1] + (element - 1) *
+		    Memi[KY_KINDICES(key)+index-1]
+	    if (strmatch (Memc[ptr], "yes") == 0)
+		return (false)
+	    else
+	        return (true)
+	} else
+	    call error (0, "Unknown boolean keyword in expression")
+end
+
+
+# PT_KYINTEGER -- Procedure to get an integer parameter.
+
+int procedure pt_kyinteger (key, field, element)
+
+pointer	key		# pointer to keys structure
+char	field[ARB]	# parameter name
+int	element		# element of int array
+
+int	index, ip, ival
+pointer	sp, temp, ptr
+int	ctoi()
+pointer	strdic()
+
+begin
+	call smark (sp)
+	call salloc (temp, SZ_LINE, TY_CHAR)
+	index = strdic (field, Memc[temp], SZ_LINE, Memc[KY_WORDS(key)])
+	call sfree (sp)
+
+	if (index != 0) {
+	    if (Memi[KY_NELEMS(key)+index-1] == 1)
+		ptr = Memi[KY_PTRS(key)+index-1]
+	    else
+		ptr = Memi[KY_PTRS(key)+index-1] + (element - 1) *
+		    Memi[KY_KINDICES(key)+index-1]
+	    ip = 1
+	    if (ctoi (Memc[ptr], ip, ival) == 0)
+		call error (0, "Cannot decode integer parameter")
+	    else
+		return (ival)
+	} else
+	    call error (0, "Unknown integer keyword in expression")
+end
+
+
+# PT_KYREAL -- Procedure to get a real parameter.
+
+real procedure pt_kyreal (key, field, element)
+
+pointer	key		# pointer to keys structure
+char	field[ARB]	# parameter name
+int	element		# which element to extract
+
+int	index, ip
+pointer	sp, temp, ptr
+real	rval
+int	ctor()
+pointer	strdic()
+
+begin
+	call smark (sp)
+	call salloc (temp, SZ_LINE, TY_CHAR)
+	index = strdic (field, Memc[temp], SZ_LINE, Memc[KY_WORDS(key)])
+	call sfree (sp)
+
+	if (index != 0) {
+	    if (Memi[KY_NELEMS(key)+index-1] == 1)
+		ptr = Memi[KY_PTRS(key)+index-1]
+	    else
+		ptr = Memi[KY_PTRS(key)+index-1] + (element - 1) *
+		    Memi[KY_KINDICES(key)+index-1]
+	    ip = 1
+	    if (ctor (Memc[ptr], ip, rval) <= 0)
+		call error (0, "Cannot decode real parameter")
+	    else
+		return (rval)
+	} else
+	    call error (0, "Unknown real keyword in expression")
+end
+
+
+# PT_KYSTR -- Procedure to get a string parameter.
+
+procedure pt_kystr (key, field, element, str, maxch)
+
+pointer	key		# pointer to keys structure
+char	field[ARB]	# parameter name
+int	element		# element of the array
+char	str[ARB]	# output string
+int	maxch		# maximum number of character
+
+int	index, nk
+pointer	sp, temp, ptr
+pointer	strdic()
+
+begin
+	call smark (sp)
+	call salloc (temp, SZ_LINE, TY_CHAR)
+	index = strdic (field, Memc[temp], SZ_LINE, Memc[KY_WORDS(key)])
+	call sfree (sp)
+
+	if (index != 0) {
+	    if (Memi[KY_NELEMS(key)+index-1] == 1)
+		ptr = Memi[KY_PTRS(key)+index-1]
+	    else
+		ptr = Memi[KY_PTRS(key)+index-1] + (element - 1) *
+		    Memi[KY_KINDICES(key)+index-1]
+	    for (; Memc[ptr] == ' ';)
+		ptr = ptr + 1
+	    for (nk = 0; Memc[ptr+nk] != ' '; nk = nk + 1)
+		;
+	    call strcpy (Memc[ptr], str, min (nk, maxch))
+	} else
+	    call error (0, "Unknown string keyword in expression")
+end