1 // cslerror.h                              Copyright (C) 1989-2021 Codemist
2 
3 // Error codes and functions.
4 //
5 
6 
7 /**************************************************************************
8  * Copyright (C) 2021, Codemist.                         A C Norman       *
9  *                                                                        *
10  * Redistribution and use in source and binary forms, with or without     *
11  * modification, are permitted provided that the following conditions are *
12  * met:                                                                   *
13  *                                                                        *
14  *     * Redistributions of source code must retain the relevant          *
15  *       copyright notice, this list of conditions and the following      *
16  *       disclaimer.                                                      *
17  *     * Redistributions in binary form must reproduce the above          *
18  *       copyright notice, this list of conditions and the following      *
19  *       disclaimer in the documentation and/or other materials provided  *
20  *       with the distribution.                                           *
21  *                                                                        *
22  * THIS SOFTWARE IS PROVIDED BY THE COPYRIGHT HOLDERS AND CONTRIBUTORS    *
23  * "AS IS" AND ANY EXPRESS OR IMPLIED WARRANTIES, INCLUDING, BUT NOT      *
24  * LIMITED TO, THE IMPLIED WARRANTIES OF MERCHANTABILITY AND FITNESS      *
25  * FOR A PARTICULAR PURPOSE ARE DISCLAIMED. IN NO EVENT SHALL THE         *
26  * COPYRIGHT OWNERS OR CONTRIBUTORS BE LIABLE FOR ANY DIRECT, INDIRECT,   *
27  * INCIDENTAL, SPECIAL, EXEMPLARY, OR CONSEQUENTIAL DAMAGES (INCLUDING,   *
28  * BUT NOT LIMITED TO, PROCUREMENT OF SUBSTITUTE GOODS OR SERVICES; LOSS  *
29  * OF USE, DATA, OR PROFITS; OR BUSINESS INTERRUPTION) HOWEVER CAUSED AND *
30  * ON ANY THEORY OF LIABILITY, WHETHER IN CONTRACT, STRICT LIABILITY, OR  *
31  * TORT (INCLUDING NEGLIGENCE OR OTHERWISE) ARISING IN ANY WAY OUT OF     *
32  * THE USE OF THIS SOFTWARE, EVEN IF ADVISED OF THE POSSIBILITY OF SUCH   *
33  * DAMAGE.                                                                *
34  *************************************************************************/
35 
36 // $Id: cslerror.h 5609 2021-01-23 22:02:30Z arthurcnorman $
37 
38 #ifndef header_cslerror_h
39 #define header_cslerror_h 1
40 
41 extern LispObject interrupted(bool noisy);
42 
43 extern LispObject error(int nargs, int code, ...);
44 extern LispObject cerror(int nargs, int code1, int code2, ...);
45 
46 extern LispObject got_0_wanted_1(LispObject env);
47 extern LispObject got_0_wanted_2(LispObject env);
48 extern LispObject got_0_wanted_3(LispObject env);
49 extern LispObject got_0_wanted_4up(LispObject env);
50 // "other" is for use if the function could take a variable number of
51 // arguments, but the number actually provided is not acceptable. A case
52 // where this arises is with functions that have a signatire of the
53 // style (de foo (a !&rest r) ...) where not being passed any arguments at
54 // all would be an error.
55 extern LispObject got_0_wanted_other(LispObject env);
56 
57 extern LispObject got_1_wanted_0(LispObject env,
58                                         LispObject a1);
59 extern LispObject got_1_wanted_2(LispObject env,
60                                         LispObject a1);
61 extern LispObject got_1_wanted_3(LispObject env,
62                                         LispObject a1);
63 extern LispObject got_1_wanted_4up(LispObject env,
64         LispObject a1);
65 extern LispObject got_1_wanted_other(LispObject env,
66         LispObject a1);
67 
68 extern LispObject got_2_wanted_0(LispObject env, LispObject a1,
69                                         LispObject a2);
70 extern LispObject got_2_wanted_1(LispObject env, LispObject a1,
71                                         LispObject a2);
72 extern LispObject got_2_wanted_3(LispObject env, LispObject a1,
73                                         LispObject a2);
74 extern LispObject got_2_wanted_4up(LispObject env,
75         LispObject a1,
76         LispObject a2);
77 extern LispObject got_2_wanted_other(LispObject env,
78         LispObject a1,
79         LispObject a2);
80 
81 extern LispObject got_3_wanted_0(LispObject env, LispObject a1,
82                                         LispObject a2, LispObject a3);
83 extern LispObject got_3_wanted_1(LispObject env, LispObject a1,
84                                         LispObject a2, LispObject a3);
85 extern LispObject got_3_wanted_2(LispObject env, LispObject a1,
86                                         LispObject a2, LispObject a3);
87 extern LispObject got_3_wanted_4up(LispObject env,
88         LispObject a1,
89         LispObject a2, LispObject a3);
90 extern LispObject got_3_wanted_other(LispObject env,
91         LispObject a1,
92         LispObject a2, LispObject a3);
93 
94 extern LispObject got_4up_wanted_0(LispObject env,
95         LispObject a1,
96         LispObject a2, LispObject a3,
97         LispObject a4up);
98 extern LispObject got_4up_wanted_1(LispObject env,
99         LispObject a1,
100         LispObject a2, LispObject a3,
101         LispObject a4up);
102 extern LispObject got_4up_wanted_2(LispObject env,
103         LispObject a1,
104         LispObject a2, LispObject a3,
105         LispObject a4up);
106 extern LispObject got_4up_wanted_3(LispObject env,
107         LispObject a1,
108         LispObject a2, LispObject a3,
109         LispObject a4up);
110 extern LispObject got_4up_wanted_other(LispObject env,
111         LispObject a1,
112         LispObject a2, LispObject a3,
113         LispObject a4up);
114 
115 
116 // The following are put in the function cells of symbols that are special
117 // forms so that if by some mischance somebody calls one of them one gets
118 // a tolerable diagnostic.
119 
120 extern LispObject bad_specialfn_0(LispObject env);
121 extern LispObject bad_specialfn_2(LispObject env, LispObject,
122         LispObject);
123 extern LispObject bad_specialfn_3(LispObject env, LispObject,
124         LispObject, LispObject);
125 extern LispObject bad_specialfn_4up(LispObject env, LispObject,
126         LispObject, LispObject, LispObject);
127 
128 
129 // The following are just abbreviations to make the setup tables in the
130 // code less bulky.
131 
132 #define G0W1           got_0_wanted_1
133 #define G0W2           got_0_wanted_2
134 #define G0W3           got_0_wanted_3
135 #define G0W4up         got_0_wanted_4up
136 #define G0Wother       got_0_wanted_other
137 
138 #define G1W0           got_1_wanted_0
139 #define G1W2           got_1_wanted_2
140 #define G1W3           got_1_wanted_3
141 #define G1W4up         got_1_wanted_4up
142 #define G1Wother       got_1_wanted_other
143 
144 #define G2W0           got_2_wanted_0
145 #define G2W1           got_2_wanted_1
146 #define G2W3           got_2_wanted_3
147 #define G2W4up         got_2_wanted_4up
148 #define G2Wother       got_2_wanted_other
149 
150 #define G3W0           got_3_wanted_0
151 #define G3W1           got_3_wanted_1
152 #define G3W2           got_3_wanted_2
153 #define G3W4up         got_3_wanted_4up
154 #define G3Wother       got_3_wanted_other
155 
156 #define G4W0           got_4up_wanted_0
157 #define G4W1           got_4up_wanted_1
158 #define G4W2           got_4up_wanted_2
159 #define G4W3           got_4up_wanted_3
160 #define G4Wother       got_4up_wanted_other
161 
162 extern LispObject aerror(const char
163                                 *s);         // Called from C not Lisp
164 extern LispObject aerror0(const char *s);
165 extern LispObject aerror1(const char *s, LispObject a);
166 extern LispObject aerror2(const char *s, LispObject a,
167                                  LispObject b);
168 extern LispObject aerror2(const char *s, const char *a,
169                                  LispObject b);
170 extern LispObject aerror3(const char *s, LispObject a,
171                                  LispObject b, LispObject c);
172 extern void fatal_error(int code, ...);
173 
174 // For the sake of Common Lisp style treatment of (car nil) and (cdr nil)
175 // I have these. In the CL case they can return nil if the arg is nil or
176 // raise an exception otherwise.
177 extern LispObject carerror(LispObject a);
178 extern LispObject cdrerror(LispObject a);
179 
180 extern LispObject car_fails(LispObject a);
181 extern LispObject cdr_fails(LispObject a);
182 extern LispObject rplaca_fails(LispObject a);
183 extern LispObject rplacd_fails(LispObject a);
184 
185 //
186 // Since miscflags is treated as a set of bits the issue of whether it
187 // is signed or not will never arise!
188 //
189 #define GC_MESSAGES   0x01
190 #define FASL_MESSAGES 0x02
191 #define VERBOSE_MSGS  0x04
192 
193 #define GC_MSG_BITS   0x07
194 #define verbos_flag (miscflags & GC_MSG_BITS)
195 
196 //
197 // In a backtrace I can get
198 //    +++ Error EXPLANATION               HEADLINE_FLAG
199 //    Calling: FUNCTION                   FNAME_FLAG
200 //    Arg1: DATA                          ARGS_FLAG
201 //
202 //
203 
204 #define HEADLINE_FLAG 0x08
205 #define FNAME_FLAG    0x10
206 #define ARGS_FLAG     0x20
207 
208 #define BACKTRACE_MSG_BITS 0x38
209 
210 //
211 // It is essential that the #define values set up here are kept in
212 // step with the textual error messages in the array that follows...
213 //
214 
215 #define err_bad_car               0      // + the atom
216 #define err_bad_cdr               1      // + the atom
217 #define err_no_store              2      // no extras
218 #define err_undefined_function_0  3      // + fn name
219 #define err_undefined_function_1  4      // + fn name
220 #define err_undefined_function_2  5      // + fn name
221 #define err_undefined_function_3  6      // + fn name
222 #define err_undefined_function_4up  7    // + fn name
223 #define err_wrong_no_args         8      // fn name, actual arg count
224 #define err_unbound_lexical       9      // + name
225 #define err_bad_rplac            10      // + atom
226 #define err_bad_arith            11      // + bad value
227 #define err_redef_special        12      // + name
228 #define err_bad_arg              13      // + offending value
229 #define err_bad_declare          14      // + offending value
230 #define err_bad_fn               15      // + offending value
231 #define err_unset_var            16      // + name
232 #define err_too_many_args0       17      // no extras
233 #define err_too_many_args1       18      // no extras
234 #define err_too_many_args2       19      // no extras
235 #define err_too_many_args3       20      // no extras
236 #define err_bad_apply            21      // + bad thing
237 #define err_macroex_hook         22      // what it is
238 #define err_block_tag            23      // bad tag
239 #define err_go_tag               24      // bad tag
240 #define err_excess_args          25
241 #define err_insufficient_args    26
242 #define err_bad_bvl              27      // + offending value
243 #define err_bad_keyargs          28
244 #define err_write_err            29
245 #define err_bad_endp             30      // + the non-null atom
246 #define err_no_fasldir           31
247 #define err_no_fasl              32      // plus module name
248 #define err_open_failed          33      // plus file name
249 #define err_pipe_failed          34      // plus command for execution
250 #define err_stack_overflow       35
251 #define err_top_bit              36
252 #define err_mem_spans_zero       37
253 #define err_read_failure         38      // from preserve.cpp
254 #define err_no_tempdir           39
255 
256 #ifdef INCLUDE_ERROR_STRING_TABLE
257 static const char *error_message_table[] =
258 {   "attempt to take car of an atom",
259     "attempt to take cdr of an atom",
260     "insufficient freestore to run this package",
261     "undefined function (0 args)",
262     "undefined function (1 arg)",
263     "undefined function (2 args)",
264     "undefined function (3 args)",
265     "undefined function (4 or more args)",
266     "wrong number of arguments",
267     "unbound lexical variable",
268     "bad rplaca/rplacd",
269     "bad argument for an arithmetic function",
270     "attempt to redefine a special form",
271     "not a variable",
272     "bad use of declare",
273     "attempt to apply non-function",
274     "unset variable",
275     "too many arguments for 0-arg function",
276     "too many arguments for 1-arg function",
277     "too many arguments for 2-arg function",
278     "too many arguments for 3-arg function",
279     "object not valid as a function (apply,",
280     "macroexpand-hook failure",
281     "block tag not found",
282     "go tag not found",
283     "too many arguments provided",
284     "not enough arguments provided",
285     "bad item in bound variable list",
286     "bad keyword arguments",
287     "write-error on file",
288     "endp used on badly terminated list",
289     "environment parameter 'fasldir' not set",
290     "loadable module not found for loading",
291     "file could not be opened",
292     "unable to establish pipe",
293     "stack overflow",
294     "top bit of address has unexpected value",
295     "memory block spans the zero address",
296     "failure reading from an image file",
297     "unable to find a directory for temporary files",
298     "dummy final error message"
299 };
300 #endif
301 
302 #endif // header_cslerror_h
303 
304 // end of cslerror.h
305