blob: 0a28167b3052e02778c3c8d84bacf22540a62a3a (
plain) (
blame)
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
|
# 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
|
