Repatch (from linux) of OSX IRAF

1 files changed, 273 insertions, 0 deletions

diff --git a/noao/digiphot/photcal/parser/prcode.x b/noao/digiphot/photcal/parser/prcode.x
new file mode 100644
index 00000000..dfdb95fb
--- /dev/null
+++ b/noao/digiphot/photcal/parser/prcode.x
@@ -0,0 +1,273 @@
+.help prcode
+Parser code generator
+
+The parser generates code for all the equations in the symbol table in
+Reverse Polish Notation (RPN). Under this notation, operands are pushed
+into a stack, until an operation comes up. The operation takes as many stack
+places (from the stack top) it needs as arguments, and places the result
+in the top of the stack. The final result will be always in the top of
+the stack.
+.sp
+In the current implemantation, arguments can be either constants, catalog
+variables, observational variables, parameters, and equations (extinction
+and transformation). The latter argument is a recursive call to other equation.
+Operations can take only one or two stack places as arguments.
+.sp
+The instructions generated by the parser can be of one or two words.
+The first word is always an integer, and identifies the operation to be
+performed. If the operation is a "push" of a quantity into the stack,
+the second word must contain the value (real) or index (integer) of
+the quantity. The real value is used for constants, and index is used
+for variables and parameters.
+.sp
+The RPN instructions are stored into memory as a dinamically allocated
+buffer of structure type (TY_STRUCT), since it may contain integer and
+real numbers.
+.sp
+The procedures provided here are called by the parser, to generate code
+for each expression (formula) found. The following entry points are
+defined:
+
+.nf
+	pr_calloc ()			Allocate space for temp. code buffer
+	pr_cfree ()			Deallocate code buffer
+	pr_cinit ()			Begin code generation
+	pr_cend (ptr)			End code generation
+	pr_cgen (token, id, value)	Generate code for parser token
+pointer pr_cput (code, len)		Create and copy code buffer
+.endhelp
+
+include	"../lib/lexer.h"
+include	"../lib/parser.h"
+include	"../lib/prtoken.h"
+include	"../lib/preval.h"
+
+
+# PR_CALLOC - Allocate code buffer
+
+procedure pr_calloc ()
+
+include	"prcode.com"
+
+begin
+	# Allocate code buffer
+	call malloc (code, LEN_CODE, TY_STRUCT)
+end
+
+
+# PR_CFREE - Free code buffer
+
+procedure pr_cfree ()
+
+include	"prcode.com"
+
+begin
+	# Free buffer in common
+	call mfree (code, TY_STRUCT)
+end
+
+
+# PR_CINIT - Start code generation
+
+procedure pr_cinit ()
+
+include	"prcode.com"
+
+begin
+	# Set next free instruction be the first
+	cp = 1
+end
+
+
+# PR_CEND - Finish code generation
+
+procedure pr_cend (ptr)
+
+pointer	ptr		# lexer symbol pointer
+
+include	"prcode.com"
+
+begin
+	# Put the end-of-code marker in
+	# the next instruction
+	Memi[code + cp - 1] = PEV_EOC
+
+	# Set code length
+	LEX_CLEN (ptr) = cp
+
+	# Copy the code buffer into the lexer symbol
+	call amovi (Memi[code], Memi[LEX_CODE (ptr)], cp)
+
+	# Reset code counter to the first
+	# instruction
+	cp = 1
+end
+
+
+# PR_CGEN - Generate RPN code.
+
+procedure pr_cgen (token, id, value)
+
+int	token			# lexer token
+char	id[ARB]			# lexer identifier
+real	value			# lexer value
+
+char	aux[SZ_LINE]
+int	offset, sym, type
+
+include	"prcode.com"
+
+int	pr_geti(), pr_gsymi()
+pointer	pr_getsym()
+
+begin
+	# Generate code for the current instruction according
+	# with token value returned by the lexer
+	switch (token) {
+
+	case IDENTIFIER:
+
+	    # Find the identifier in the symbol table, and store
+	    # the appropiate instruction code, and number, according
+	    # with the symbol type. If the identifier is not found in
+	    # the symbol table no code is generated, and no error
+	    # action is taken. The latter is to avoid stopping the
+	    # parser and allow some error recovery.
+	    # Also compute an offset to add later to the symbol number.
+	    # In catalog variables an offset is necessary because the
+	    # expression evaluator has only ONE table with variable
+	    # values, with catalog variables at the end.
+	    sym = pr_getsym (id)
+	    if (!IS_INDEFI (sym)) {
+
+		# Get symbol type and take action acordingly
+		type = pr_gsymi (sym, PSYMTYPE)
+		switch (type) {
+		case PTY_OBSVAR:
+		    Memi[code + cp - 1] = PEV_OBSVAR
+		    offset = 0
+		case PTY_CATVAR:
+		    Memi[code + cp - 1] = PEV_CATVAR
+		    offset = pr_geti (NOBSVARS)
+		case PTY_FITPAR, PTY_CONST:
+		    Memi[code + cp - 1] = PEV_PARAM
+		    offset = 0
+		case PTY_SETEQ:
+		    Memi[code + cp - 1] = PEV_SETEQ
+		    offset = 0
+		case PTY_EXTEQ:
+		    Memi[code + cp - 1] = PEV_EXTEQ
+		    offset = 0
+		case PTY_TRNEQ:
+		    Memi[code + cp - 1] = PEV_TRNEQ
+		    offset = 0
+		default:
+		    call sprintf (aux, SZ_LINE,
+			"pr_cgen: Illegal symbol type (%d)")
+			call pargi (type)
+		    call error (0, aux)
+		}
+
+		# Store symbol number, plus the offset, in next instruction
+		cp = cp + 1
+		Memi[code + cp - 1] = pr_gsymi (sym, PSYMNUM) + offset
+
+	    }
+
+	case INUMBER, RNUMBER:
+
+	    # Store number instruction code and the number
+	    # value in the next instruction
+	    Memi[code + cp - 1] = PEV_NUMBER
+	    cp = cp + 1
+	    Memr[code + cp - 1] = value
+
+	case UPLUS:
+	    Memi[code + cp - 1] = PEV_UPLUS
+
+	case UMINUS:
+	    Memi[code + cp - 1] = PEV_UMINUS
+
+	case PLUS:
+	    Memi[code + cp - 1] = PEV_PLUS
+
+	case MINUS:
+	    Memi[code + cp - 1] = PEV_MINUS
+
+	case STAR:
+	    Memi[code + cp - 1] = PEV_STAR
+
+	case SLASH:
+	    Memi[code + cp - 1] = PEV_SLASH
+
+	case EXPON:
+	    Memi[code + cp - 1] = PEV_EXPON
+
+	case F_ABS:
+	    Memi[code + cp - 1] = PEV_ABS
+
+	case F_ACOS:
+	    Memi[code + cp - 1] = PEV_ACOS
+
+	case F_ASIN:
+	    Memi[code + cp - 1] = PEV_ASIN
+
+	case F_ATAN:
+	    Memi[code + cp - 1] = PEV_ATAN
+
+	case F_COS:
+	    Memi[code + cp - 1] = PEV_COS
+
+	case F_EXP:
+	    Memi[code + cp - 1] = PEV_EXP
+
+	case F_LOG:
+	    Memi[code + cp - 1] = PEV_LOG
+
+	case F_LOG10:
+	    Memi[code + cp - 1] = PEV_LOG10
+
+	case F_SIN:
+	    Memi[code + cp - 1] = PEV_SIN
+
+	case F_SQRT:
+	    Memi[code + cp - 1] = PEV_SQRT
+
+	case F_TAN:
+	    Memi[code + cp - 1] = PEV_TAN
+
+	default:
+	    call error (0, "pr_cgen: Illegal instruction")
+	}
+
+	# Count codes, and check boundaries. Reserve at
+	# least three places: two for the next instruction,
+	# and one for the end-of-code marker
+	cp = cp + 1
+	if (cp > LEN_CODE - 2)
+	    call error (0, "pr_cgen: Too much code")
+end
+
+
+# PR_CPUT - Allocate space for a code buffer, copy given code bufer into
+# it, and return pointer to it
+
+pointer procedure pr_cput (code, len)
+
+pointer	code		# code buffer
+int	len		# code length
+
+pointer	aux
+
+begin
+	# Check pointer
+	if (code == NULL)
+	    call error (0, "pr_cput: Null code pointer")
+
+	# Allocate memory for code and copy code buffer into it
+	call malloc (aux, len, TY_STRUCT)
+	call amovi (Memi[code], Memi[aux], len)
+
+	# Return new buffer pointer
+	return (aux)
+end