-
-
Notifications
You must be signed in to change notification settings - Fork 24
/
Copy pathAERROR
188 lines (162 loc) · 10.4 KB
/
AERROR
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
97
98
99
100
101
102
103
104
105
106
107
108
109
110
111
112
113
114
115
116
117
118
119
120
121
122
123
124
125
126
127
128
129
130
131
132
133
134
135
136
137
138
139
140
141
142
143
144
145
146
147
148
149
150
151
152
153
154
155
156
157
158
159
160
161
162
163
164
165
166
167
168
169
170
171
172
173
174
175
176
177
178
179
180
181
182
183
184
185
186
187
188
(DEFINE-FILE-INFO PACKAGE "INTERLISP" READTABLE "INTERLISP" BASE 10)
(FILECREATED "16-May-90 11:58:35" {DSK}<usr>local>lde>lispcore>sources>AERROR.;2 10460
changes to%: (VARS AERRORCOMS)
previous date%: " 1-Feb-89 09:38:44" {DSK}<usr>local>lde>lispcore>sources>AERROR.;1)
(* ; "
Copyright (c) 1982, 1983, 1986, 1987, 1988, 1989, 1990 by Venue & Xerox Corporation. All rights reserved.
")
(PRETTYCOMPRINT AERRORCOMS)
(RPAQQ AERRORCOMS
((FNS ERRORSTRING SETERRORN LISPERROR \LISPERROR \ILLEGAL.ARG \ARG.NOT.LITATOM)
(EXPORT (DECLARE%: EVAL@COMPILE (VARS \ERRORMESSAGELIST)
DONTCOPY
(OPTIMIZERS LISPERROR)))
(VARIABLES *LAST-CONDITION*)
(GLOBALVARS \ERRORMESSAGELIST)
(FUNCTIONS ERRM-TO-CONDITION)
(PROP FILETYPE AERROR)
(LOCALVARS . T)))
(DEFINEQ
(ERRORSTRING
(LAMBDA (X) (* lmm "21-APR-80 15:46") (CAR (NTH \ERRORMESSAGELIST (ADD1 (OR (NUMBERP X) 17))))))
(SETERRORN
(LAMBDA (NUM MESS) (* amd "30-Jul-86 17:00") (CL:SETQ *LAST-CONDITION* (ERRM-TO-CONDITION NUM MESS))))
(LISPERROR
[LAMBDA (N X CONTINUEOKFLG) (* ; "Edited 1-Feb-89 09:38 by jds")
(* ;; "compiles open as call to \LISPERROR")
[COND
((STRINGP N)
(* ;; "Case where LISPERROR is called with one of the %"canonical error message%" strings from the old IL implementation. Need to translate it to a number. THIS CODE IS STOLEN IN SPIRIT FROM THE OPTIMIZER.")
(FOR MSG IN \ERRORMESSAGELIST AS I FROM 0 WHEN (CL:EQUAL MSG N)
DO (SETQ N I]
(\LISPERROR X N CONTINUEOKFLG])
(\LISPERROR
(LAMBDA (X N CONTINUEOKFLG) (* amd "11-Nov-86 12:09") (DECLARE (USEDFREE \INTERRUPTABLE)) (PROG NIL (SELECTQ N ((5 22) (* ; "File errors that can happen to files open for output") (* ;; "(\STOP.DRIBBLE? X)")) NIL) (OR \INTERRUPTABLE (\MP.ERROR \MP.UNINTERRUPTABLE "Error in uninterruptable system code -- ^N to continue into error handler" X)) RET (RETURN (PROG1 (COND ((SMALLP N) (ERRORX (LIST N X))) (T (ERROR N X))) (OR CONTINUEOKFLG (GO RET))))))
)
(\ILLEGAL.ARG
(LAMBDA (X) (* lmm "25-APR-80 18:02") (LISPERROR "ILLEGAL ARG" X)))
(\ARG.NOT.LITATOM
(LAMBDA (X) (* lmm "25-APR-80 18:02") (LISPERROR "ARG NOT LITATOM" X)))
)
(* "FOLLOWING DEFINITIONS EXPORTED")
(DECLARE%: EVAL@COMPILE
(RPAQQ \ERRORMESSAGELIST
("SYSTEM ERROR" " " "STACK OVERFLOW" "ILLEGAL RETURN" "ARG NOT LIST" "HARD DISK ERROR"
"ATTEMPT TO SET NIL OR T" "ATTEMPT TO RPLAC NIL" "UNDEFINED OR ILLEGAL GO"
"FILE WON'T OPEN" "NON-NUMERIC ARG" "ATOM TOO LONG" "ATOM HASH TABLE FULL"
"FILE NOT OPEN" "ARG NOT LITATOM" "! too many files open" "END OF FILE" "ERROR" "BREAK"
"ILLEGAL STACK ARG" "FAULT IN EVAL" "ARRAYS FULL" "FILE SYSTEM RESOURCES EXCEEDED"
"FILE NOT FOUND" "BAD SYSOUT FILE" "UNUSUAL CDR ARG LIST" "HASH TABLE FULL"
"ILLEGAL ARG" "ARG NOT ARRAY" "ILLEGAL OR IMPOSSIBLE BLOCK"
"STACK PTR HAS BEEN RELEASED" "STORAGE FULL" "ATTEMPT TO USE ITEM OF INCORRECT TYPE"
"ILLEGAL DATA TYPE NUMBER" "DATA TYPES FULL" "ATTEMPT TO BIND NIL OR T"
"! too many user interrupt characters" "! read-macro context error" "ILLEGAL READTABLE"
"ILLEGAL TERMINAL TABLE" "! swapblock too big for buffer" "PROTECTION VIOLATION"
"BAD FILE NAME" "USER BREAK" "UNBOUND ATOM" "UNDEFINED CAR OF FORM"
"UNDEFINED FUNCTION" "CONTROL-E" "FLOATING UNDERFLOW" "FLOATING OVERFLOW" "OVERFLOW"
"ARG NOT HARRAY" "TOO MANY ARGUMENTS"))
DONTCOPY
(DEFOPTIMIZER LISPERROR (MESSAGE ARG)
`(\LISPERROR ,ARG
,(CL:IF (CL:STRINGP MESSAGE)
[FOR X IN \ERRORMESSAGELIST AS I FROM 0
WHEN (CL:EQUAL X MESSAGE) DO (RETURN I)
FINALLY (RETURN (HELP "Unknown error message"
(LIST MESSAGE ARG]
MESSAGE)))
)
(* "END EXPORTED DEFINITIONS")
(CL:DEFVAR *LAST-CONDITION* NIL
"Last condition signalled. This gets rebound to itself in nested execs.")
(DECLARE%: DOEVAL@COMPILE DONTCOPY
(GLOBALVARS \ERRORMESSAGELIST)
)
(CL:DEFUN ERRM-TO-CONDITION (NUM MESSAGE)
(CL:IF (TYPEP NUM 'CONDITION)
NUM
(CASE NUM
(2 (* ; "STACK OVERFLOW")
(MAKE-CONDITION 'STACK-OVERFLOW))
(3 (* ; "ILLEGAL RETURN")
(MAKE-CONDITION 'ILLEGAL-RETURN :TAG MESSAGE))
((4 10 14 28 38 39 51) (* ; "ARG NOT x")
[MAKE-CONDITION 'XCL:TYPE-MISMATCH :NAME MESSAGE :VALUE MESSAGE :EXPECTED-TYPE
(CL:ECASE NUM
(4 'LIST)
(10 'CL:NUMBER)
(14 'CL:SYMBOL)
(28 'ARRAYP)
(38 'READTABLEP)
(39 'TERMTABLEP)
(51 'CL:HASH-TABLE))])
(5 (* ; "HARD DISK ERROR")
(MAKE-CONDITION 'XCL:SIMPLE-DEVICE-ERROR :MESSAGE MESSAGE))
((6 35) (* ;
"ATTEMPT TO SET NIL, ATTEMPT TO BIND NIL OR T")
(MAKE-CONDITION 'XCL:ATTEMPT-TO-CHANGE-CONSTANT :NAME NIL))
(7 (* ; "ATTEMPT TO RPLAC NIL")
(MAKE-CONDITION 'XCL:ATTEMPT-TO-RPLAC-NIL :NAME MESSAGE))
(8 (* ; "UNDEFINED OR ILLEGAL GO")
(MAKE-CONDITION 'ILLEGAL-GO :TAG MESSAGE))
(9 (* ; "FILE WON'T OPEN")
(MAKE-CONDITION 'XCL:FILE-WONT-OPEN :PATHNAME MESSAGE))
(11 (* ; "ATOM TOO LONG")
(MAKE-CONDITION 'XCL:SYMBOL-NAME-TOO-LONG))
(12 (* ; "ATOM HASH TABLE FULL")
(MAKE-CONDITION 'XCL:SYMBOL-HT-FULL))
(13 (* ; "FILE NOT OPEN")
(MAKE-CONDITION 'XCL:STREAM-NOT-OPEN :STREAM MESSAGE))
(16 (* ; "END OF FILE")
(MAKE-CONDITION 'END-OF-FILE :STREAM MESSAGE))
(17 (* ; "ERROR")
(MAKE-CONDITION 'INTERLISP-ERROR :MESSAGE MESSAGE))
(19 (* ; "ILLEGAL STACK ARG")
(MAKE-CONDITION 'ILLEGAL-STACK-ARG :ARG MESSAGE))
(21 (* ; "ARRAYS FULL")
(MAKE-CONDITION 'XCL:ARRAY-SPACE-FULL))
(22 (* ; "FILE SYSTEM RESOURCES EXCEEDED")
(MAKE-CONDITION 'XCL:FS-RESOURCES-EXCEEDED :PATHNAME MESSAGE))
(23 (* ; "FILE NOT FOUND")
(MAKE-CONDITION 'XCL:FILE-NOT-FOUND :PATHNAME MESSAGE))
((25 27) (* ;
"UNUSUAL CDR ARG LIST, ILLEGAL ARG")
(MAKE-CONDITION 'INVALID-ARGUMENT-LIST :ARGUMENT MESSAGE))
(26 (* ; "HASH TABLE FULL")
(MAKE-CONDITION 'XCL:HASH-TABLE-FULL :TABLE MESSAGE))
(30 (* ; "STACK PTR HAS BEEN RELEASED")
(MAKE-CONDITION 'STACK-POINTER-RELEASED :NAME MESSAGE))
(31 (* ; "STORAGE FULL")
(MAKE-CONDITION 'XCL:STORAGE-EXHAUSTED))
(34 (* ; "DATA TYPES FULL")
(MAKE-CONDITION 'XCL:DATA-TYPES-EXHAUSTED))
(41 (* ; "PROTECTION VIOLATION")
(MAKE-CONDITION 'XCL:FS-PROTECTION-VIOLATION :PATHNAME MESSAGE))
(42 (* ; "BAD FILE NAME")
(MAKE-CONDITION 'XCL:INVALID-PATHNAME :PATHNAME MESSAGE))
(44 (* ; "UNBOUND ATOM")
(MAKE-CONDITION 'UNBOUND-VARIABLE :NAME MESSAGE))
(45 (* ; "UNDEFINED CAR OF FORM")
(MAKE-CONDITION 'UNDEFINED-CAR-OF-FORM :FUNCTION MESSAGE))
(46 (* ; "UNDEFINED FUNCTION")
(MAKE-CONDITION 'UNDEFINED-FUNCTION-IN-APPLY :NAME (CL:FIRST MESSAGE)
:ARGUMENTS
(CL:SECOND MESSAGE)))
(47 (* ; "CONTROL-E")
(MAKE-CONDITION 'XCL:CONTROL-E-INTERRUPT))
(48 (* ; "FLOATING UNDERFLOW")
(MAKE-CONDITION 'CONDITIONS:FLOATING-POINT-UNDERFLOW))
(49 (* ; "FLOATING OVERFLOW")
(MAKE-CONDITION 'CONDITIONS:FLOATING-POINT-OVERFLOW))
(52 (* ; "TOO MANY ARGUMENTS")
(MAKE-CONDITION 'TOO-MANY-ARGUMENTS :CALLEE MESSAGE :MAXIMUM CL:CALL-ARGUMENTS-LIMIT))
(CL:OTHERWISE (CL:ERROR "Interlisp error number ~D (message: ~S) no longer supported" NUM
MESSAGE)))))
(PUTPROPS AERROR FILETYPE CL:COMPILE-FILE)
(DECLARE%: DOEVAL@COMPILE DONTCOPY
(LOCALVARS . T)
)
(PUTPROPS AERROR COPYRIGHT ("Venue & Xerox Corporation" 1982 1983 1986 1987 1988 1989 1990))
(DECLARE%: DONTCOPY
(FILEMAP (NIL (872 2358 (ERRORSTRING 882 . 995) (SETERRORN 997 . 1114) (LISPERROR 1116 . 1703) (
\LISPERROR 1705 . 2174) (\ILLEGAL.ARG 2176 . 2261) (\ARG.NOT.LITATOM 2263 . 2356)))))
STOP