1
2
3
4
5
6
7
8
9
10
11
12
13
14
15
16
17
18
19
20
21
22
23
24
25
26
27
28
29
30
31
32
33
34
35
36
37
38
39
40
41
42
43
44
45
46
47
48
49
50
51
52
53
54
55
56
57
58
59
60
61
62
63
64
65
66
67
68
69
70
71
72
73
74
75
76
77
78
79
80
81
82
83
84
85
86
87
88
89
90
91
92
93
94
95
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
|
