Repatch (from linux) of OSX IRAF

1 files changed, 539 insertions, 0 deletions

diff --git a/sys/gio/stdgraph/stgencode.x b/sys/gio/stdgraph/stgencode.x
new file mode 100644
index 00000000..3c7a6ffb
--- /dev/null
+++ b/sys/gio/stdgraph/stgencode.x
@@ -0,0 +1,539 @@
+# Copyright(c) 1986 Association of Universities for Research in Astronomy Inc.
+
+include	<ctype.h>
+include	"stdgraph.h"
+
+.help stg_encode
+.nf _________________________________________________________________________
+STG_ENCODE -- Table driven binary encoder/decoder.  The encoder (which can
+also decode) processes a format string, also referred to as a program, to
+either encode an output string or decode an input string.  Internally the
+encoder operates in two modes, copy mode and execute mode.  In copy mode
+all format characters are copied to the output except the following special
+characters:
+
+	'	escape next character (literal)
+	%	begin a formatted output string
+	(	switch to execute mode (stack driven, RPN interpreter)
+
+An ( appearing in the format string causes a mode switch to execute mode.
+In execute mode characters are metacode instructions to be executed.  An
+unescaped ) causes reversion to copy mode.  Parens may not be nested; an
+( in execute mode is an instruction to push the binary value of ( on the
+stack, and an ) in copy mode is copied to the output as a character.  In
+execute mode the following characters are recognized as special instructions.
+All other characters are instructions too, telling the encoder to push the
+ASCII value of the character on the stack.
+
+	'	escape next character (recognized everywhere)
+	%	formatted output
+	)	revert to copy mode
+	#nnn	push signed decimal integer number nnn
+	$ 	switch case construct
+	.	pop number from stack and place in output string
+	,	get next character from input string and push on stack
+	&	modulus (similar to AND of low bits)
+	+	add (similar to OR)
+	-	subtract (similar to AND)
+	*	multiply (shift left if pwr of 2)
+	/	divide (shift right if pwr of 2)
+	<	less than (0=false, 1=true)
+	> 	greater than (0=false, 1=true)
+	=	equals (0=false, 1=true)
+	;	branch if: <bool> <offset> ;.  The ; is at offset zero.
+       0-9	push register
+	!N	pop stack into register N
+	!!	pop N from stack and output an N millisecond delay
+
+The encoder communicates with the outside world via three general purpose
+data structures.
+
+	registers	0-9 (integer only)
+	memory		char array
+	program		char array
+
+The registers are used for parameter input and output as well as for storing
+intermediate results.  R 1-3 are used for input and output arguments.  R 4-9
+and R0 (R10) are reserved for use by the program.  R11 is the i/o pointer into
+encoder memory, used for character input and output.  R12 should contain the
+maximum memory address upon input.  Memory may be used for anything but is
+normally used only for the input string or output string.  The program is the
+format string.
+
+Further documentation is given in the GIO reference manual.
+.endhelp _____________________________________________________________________
+
+define	SZ_FORMAT	10		# max length printf format
+define	SZ_NUMSTR	10		# encoded numeric string
+
+define	R1	registers[1]		# argument
+define	R2	registers[2]		# argument
+define	R3	registers[3]		# argument
+define	R4	registers[4]		# scratch
+define	R5	registers[5]		# scratch
+define	R6	registers[6]		# scratch
+define	R7	registers[7]		# scratch
+define	R8	registers[8]		# scratch
+define	R9	registers[9]		# scratch
+define	R0	registers[10]		# scratch
+define	IOP	registers[11]		# i/o pointer into encoder memory
+define	TOP	registers[12]		# max memory location
+
+# Inline macros.
+
+define	memory_overflow_	1
+define	stack_underflow_	2
+define	stack_overflow_		3
+
+define	input	{$1=memory[iop];iop=iop+1}
+define	output	{memory[iop]=($1);iop=iop+1;if(iop>top)goto memory_overflow_}
+define	push	{stack[sp]=($1);sp=sp+1}
+define	pop	{sp=sp-1;$1=stack[sp]}
+
+
+# STG_ENCODE -- Interpret a program, encoding values passed in registers into
+# memory, or decoding memory into registers.
+
+int procedure stg_encode (program, memory, registers)
+
+char	program[ARB]			# program to be executed
+char	memory[ARB]			# data space
+int	registers[NREGISTERS]		# general purpose registers
+
+int	x, y, num, ch, status
+int	stack[LEN_STACK]
+int	sp, pc, iop, top, incase
+common	/sgecom/ pc, sp, iop, top, incase, stack
+int	sge_execute()
+include	"stdgraph.com"
+
+begin
+	# TEK format, %t.  This format deserves special treatment due to the
+	# prevalence of tektronix compatible graphics terminals.
+
+	if (program[1] == '%' && program[2] == 't') {
+	    x = R1
+	    y = R2
+	    iop = IOP + 4
+	    if (iop > top)
+		goto memory_overflow_
+
+	    memory[iop-4] = g_hixy[y+1]
+	    memory[iop-3] = g_loy[y+1]
+	    memory[iop-2] = g_hixy[x+1]
+	    memory[iop-1] = g_lox[x+1]
+
+	    IOP = iop
+	    if (program[3] == EOS)
+		return (OK)
+	}
+
+	# Process a general format string (as well as any chars following the
+	# %t format).
+
+	incase = NO
+	iop    = IOP
+	top    = TOP
+	pc     = 1
+	sp     = 1
+
+	for (ch=program[pc];  ch != EOS;  ch=program[pc]) {
+	    pc = pc + 1
+	    if (ch == '%' && program[pc] != EOS) {
+		if (program[pc] == 't') {
+		    # Tek format again.
+		    pc = pc + 1
+		    x = R1
+		    y = R2
+		    iop = iop + 4
+		    if (iop > top)
+			goto memory_overflow_
+
+		    memory[iop-4] = g_hixy[y+1]
+		    memory[iop-3] = g_loy[y+1]
+		    memory[iop-2] = g_hixy[x+1]
+		    memory[iop-1] = g_lox[x+1]
+
+		} else {
+		    # Extract a general format specification and use it to
+		    # encode the number on top of the stack.
+		    pop (num)
+		    if (sp < 1) {
+			IOP = iop
+			return (stack_underflow_)
+		    } else
+			call sge_printf (num, memory, iop, top, program, pc)
+		}
+
+	    } else if (ch == '(' && program[pc] != EOS) {
+		# Switch to execute mode.
+		status = sge_execute (program, memory, registers)
+		if (status != OK)
+		    return (status)
+
+	    } else if (ch == '\'' && program[pc] != EOS) {
+		# Escape next character.
+		output (program[pc])
+		pc = pc + 1
+
+	    } else {
+		# Copy an ordinary character to the output string.
+		output (ch)
+	    }
+	}
+
+	IOP = iop
+	return (OK)
+
+memory_overflow_
+	IOP = iop
+	return (memory_overflow_)
+end
+
+
+# SGE_EXECUTE -- Execute a metacode program stored in encoder memory starting
+# at the location of the PC.  The stack, program counter, i/o pointer, and
+# registers are shared by the copy and execute mode procedures via common.
+
+int procedure sge_execute (program, memory, registers)
+
+char	program[ARB]			# program to be executed
+char	memory[ARB]			# data space
+int	registers[NREGISTERS]		# general purpose registers
+
+int	num, ch, a, b, neg, x, y
+int	stack[LEN_STACK]
+int	sp, pc, iop, top, incase, msec, npad, baud, envgeti(), btoi()
+common	/sgecom/ pc, sp, iop, top, incase, stack
+include	"stdgraph.com"
+errchk	envgeti
+
+begin
+	# Execute successive single character instructions until either ) or
+	# EOS is seen.  On a good host machine this case will be compiled as
+	# a vectored goto with a loop overhead of only a dozen or so machine
+	# instructions per loop.
+
+	for (ch=program[pc];  ch != EOS;  ch=program[pc]) {
+	    pc = pc + 1
+
+	    switch (ch) {
+	    case '\'':
+		# Escape next character (recognized everywhere).
+		ch = program[pc]
+		if (ch != EOS) {
+		    # Push ASCII value of character.
+		    push (ch)
+		    pc = pc + 1
+		}
+
+	    case '%':
+		if (program[pc] == 't') {
+		    # Tek format again.
+		    pc = pc + 1
+		    x = R1
+		    y = R2
+		    iop = iop + 4
+		    if (iop > top)
+			goto memory_overflow_
+
+		    memory[iop-4] = g_hixy[y+1]
+		    memory[iop-3] = g_loy[y+1]
+		    memory[iop-2] = g_hixy[x+1]
+		    memory[iop-1] = g_lox[x+1]
+
+		} else {
+		    # Formatted output.
+		    if (program[pc] != EOS) {
+			pop (num)
+			call sge_printf (num, memory, iop, top, program, pc)
+		    } else
+			output (ch)
+		}
+
+	    case ')':
+		# End interpreter mode.
+		return (OK)
+
+	    case '#':
+		# Push signed decimal integer number.
+		neg = NO
+		if (program[pc] == '-') {
+		    neg = YES
+		    pc = pc + 1
+		}
+
+		num = 0
+		while (IS_DIGIT (program[pc])) {
+		    num = num * 10 + TO_INTEG (program[pc])
+		    pc = pc + 1
+		}
+
+		if (neg == YES)
+		    push (-num)
+		else
+		    push (num)
+
+	    case '$':
+		# Switch case instruction.
+
+		if (incase == NO) {
+		    # Pop the switch off the stack.
+		    pop (num)
+
+		    # Search for case number 'num'.
+		    for (ch=program[pc];  ch != EOS;  ch=program[pc]) {
+			if (ch == '$') {
+			    # End of switch statement.
+			    pc = pc + 1
+			    incase = NO
+			    break
+
+			} else if (program[pc+1] == '-') {
+			    # Range of cases.
+			    a = TO_INTEG (ch)
+			    b = TO_INTEG (program[pc+2])
+			    pc = pc + 3
+			    if (a <= num && num <= b) {
+				incase = YES
+				break
+			    }
+			} else if (ch == 'D' || TO_INTEG(ch) == num) {
+			    # Default or requested case.
+			    pc = pc + 1
+			    incase = YES
+			    break
+
+			}
+
+			# Advance to the next case.  Leave pc pointing to the
+			# N of case $N.
+
+			if (ch != '$' && incase == NO) {
+			    while (program[pc] != EOS && program[pc] != '$')
+				pc = pc + 1
+			    if (program[pc] == '$')
+				pc = pc + 1
+			}
+		    }
+
+		} else {
+		    # $ encountered delimiting a case.  Search forward for
+		    # $$ or EOS.
+
+		    if (program[pc] != '$')
+			for (ch=program[pc];  ch != EOS;  ch=program[pc]) {
+			    pc = pc + 1
+			    if (ch == '$' && program[pc] == '$')
+				break
+			}
+
+		    if (program[pc] == '$')
+			pc = pc + 1
+
+		    incase = NO
+		}
+
+	    case '.':
+		# Pop number from stack and place in output string as a
+		# binary character.
+		pop (num)
+		output (num)
+
+	    case ',':
+		# Get next character from input string and push on stack.
+		input (num)
+		push (num)
+
+	    case '&':
+		# Modulus (similar to AND of low bits).
+		pop (b)
+		pop (a)
+		push (mod (a, b))
+
+	    case '+':
+		# Add (similar to OR).
+		pop (b)
+		pop (a)
+		push (a + b)
+
+	    case '-':
+		# Subtract (similar to AND).
+		pop (b)
+		pop (a)
+		push (a - b)
+
+	    case '*':
+		# Multiply (shift left if pwr of 2).
+		pop (b)
+		pop (a)
+		push (a * b)
+
+	    case '/':
+		# Divide (shift right if pwr of 2).
+		pop (b)
+		pop (a)
+		push (a / b)
+
+	    case '<':
+		# Less than (0=false, 1=true).
+		pop (b)
+		pop (a)
+		push (btoi (a < b))
+
+	    case '>':
+		# Greater than (0=false, 1=true).
+		pop (b)
+		pop (a)
+		push (btoi (a > b))
+
+	    case '=':
+		# Equals (0=false, 1=true).
+		pop (b)
+		pop (a)
+		push (btoi (a == b))
+
+	    case ';':
+		# If 2nd value on stack is true add 1st value on stack to PC.
+		# Example: "12<#-8;".  The ; is at offset zero.
+		pop (a)
+		pop (b)
+		if (b != 0)
+		    pc = pc - 1 + a
+
+	    case '0':
+		# Push contents of register 0 (10).
+		push (R0)
+	    case '1':
+		# Push contents of register 1.
+		push (R1)
+	    case '2':
+		# Push contents of register 2.
+		push (R2)
+	    case '3':
+		# Push contents of register 3.
+		push (R3)
+	    case '4':
+		# Push contents of register 4.
+		push (R4)
+	    case '5':
+		# Push contents of register 5.
+		push (R5)
+	    case '6':
+		# Push contents of register 6.
+		push (R6)
+	    case '7':
+		# Push contents of register 7.
+		push (R7)
+	    case '8':
+		# Push contents of register 8.
+		push (R8)
+	    case '9':
+		# Push contents of register 9.
+		push (R9)
+
+	    case '!':
+		if (program[pc] == '!') {
+		    # !!: Pop stack and generate delay.
+		    pc = pc + 1
+		    pop (msec)
+		    iferr (baud = envgeti ("ttybaud"))
+			baud = 9600
+		    npad = real(msec) * (real(baud) / 8. / 1000.)
+		    while (npad > 0) {
+			output (PADCHAR)
+			npad = npad - 1
+		    }
+		} else {
+		    # !N: Pop stack into register N.
+		    num = TO_INTEG (program[pc])
+		    if (num >= 0 && num <= 9) {
+			if (num == 0)
+			    num = 10
+			pop (registers[num])
+			pc = pc + 1
+		    } else
+			output (ch)
+		}
+
+	    default:
+		# Push ASCII value of character.
+		push (ch)
+	    }
+
+	    if (sp <= 0)
+		return (stack_underflow_)
+	    if (sp > LEN_STACK)
+		return (stack_overflow_)
+	}
+
+	return (OK)
+
+memory_overflow_
+	return (memory_overflow_)
+end
+
+
+# SGE_PRINTF -- Process a %.. format specification.  The number to be encoded
+# has already been popped from the stack into the first argument.  The encoded
+# number is returned in memory at IOP, leaving IOP positioned to the first
+# char following the encoded number.  The format used to encode the number is
+# extracted from the program starting at PC.  PC is left pointing to the first
+# character following the format.
+
+procedure sge_printf (number, memory, iop, top, program, pc)
+
+int	number			# number to be encoded
+char	memory[top]		# output buffer
+int	iop			# index of first char to be written	(in/out)
+int	top			# size of output buffer
+char	program[ARB]		# contains printf format string
+int	pc			# index of first char of format string	(in/out)
+
+char	format[SZ_FORMAT]
+char	numstr[SZ_NUMSTR]
+int	op, ch, junk
+int	gstrcpy(), itoc()
+
+begin
+	# Extract format %w.dC, a string of digits, -, or ., delimited by a
+	# letter.  The format %w.dr is followed by a single character which
+	# must also be included in the format string.
+
+	format[1] = '%'
+	op = 2
+	for (ch=program[pc];  ch != EOS;  ch=program[pc]) {
+	    pc = pc + 1
+	    format[op] = ch
+	    op = op + 1
+	    if (IS_LOWER(ch)) {
+		if (ch == 'r' && program[pc] != EOS) {
+		    # Radix digit follows %r.
+		    format[op] = program[pc]
+		    op = op + 1
+		    pc = pc + 1
+		}
+		break
+	    }
+	}
+	format[op] = EOS
+
+	# Encode the number using the extracted format string.  The case of
+	# a simple decimal encoding is optimized.
+
+	if (format[2] == 'd')
+	    junk = itoc (number, numstr, SZ_NUMSTR)
+	else {
+	    iferr {
+		call sprintf (numstr, SZ_NUMSTR, format)
+		    call pargi (number)
+	    } then
+		numstr[1] = EOS
+	}
+
+	# Move the encoded number to encoder memory, advancing the i/o
+	# pointer and taking care not to overrun memory.  Leave the iop
+	# pointing AT, not after, the EOS output by gstrcpy.
+
+	iop = iop + gstrcpy (numstr, memory[iop], top - iop + 1)
+end