1 files changed, 96 insertions, 0 deletions
diff --git a/sys/etc/onerror.x b/sys/etc/onerror.x
new file mode 100644
index 00000000..d8bd36f3
--- /dev/null
+++ b/sys/etc/onerror.x
@@ -0,0 +1,96 @@
+# Copyright(c) 1986 Association of Universities for Research in Astronomy Inc.
+
+include	<config.h>
+include	<syserr.h>
+include	<error.h>
+
+# ONERROR -- Give system the EPA of a procedure to be executed when task
+# termination occurs (either normal task termination or task termination
+# via error recovery).  Each procedure will be called with the task termination
+# status, i.e., OK for normal termination, else the ERRCODE argument to ERROR.
+
+procedure onerror (user_proc)
+
+extern	user_proc()			#I procedure to be posted
+
+int	epa, i
+bool	first_time
+int	proc_list[MAX_ONERROR], nprocs
+common	/onercm/ nprocs, proc_list
+data	first_time /true/
+
+begin
+	# The first call is by the IRAF main at process startup time, with
+	# a dummy argument.
+
+	if (first_time) {
+	    nprocs = 0
+	    first_time = false
+	    return
+	}
+
+	call zlocpr (user_proc, epa)
+
+	# Ignore the call if the procedure has already been posted.
+	# Otherwise tack address of proc onto list and return.
+
+	for (i=1;  i <= nprocs;  i=i+1)
+	    if (epa == proc_list[i])
+		return
+
+	nprocs = nprocs + 1
+	if (nprocs > MAX_ONERROR)
+	    iferr (call syserr (SYS_SONERROVFL))
+		call erract (EA_WARN)
+
+	proc_list[nprocs] = epa
+end
+
+
+# ONERROR_REMOVE -- Remove a previously posted ONERROR procedure.
+
+procedure onerror_remove (user_proc)
+
+extern	user_proc()			#I procedure to be posted
+
+int	epa, i
+int	proc_list[MAX_ONERROR], nprocs
+common	/onercm/ nprocs, proc_list
+
+begin
+	call zlocpr (user_proc, epa)
+	for (i=1;  i <= nprocs;  i=i+1)
+	    if (proc_list[i] == epa)
+		proc_list[i] = 0
+end
+
+
+# XONERROR -- Called at task termination by the IRAF Main to execute each of
+# the posted user error cleanup procedures (if any).  Procedures are executed
+# in the order in which they were posted.  The task termination status is
+# passed to the called procedure as the single argument to the procedure.
+# The list of termination handlers is cleared when finished.
+
+procedure xonerror (status)
+
+int	status			#I task termination status (OK or error code)
+
+int	nprocs_to_execute, i
+int	proc_list[MAX_ONERROR], nprocs
+common	/onercm/ nprocs, proc_list
+errchk	zcall1
+
+begin
+	# Clear "nprocs" before calling user procedures, to ensure that
+	# a reentrant call does not lead to an infinite loop (i.e., in the
+	# event of an error during execution of a cleanup procedure). 
+	# In principle this should not be necessary, since an error occurring
+	# during error restart should result in a panic abort.
+
+	nprocs_to_execute = nprocs
+	nprocs = 0
+
+	for (i=1; i <= nprocs_to_execute;  i=i+1)
+	    if (proc_list[i] != 0)
+		call zcall1 (proc_list[i], status)
+end