Repatch (from linux) of OSX IRAF

1 files changed, 66 insertions, 0 deletions

diff --git a/sys/etc/xerstmt.x b/sys/etc/xerstmt.x
new file mode 100644
index 00000000..0a28167b
--- /dev/null
+++ b/sys/etc/xerstmt.x
@@ -0,0 +1,66 @@
+# Copyright(c) 1986 Association of Universities for Research in Astronomy Inc.
+
+include	<syserr.h>
+include	<error.h>
+include	<ctype.h>
+
+define	SZ_NUMBUF	6
+
+# XERSTMT -- Format and issue an error statement to the CL.  Note that this is
+# a command issued to the CL, not a line written to STDERR.  The error code and
+# error message string output were posted in the last call to ERROR or FATAL.
+# 
+# Example:	ERROR (501, "Access Violation")
+# 
+# The actual concatentation and transmission of the error message is carried
+# out by the primitive XERPUTC, rather than by PUTLINE and PUTC calls to CLOUT,
+# to avoid recursion in the FIO routines, probably leading to error recursion.
+
+procedure xer_send_error_statement_to_cl (errcode)
+
+int	errcode
+char	numbuf[SZ_NUMBUF]
+int	ip, junk, itoc()
+include	"error.com"
+
+begin
+	# The error code is passed as an argument rather than taken from the
+	# xercom common because XERPOP clears the error code before we are
+	# called by the IRAF Main.
+
+	junk = itoc (errcode, numbuf, SZ_NUMBUF)
+
+	# Format the ERROR statement and sent it to the CL.
+
+	call xerpstr ("ERROR (")
+	call xerpstr (numbuf)
+	call xerpstr (", \"")
+
+	# Output error message string, omitting characters like newline or
+	# quote which could cause syntax problems.
+
+	for (ip=1;  xermsg[ip] != EOS;  ip=ip+1)
+	    if (IS_PRINT (xermsg[ip]) && xermsg[ip] != '"')
+		call xerputc (xermsg[ip])
+
+	# Ring terminal bell if unexpected error (anything other than
+	# a keyboard interrupt).
+
+	if (xercod != SYS_XINT)
+	    call xerpstr ("\7")
+	call xerpstr ("\")\n")
+end
+
+
+# XERPSTR -- Put a string to the CL (special routine, to avoid recursion).
+# Use PUTLINE in normal code.
+
+procedure xerpstr (str)
+
+char	str[ARB]
+int	ip
+
+begin
+	for (ip=1;  str[ip] != EOS;  ip=ip+1)
+	    call xerputc (str[ip])
+end