1 /* Exception Handling */
2 /*
3 Copyright (C) 2004-2017,2018 John E. Davis
4
5 This file is part of the S-Lang Library.
6
7 The S-Lang Library is free software; you can redistribute it and/or
8 modify it under the terms of the GNU General Public License as
9 published by the Free Software Foundation; either version 2 of the
10 License, or (at your option) any later version.
11
12 The S-Lang Library is distributed in the hope that it will be useful,
13 but WITHOUT ANY WARRANTY; without even the implied warranty of
14 MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE. See the GNU
15 General Public License for more details.
16
17 You should have received a copy of the GNU General Public License
18 along with this library; if not, write to the Free Software
19 Foundation, Inc., 59 Temple Place - Suite 330, Boston, MA 02111-1307,
20 USA.
21 */
22 #ifndef _GNU_SOURCE
23 # define _GNU_SOURCE
24 #endif
25 #include "slinclud.h"
26
27 #include "slang.h"
28
29 #ifdef HAVE_LOCALE_H
30 # include <locale.h>
31 #endif
32
33 #include "_slang.h"
34
35 static SLang_Object_Type *Object_Thrownp = NULL;
36 static SLang_Object_Type Object_Thrown;
37 static SLCONST char *File_With_Error = NULL;
38 static SLCONST char *Function_With_Error = NULL;
39 static SLCONST char *Last_Function_With_Error = NULL; /* either slstring or "<top-level>" */
40 static _pSLerr_Error_Queue_Type *Error_Message_Queue;
41
42 static int Linenum_With_Error = -1;
43
free_thrown_object(void)44 static void free_thrown_object (void)
45 {
46 if (Object_Thrownp != NULL)
47 {
48 SLang_free_object (Object_Thrownp);
49 Object_Thrownp = NULL;
50 }
51 }
52
53 typedef struct Error_Context_Type
54 {
55 int err;
56 int err_cleared;
57 int rethrow;
58 int linenum;
59 SLCONST char *file;
60 SLCONST char *function;
61 _pSLerr_Error_Queue_Type *err_queue;
62 int object_was_thrown;
63 SLang_Object_Type object_thrown;
64 struct Error_Context_Type *next;
65 }
66 Error_Context_Type;
67
68 static Error_Context_Type *Error_Context;
69
_pSLang_push_error_context(void)70 int _pSLang_push_error_context (void)
71 {
72 Error_Context_Type *c;
73
74 if (NULL == (c = (Error_Context_Type *)SLmalloc (sizeof (Error_Context_Type))))
75 return -1;
76
77 c->next = Error_Context;
78 c->err = _pSLang_Error;
79 c->err_cleared = 0;
80 c->rethrow = 0;
81 c->file = File_With_Error;
82 c->function = Function_With_Error; /* steal pointers */
83 c->linenum = Linenum_With_Error;
84 c->err_queue = Error_Message_Queue;
85
86 File_With_Error = NULL;
87 Function_With_Error = NULL;
88 Linenum_With_Error = -1;
89
90 if (NULL == (Error_Message_Queue = _pSLerr_new_error_queue (1)))
91 {
92 Error_Message_Queue = c->err_queue;
93 SLfree ((char *) c);
94 return -1;
95 }
96
97 Error_Context = c;
98 SLKeyBoard_Quit = 0;
99
100 c->object_was_thrown = (Object_Thrownp != NULL);
101 if (c->object_was_thrown)
102 {
103 c->object_thrown = Object_Thrown;
104 Object_Thrownp = NULL;
105 }
106
107 if (-1 == SLang_set_error (0))
108 {
109 _pSLang_pop_error_context (1);
110 return -1;
111 }
112 return 0;
113 }
114
115 /* this will be called with use_current_queue set to 0 if the catch block
116 * was processed with no error. If an error occurs processing the catch
117 * block, then that error will take precedence over the one triggering the
118 * catch block. However, if the original error is rethrown, then this routine
119 * will still be called with use_current_queue non-zero since all the caller
120 * knows is that an error occured and cannot tell if it was a rethrow.
121 */
_pSLang_pop_error_context(int use_current_queue)122 int _pSLang_pop_error_context (int use_current_queue)
123 {
124 Error_Context_Type *e;
125
126 e = Error_Context;
127 if (e == NULL)
128 return -1;
129
130 Error_Context = e->next;
131
132 if ((use_current_queue == 0) || (e->rethrow))
133 {
134 (void) _pSLerr_set_error_queue (e->err_queue);
135 _pSLerr_delete_error_queue (Error_Message_Queue);
136 Error_Message_Queue = e->err_queue;
137 free_thrown_object ();
138 if (e->object_was_thrown)
139 {
140 Object_Thrownp = &Object_Thrown;
141 Object_Thrown = e->object_thrown;
142 }
143 }
144 else
145 {
146 _pSLerr_delete_error_queue (e->err_queue);
147 if (e->object_was_thrown)
148 SLang_free_object (&e->object_thrown);
149 }
150
151 if (_pSLang_Error == 0)
152 {
153 if (e->err_cleared)/* ERROR_BLOCK */
154 _pSLerr_free_queued_messages ();
155 else
156 {
157 SLang_free_slstring ((char *)File_With_Error);
158 SLang_free_slstring ((char *)Function_With_Error);
159 File_With_Error = e->file; e->file = NULL;
160 Function_With_Error = e->function; e->function = NULL;
161 Linenum_With_Error = e->linenum;
162 (void) SLang_set_error (e->err);
163 }
164 }
165
166 if (_pSLang_Error == SL_UserBreak_Error)
167 SLKeyBoard_Quit = 1;
168
169 SLang_free_slstring ((char *) e->file);
170 SLang_free_slstring ((char *) e->function);
171
172 SLfree ((char *) e);
173 return 0;
174 }
175
_pSLerr_get_last_error(void)176 int _pSLerr_get_last_error (void)
177 {
178 Error_Context_Type *e;
179
180 e = Error_Context;
181 if (e == NULL)
182 return 0;
183 return e->err;
184 }
185
do_file_line_funct_error(SLCONST char * file,int linenum,SLCONST char * function)186 static void do_file_line_funct_error (SLCONST char *file, int linenum, SLCONST char *function)
187 {
188 if ((file == NULL) || (_pSLang_Error == 0))
189 return;
190
191 if (Last_Function_With_Error == function) /* either slstring or "<top-level>" */
192 return;
193 Last_Function_With_Error = function;
194 if (SLang_Traceback && *function)
195 _pSLerr_traceback_msg ("%s:%d:%s:%s\n", file, linenum, function, SLerr_strerror (_pSLang_Error));
196 }
197
_pSLerr_set_line_info(SLFUTURE_CONST char * file,int linenum,SLFUTURE_CONST char * fun)198 int _pSLerr_set_line_info (SLFUTURE_CONST char *file, int linenum, SLFUTURE_CONST char *fun)
199 {
200 if (linenum == 0)
201 linenum = -1;
202
203 if (0 == (SLang_Traceback == SL_TB_FULL))
204 {
205 if ((File_With_Error != NULL) && (Linenum_With_Error != -1))
206 return 0;
207 if ((linenum == -1) && (file == NULL))
208 return 0;
209 }
210
211 if (fun == NULL)
212 fun = "<top-level>";
213
214 do_file_line_funct_error (file, linenum, fun);
215
216 if (File_With_Error != NULL)
217 return 0;
218
219 Linenum_With_Error = linenum;
220 if (file != NULL)
221 {
222 if (NULL == (file = SLang_create_slstring (file)))
223 return -1;
224 }
225 if (NULL == (fun = SLang_create_slstring (fun)))
226 {
227 SLang_free_slstring ((char *) file); /* NULL ok */
228 return -1;
229 }
230
231 SLang_free_slstring ((char *)File_With_Error);
232 SLang_free_slstring ((char *)Function_With_Error);
233
234 File_With_Error = file;
235 Function_With_Error = fun;
236
237 #if SLANG_HAS_BOSEOS && SLANG_HAS_DEBUGGER_SUPPORT
238 (void) _pSLcall_debug_hook (file, linenum);
239 #endif
240
241 return 0;
242 }
243
_pSLerr_get_last_error_line_info(SLCONST char ** filep,int * linep,SLCONST char ** funp)244 static int _pSLerr_get_last_error_line_info (SLCONST char **filep, int *linep, SLCONST char **funp)
245 {
246 Error_Context_Type *e = Error_Context;
247 if (e == NULL)
248 {
249 *filep = NULL;
250 *linep = -1;
251 *funp = NULL;
252 return -1;
253 }
254 *filep = e->file;
255 *linep = e->linenum;
256 *funp = e->function;
257 return 0;
258 }
259
get_error_msg_from_queue(int type)260 static char *get_error_msg_from_queue (int type)
261 {
262 Error_Context_Type *e = Error_Context;
263
264 if (e == NULL)
265 return NULL;
266
267 return _pSLerr_get_error_from_queue (e->err_queue, type);
268 }
269
270 void (*SLang_User_Clear_Error)(void) = NULL;
_pSLerr_clear_error(int set_clear_err_flag)271 void _pSLerr_clear_error (int set_clear_err_flag)
272 {
273 SLang_set_error (0);
274 free_thrown_object ();
275
276 if ((Error_Context != NULL)
277 && (set_clear_err_flag))
278 {
279 /* This is used only for error blocks */
280 Error_Context->err_cleared = 1;
281 }
282
283 SLang_free_slstring ((char *) File_With_Error); File_With_Error = NULL;
284 SLang_free_slstring ((char *) Function_With_Error); Function_With_Error = NULL;
285 Linenum_With_Error = -1;
286 Last_Function_With_Error = NULL;
287 if (SLang_User_Clear_Error != NULL) (*SLang_User_Clear_Error)();
288 _pSLerr_free_queued_messages ();
289 }
290
rethrow_error(void)291 static int rethrow_error (void)
292 {
293 Error_Context_Type *e = Error_Context;
294
295 if (e == NULL)
296 return 0;
297
298 SLang_set_error (e->err);
299 e->rethrow=1;
300 e->err_cleared = 0;
301 return 0;
302 }
303
_pSLerr_throw(void)304 int _pSLerr_throw (void)
305 {
306 int e;
307 int nargs = SLang_Num_Function_Args;
308 char *msg = NULL;
309
310 free_thrown_object ();
311
312 switch (nargs)
313 {
314 case 3:
315 if (-1 == SLang_pop (&Object_Thrown))
316 return -1;
317 Object_Thrownp = &Object_Thrown;
318 /* drop */
319 case 2:
320 if (-1 == SLang_pop_slstring (&msg))
321 {
322 free_thrown_object ();
323 return -1;
324 }
325 case 1:
326 /* drop */
327 if (-1 == _pSLerr_pop_exception (&e))
328 {
329 SLang_free_slstring (msg);/* NULL ok */
330 free_thrown_object ();
331 return -1;
332 }
333 break;
334
335 case 0: /* rethrow */
336 return rethrow_error ();
337
338 default:
339 _pSLang_verror (SL_NumArgs_Error, "expecting: throw error [, optional-message [, optional-arg]]");
340 return -1;
341 }
342
343 if (msg != NULL)
344 {
345 _pSLang_verror (e, "%s", msg);
346 SLang_free_slstring (msg);
347 }
348 else
349 SLang_set_error (e);
350
351 return 0;
352 }
353
SLerr_throw(int err,SLFUTURE_CONST char * msg,SLtype obj_type,VOID_STAR objptr)354 int SLerr_throw (int err, SLFUTURE_CONST char *msg, SLtype obj_type, VOID_STAR objptr)
355 {
356 free_thrown_object ();
357
358 if ((obj_type != 0) || (objptr != NULL))
359 {
360 if (-1 == SLang_push_value (obj_type, objptr))
361 return -1;
362 if (-1 == SLang_pop (&Object_Thrown))
363 return -1;
364 Object_Thrownp = &Object_Thrown;
365 }
366
367 if (msg != NULL)
368 _pSLang_verror (err, "%s", msg);
369 else
370 SLang_set_error (err);
371
372 return 0;
373 }
374
new_exception(char * name,int * baseclass,char * description)375 static void new_exception (char *name, int *baseclass, char *description)
376 {
377 (void) SLerr_new_exception (*baseclass, name, description);
378 }
379
get_exception_info_intrinsic(void)380 static void get_exception_info_intrinsic (void)
381 {
382 #define NUM_EXCEPT_FIELDS 8
383 static SLFUTURE_CONST char *field_names[NUM_EXCEPT_FIELDS] =
384 {
385 "error", "descr", "file", "line", "function", "object", "message", "traceback"
386 };
387 SLtype field_types[NUM_EXCEPT_FIELDS];
388 VOID_STAR field_values[NUM_EXCEPT_FIELDS];
389 int err;
390 SLCONST char *desc;
391 SLCONST char *file;
392 SLCONST char *function;
393 SLCONST char *errmsg;
394 SLCONST char *tbmsg;
395 int linenum;
396
397 err = _pSLerr_get_last_error ();
398 if (err == 0)
399 {
400 (void) SLang_push_null ();
401 return;
402 }
403
404 desc = SLerr_strerror (err);
405 (void) _pSLerr_get_last_error_line_info (&file, &linenum, &function);
406
407 field_types[0] = SLANG_INT_TYPE;
408 field_values[0] = (VOID_STAR) &err;
409
410 field_types[1] = SLANG_STRING_TYPE;
411 field_values[1] = (VOID_STAR) &desc;
412
413 field_types[2] = SLANG_STRING_TYPE;
414 field_values[2] = (VOID_STAR) &file;
415
416 field_types[3] = SLANG_INT_TYPE;
417 field_values[3] = (VOID_STAR) &linenum;
418
419 field_types[4] = SLANG_STRING_TYPE;
420 field_values[4] = (VOID_STAR) &function;
421
422 if ((Error_Context == NULL)
423 || (Error_Context->object_was_thrown == 0))
424 {
425 char *null = NULL;
426 field_types[5] = SLANG_NULL_TYPE;
427 field_values[5] = (VOID_STAR) &null;
428 }
429 else
430 {
431 SLtype data_type = Error_Context->object_thrown.o_data_type;
432 field_types[5] = data_type;
433 field_values[5] = _pSLclass_get_ptr_to_value (_pSLclass_get_class (data_type),
434 &Error_Context->object_thrown);
435 }
436 errmsg = get_error_msg_from_queue (_SLERR_MSG_ERROR);
437 if ((errmsg == NULL) || (*errmsg == 0))
438 errmsg = desc;
439 field_types[6] = SLANG_STRING_TYPE;
440 field_values[6] = (VOID_STAR) &errmsg;
441
442 tbmsg = get_error_msg_from_queue (_SLERR_MSG_TRACEBACK);
443 field_types[7] = (tbmsg == NULL) ? SLANG_NULL_TYPE : SLANG_STRING_TYPE;
444 field_values[7] = (VOID_STAR) &tbmsg;
445
446 (void) SLstruct_create_struct (NUM_EXCEPT_FIELDS, field_names, field_types, field_values);
447 if (errmsg != desc)
448 SLang_free_slstring ((char *) errmsg);
449 SLang_free_slstring ((char *)tbmsg);
450 }
451
_pSLerr_pop_exception(int * e)452 int _pSLerr_pop_exception (int *e)
453 {
454 return SLang_pop_integer (e);
455 }
456
new_exception_hook(SLFUTURE_CONST char * name,SLFUTURE_CONST char * desc,int err_code)457 static int new_exception_hook (SLFUTURE_CONST char *name, SLFUTURE_CONST char *desc, int err_code)
458 {
459 SLang_IConstant_Type *ic;
460
461 (void) desc;
462 if (NULL != (ic = (SLang_IConstant_Type *)_pSLlocate_name (name)))
463 {
464 if ((ic->name_type != SLANG_ICONSTANT)
465 || (ic->value != err_code))
466 {
467 _pSLang_verror (SL_RunTime_Error, "Exception %s already exists and may not be redefined", name);
468 return -1;
469 }
470 return 0;
471 }
472
473 if (-1 == SLns_add_iconstant (NULL, name, SLANG_INT_TYPE, err_code))
474 return -1;
475
476 return 0;
477 }
478
479 static SLang_Intrin_Fun_Type Except_Table [] =
480 {
481 MAKE_INTRINSIC_0("__get_exception_info", get_exception_info_intrinsic, SLANG_VOID_TYPE),
482 MAKE_INTRINSIC_SIS("new_exception", new_exception, SLANG_VOID_TYPE),
483 SLANG_END_INTRIN_FUN_TABLE
484 };
485
_pSLang_init_exceptions(void)486 int _pSLang_init_exceptions (void)
487 {
488 _pSLerr_New_Exception_Hook = new_exception_hook;
489 if (-1 == _pSLerr_init_interp_exceptions ())
490 return -1;
491
492 if (-1 == SLadd_intrin_fun_table(Except_Table, NULL))
493 return -1;
494
495 return 0;
496 }
497
498