1 /* error handling common to all routines. */
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 
23 #include "slinclud.h"
24 
25 #include "slang.h"
26 #include "_slang.h"
27 
28 void (*_pSLinterpreter_Error_Hook) (int) = NULL;
29 
30 void (*SLang_VMessage_Hook) (SLFUTURE_CONST char *, va_list) = NULL;
31 void (*SLang_Error_Hook)(SLFUTURE_CONST char *) = NULL;
32 void (*SLang_Exit_Error_Hook)(SLFUTURE_CONST char *, va_list) = NULL;
33 void (*SLang_Dump_Routine)(SLFUTURE_CONST char *) = NULL;
34 
35 volatile int _pSLang_Error = 0;
36 volatile int SLKeyBoard_Quit = 0;
37 
38 typedef struct _Exception_Type Exception_Type;
39 struct _Exception_Type
40 {
41    int error_code;
42    SLFUTURE_CONST char *name;
43    SLFUTURE_CONST char *description;
44    Exception_Type *subclasses;
45    Exception_Type *next;
46    Exception_Type *parent;
47 };
48 
49 static Exception_Type *Exception_Root;
50 static Exception_Type Exception_Root_Buf =
51 {
52    -1, "AnyError", "All Errors", NULL, NULL, NULL
53 };
54 
55 /* Built-in error codes */
56 /* These values should correspond to the values produced by _pSLerr_init.
57  * Some apps may not use the interpreter, and as such _pSLerr_init will not
58  * get called.
59  */
60 int SL_Any_Error = -1;
61 int SL_Unknown_Error = 6;
62 int SL_Internal_Error = 5;
63 int SL_OS_Error = 1;
64 int   SL_Malloc_Error = 2;
65 int   SL_Import_Error = 7;
66 int SL_RunTime_Error = 3;
67 int   SL_InvalidParm_Error = 4;
68 int   SL_TypeMismatch_Error = 8;
69 int   SL_UserBreak_Error = 9;
70 int   SL_Stack_Error = 10;
71 int     SL_StackOverflow_Error = 12;
72 int     SL_StackUnderflow_Error = 11;
73 int   SL_ReadOnly_Error = 13;
74 int   SL_VariableUninitialized_Error = 14;
75 int   SL_NumArgs_Error = 15;
76 int   SL_Index_Error = 16;
77 int   SL_Usage_Error = 17;
78 int   SL_Application_Error = 18;
79 int   SL_NotImplemented_Error = 19;
80 int   SL_LimitExceeded_Error = 20;
81 int   SL_Forbidden_Error = 21;
82 int   SL_Math_Error = 22;
83 int     SL_DivideByZero_Error = 23;
84 int     SL_ArithOverflow_Error = 24;
85 int     SL_ArithUnderflow_Error = 25;
86 int     SL_Domain_Error = 26;
87 int   SL_IO_Error = 27;
88 int     SL_Write_Error = 28;
89 int     SL_Read_Error = 29;
90 int     SL_Open_Error = 30;
91 int   SL_Data_Error = 31;
92 int   SL_Unicode_Error = 32;
93 int     SL_InvalidUTF8_Error = 33;
94 int   SL_Namespace_Error = 34;
95 int SL_Parse_Error = 35;
96 int   SL_Syntax_Error = 36;
97 int   SL_DuplicateDefinition_Error = 37;
98 int   SL_UndefinedName_Error = 38;
99 
100 typedef struct
101 {
102    int *errcode_ptr;
103    SLFUTURE_CONST char *name;
104    SLFUTURE_CONST char *description;
105    int *base_class_ptr;
106 }
107 BuiltIn_Exception_Table_Type;
108 
109 static SLCONST BuiltIn_Exception_Table_Type BuiltIn_Exception_Table[] =
110 {
111    /* Define MallocError and InvalidParmError ASAP */
112      {&SL_OS_Error, "OSError", "OS Error", &SL_Any_Error},
113        {&SL_Malloc_Error, "MallocError", "Not enough memory", &SL_OS_Error},
114 
115      {&SL_RunTime_Error, "RunTimeError", "Run-Time Error", &SL_Any_Error},
116        {&SL_InvalidParm_Error, "InvalidParmError", "Invalid Parameter", &SL_RunTime_Error},
117 
118      {&SL_Internal_Error, "InternalError", "Internal Error", &SL_Any_Error},
119      {&SL_Unknown_Error, "UnknownError", "Unknown Error", &SL_Any_Error},
120 
121    /* Rest of OSErrors */
122        {&SL_Import_Error, "ImportError", "Import Error", &SL_OS_Error},
123 
124    /* Rest of RunTimeErrors */
125        {&SL_TypeMismatch_Error, "TypeMismatchError", "Type Mismatch", &SL_RunTime_Error},
126        {&SL_UserBreak_Error, "UserBreakError", "User Break", &SL_RunTime_Error},
127        {&SL_Stack_Error, "StackError", "Stack Error", &SL_RunTime_Error},
128          {&SL_StackUnderflow_Error, "StackUnderflowError", "Stack Underflow Error", &SL_Stack_Error},
129          {&SL_StackOverflow_Error, "StackOverflowError", "Stack Overflow Error", &SL_Stack_Error},
130        {&SL_ReadOnly_Error, "ReadOnlyError", "Read-Only Error", &SL_RunTime_Error},
131        {&SL_VariableUninitialized_Error, "VariableUninitializedError", "Variable Uninitialized Error", &SL_RunTime_Error},
132        {&SL_NumArgs_Error, "NumArgsError", "Invalid Number of Arguments", &SL_RunTime_Error},
133        {&SL_Index_Error, "IndexError", "Invalid Index", &SL_RunTime_Error},
134        {&SL_Usage_Error, "UsageError", "Illegal Usage", &SL_RunTime_Error},
135        {&SL_Application_Error, "ApplicationError", "Application Error", &SL_RunTime_Error},
136        {&SL_NotImplemented_Error, "NotImplementedError", "Not Implemented", &SL_RunTime_Error},
137        {&SL_LimitExceeded_Error, "LimitExceededError", "Limit Exceeded", &SL_RunTime_Error},
138        {&SL_Forbidden_Error, "ForbiddenError", "Operation Forbidden", &SL_RunTime_Error},
139        {&SL_Math_Error, "MathError", "Math Error", &SL_RunTime_Error},
140          {&SL_DivideByZero_Error, "DivideByZeroError", "Divide by Zero", &SL_Math_Error},
141          {&SL_ArithOverflow_Error, "ArithOverflowError", "Arithmetic Overflow", &SL_Math_Error},
142          {&SL_ArithUnderflow_Error, "ArithUnderflowError", "Arithmetic Underflow", &SL_Math_Error},
143          {&SL_Domain_Error, "DomainError", "Domain Error", &SL_Math_Error},
144        {&SL_IO_Error, "IOError", "I/O Error", &SL_RunTime_Error},
145          {&SL_Write_Error, "WriteError", "Write failed", &SL_IO_Error},
146          {&SL_Read_Error, "ReadError", "Read failed", &SL_IO_Error},
147          {&SL_Open_Error, "OpenError", "Open failed", &SL_IO_Error},
148        {&SL_Data_Error, "DataError", "Data Error", &SL_RunTime_Error},
149        {&SL_Unicode_Error, "UnicodeError", "Unicode Error", &SL_RunTime_Error},
150          {&SL_InvalidUTF8_Error, "UTF8Error", "Invalid UTF8", &SL_Unicode_Error},
151        {&SL_Namespace_Error, "NamespaceError", "Namespace Error", &SL_RunTime_Error},
152 
153    /* Parse Errors */
154        {&SL_Parse_Error, "ParseError", "Parse Error", &SL_Any_Error},
155          {&SL_Syntax_Error, "SyntaxError", "Syntax Error", &SL_Parse_Error},
156          {&SL_DuplicateDefinition_Error, "DuplicateDefinitionError", "Duplicate Definition", &SL_Parse_Error},
157          {&SL_UndefinedName_Error, "UndefinedNameError", "Undefined Name", &SL_Parse_Error},
158    {NULL, NULL, NULL, NULL}
159 };
160 
find_exception(Exception_Type * root,int error_code)161 static Exception_Type *find_exception (Exception_Type *root, int error_code)
162 {
163    Exception_Type *e;
164 
165    while (root != NULL)
166      {
167 	if (error_code == root->error_code)
168 	  return root;
169 
170 	if (root->subclasses != NULL)
171 	  {
172 	     e = find_exception (root->subclasses, error_code);
173 	     if (e != NULL)
174 	       return e;
175 	  }
176 	root = root->next;
177      }
178 
179    return root;
180 }
181 
is_exception_ancestor(int a,int b)182 static int is_exception_ancestor (int a, int b)
183 {
184    Exception_Type *e;
185 
186    if (a == b)
187      return 1;
188 
189    if (NULL == (e = find_exception (Exception_Root, a)))
190      return 0;
191 
192    while (e->parent != NULL)
193      {
194 	e = e->parent;
195 	if (e->error_code == b)
196 	  return 1;
197      }
198    return 0;
199 }
200 
SLerr_exception_eqs(int a,int b)201 int SLerr_exception_eqs (int a, int b)
202 {
203    if (is_exception_ancestor (a, b))
204      return 1;
205 
206    return 0;
207 }
208 
free_this_exception(Exception_Type * e)209 static void free_this_exception (Exception_Type *e)
210 {
211    if (e == NULL)
212      return;
213 
214    if (e->name != NULL)
215      SLang_free_slstring ((char *) e->name);
216 
217    if (e->description != NULL)
218      SLang_free_slstring ((char *) e->description);
219 
220    SLfree ((char *)e);
221 }
222 
223 static int Next_Exception_Code;
224 /* The whole point of this nonsense involving the _pSLerr_New_Exception_Hook
225  * is to provide a mechanism to avoid linking in the interpreter for apps
226  * that just want the other facilities.
227  */
228 int (*_pSLerr_New_Exception_Hook)(SLFUTURE_CONST char *name, SLFUTURE_CONST char *desc, int error_code);
229 
_pSLerr_init_interp_exceptions(void)230 int _pSLerr_init_interp_exceptions (void)
231 {
232    SLCONST BuiltIn_Exception_Table_Type *b;
233    Exception_Type *e;
234 
235    if (_pSLerr_New_Exception_Hook == NULL)
236      return 0;
237 
238    e = &Exception_Root_Buf;
239    if (-1 == (*_pSLerr_New_Exception_Hook)(e->name, e->description, e->error_code))
240      return -1;
241 
242    b = BuiltIn_Exception_Table;
243    while (b->errcode_ptr != NULL)
244      {
245 	if (-1 == (*_pSLerr_New_Exception_Hook)(b->name, b->description, *b->errcode_ptr))
246 	  return -1;
247 
248 	b++;
249      }
250    return 0;
251 }
252 
SLerr_new_exception(int baseclass,SLFUTURE_CONST char * name,SLFUTURE_CONST char * descript)253 int SLerr_new_exception (int baseclass, SLFUTURE_CONST char *name, SLFUTURE_CONST char *descript)
254 {
255    Exception_Type *base;
256    Exception_Type *e;
257 
258    if (-1 == _pSLerr_init ())
259      return -1;
260 
261    base = find_exception (Exception_Root, baseclass);
262    if (base == NULL)
263      {
264 	_pSLang_verror (SL_InvalidParm_Error,
265 		      "Base class for new exception not found");
266 	return -1;
267      }
268 
269    e = (Exception_Type *) SLcalloc (1, sizeof (Exception_Type));
270    if (e == NULL)
271      return -1;
272 
273    if ((NULL == (e->name = SLang_create_slstring (name)))
274        || (NULL == (e->description = SLang_create_slstring (descript))))
275      {
276 	free_this_exception (e);
277 	return -1;
278      }
279 
280    e->error_code = Next_Exception_Code;
281 
282    if ((_pSLerr_New_Exception_Hook != NULL)
283        && (-1 == (*_pSLerr_New_Exception_Hook) (e->name, e->description, e->error_code)))
284      {
285 	free_this_exception (e);
286 	return -1;
287      }
288 
289    e->parent = base;
290    e->next = base->subclasses;
291    base->subclasses = e;
292 
293    Next_Exception_Code++;
294    return e->error_code;
295 }
296 
init_exceptions(void)297 static int init_exceptions (void)
298 {
299    SLCONST BuiltIn_Exception_Table_Type *b;
300 
301    if (Exception_Root != NULL)
302      return 0;
303 
304    Exception_Root = &Exception_Root_Buf;
305    Next_Exception_Code = 1;
306    b = BuiltIn_Exception_Table;
307    while (b->errcode_ptr != NULL)
308      {
309 	int err_code;
310 
311 	err_code = SLerr_new_exception (*b->base_class_ptr, b->name, b->description);
312 	if (err_code == -1)
313 	  return -1;
314 
315 	*b->errcode_ptr = err_code;
316 	b++;
317      }
318 
319    return 0;
320 }
321 
free_exceptions(Exception_Type * root)322 static void free_exceptions (Exception_Type *root)
323 {
324    while (root != NULL)
325      {
326 	Exception_Type *next;
327 
328 	if (root->subclasses != NULL)
329 	  free_exceptions (root->subclasses);
330 
331 	next = root->next;
332 	free_this_exception (root);
333 	root = next;
334      }
335 }
336 
deinit_exceptions(void)337 static void deinit_exceptions (void)
338 {
339    Exception_Type *root = Exception_Root;
340 
341    if (root != NULL)
342      free_exceptions (root->subclasses);
343 
344    Exception_Root = NULL;
345    Next_Exception_Code = 0;
346 }
347 
SLerr_strerror(int err_code)348 SLFUTURE_CONST char *SLerr_strerror (int err_code)
349 {
350    Exception_Type *e;
351 
352    if (err_code == 0)
353      err_code = _pSLang_Error;
354 
355    if (-1 == _pSLerr_init ())
356      return "Unable to initialize SLerr module";
357 
358    if (NULL == (e = find_exception (Exception_Root, err_code)))
359      return "Invalid/Unknown Error Code";
360 
361    return e->description;
362 }
363 
364 /* Error Queue Functions
365  *   SLang_verror (int errcode, fmt, args)
366  *     Add an error message to the queue.
367  *   SLerr_delete_queue ()
368  *     Removes messages from the error queue
369  *   SLerr_print_queue ()
370  *     Prints all messages from the queue, deletes the queue
371  */
372 typedef struct _Error_Message_Type
373 {
374    char *msg;			       /* SLstring, may be NULL */
375    int msg_type;
376    struct _Error_Message_Type *next;
377 }
378 Error_Message_Type;
379 
380 static SLFUTURE_CONST char *Static_Error_Message = NULL;
381 
382 struct _pSLerr_Error_Queue_Type
383 {
384    Error_Message_Type *head;
385    Error_Message_Type *tail;
386 };
387 
388 static _pSLerr_Error_Queue_Type *Default_Error_Queue;
389 static _pSLerr_Error_Queue_Type *Active_Error_Queue;
390 
free_error_msg(Error_Message_Type * m)391 static void free_error_msg (Error_Message_Type *m)
392 {
393    if (m == NULL)
394      return;
395    if (m->msg != NULL)
396      SLang_free_slstring (m->msg);
397    SLfree ((char *)m);
398 }
399 
allocate_error_msg(char * msg,int msg_type)400 static Error_Message_Type *allocate_error_msg (char *msg, int msg_type)
401 {
402    Error_Message_Type *m;
403 
404    if (NULL == (m = (Error_Message_Type*) SLcalloc (1, sizeof (Error_Message_Type))))
405      return NULL;
406 
407    if ((NULL != msg) && (NULL == (m->msg = SLang_create_slstring (msg))))
408      {
409 	free_error_msg (m);
410 	return NULL;
411      }
412    m->msg_type = msg_type;
413    return m;
414 }
415 
free_queued_messages(_pSLerr_Error_Queue_Type * q)416 static void free_queued_messages (_pSLerr_Error_Queue_Type *q)
417 {
418    Error_Message_Type *m;
419 
420    if (q == NULL)
421      return;
422 
423    m = q->head;
424    while (m != NULL)
425      {
426 	Error_Message_Type *m1 = m->next;
427 	free_error_msg (m);
428 	m = m1;
429      }
430    q->head = NULL;
431    q->tail = NULL;
432 }
433 
_pSLerr_delete_error_queue(_pSLerr_Error_Queue_Type * q)434 void _pSLerr_delete_error_queue (_pSLerr_Error_Queue_Type *q)
435 {
436    if (q == NULL)
437      return;
438 
439    free_queued_messages (q);
440    SLfree ((char *)q);
441 }
442 
_pSLerr_new_error_queue(int make_active)443 _pSLerr_Error_Queue_Type *_pSLerr_new_error_queue (int make_active)
444 {
445    _pSLerr_Error_Queue_Type *q;
446 
447    if (NULL == (q = (_pSLerr_Error_Queue_Type *)SLcalloc (1, sizeof(_pSLerr_Error_Queue_Type))))
448      return NULL;
449 
450    if (make_active)
451      Active_Error_Queue = q;
452    return q;
453 }
454 
queue_message(_pSLerr_Error_Queue_Type * q,char * msg,int msg_type)455 static int queue_message (_pSLerr_Error_Queue_Type *q, char *msg, int msg_type)
456 {
457    Error_Message_Type *m;
458 
459    if (NULL == (m = allocate_error_msg (msg, msg_type)))
460      return -1;
461 
462    if (q->tail != NULL)
463      q->tail->next = m;
464    if (q->head == NULL)
465      q->head = m;
466    q->tail = m;
467 
468    return 0;
469 }
470 
print_error(int msg_type,SLFUTURE_CONST char * err)471 static void print_error (int msg_type, SLFUTURE_CONST char *err)
472 {
473    SLstrlen_Type len;
474 
475    switch (msg_type)
476      {
477       case _SLERR_MSG_ERROR:
478 	if (SLang_Error_Hook != NULL)
479 	  {
480 	     (*SLang_Error_Hook)(err);
481 	     return;
482 	  }
483 	break;
484       case _SLERR_MSG_TRACEBACK:
485       case _SLERR_MSG_WARNING:
486 	if (SLang_Dump_Routine != NULL)
487 	  {
488 	     (*SLang_Dump_Routine)(err);
489 	     return;
490 	  }
491 	break;
492      }
493 
494    len = strlen (err);
495    if (len == 0)
496      return;
497 
498    fputs (err, stderr);
499    if ((err[len-1] != '\n')
500        && (msg_type != _SLERR_MSG_TRACEBACK))
501      fputs("\n", stderr);
502 
503    fflush (stderr);
504 }
505 
print_queue(void)506 static void print_queue (void)
507 {
508    if (-1 == _pSLerr_init ())
509      print_error (_SLERR_MSG_ERROR, "Unable to initialize SLerr module");
510 
511    if (_pSLang_Error == 0)
512      return;
513 
514    if (Active_Error_Queue != NULL)
515      {
516 	_pSLerr_Error_Queue_Type *q = Active_Error_Queue;
517 	Error_Message_Type *m = q->head;
518 	while (m != NULL)
519 	  {
520 	     Error_Message_Type *m_next = m->next;
521 	     if (m->msg != NULL)
522 	       print_error (m->msg_type, m->msg);
523 	     m = m_next;
524 	  }
525 
526 	free_queued_messages (q);
527      }
528    if (Static_Error_Message != NULL)
529      {
530 	print_error (_SLERR_MSG_ERROR, Static_Error_Message);
531 	Static_Error_Message = NULL;
532      }
533 }
534 
535 /* This function concatenates messages in the queue of the specified type and
536  * returns them as an SLstring.
537  */
_pSLerr_get_error_from_queue(_pSLerr_Error_Queue_Type * q,int type)538 char *_pSLerr_get_error_from_queue (_pSLerr_Error_Queue_Type *q, int type)
539 {
540    Error_Message_Type *m;
541    SLstrlen_Type len;
542    char *err, *err1, *err_max;
543    SLstrlen_Type nl_len;
544 
545    if ((q == NULL)
546        && (NULL == (q = Default_Error_Queue)))
547      return NULL;
548 
549    len = 0;
550    /* Only _SLERR_MSG_ERROR type errors need \n to separate them. */
551    nl_len = (type == _SLERR_MSG_ERROR) ? 1 : 0;
552    m = q->head;
553    while (m != NULL)
554      {
555 	if (m->msg_type == type)
556 	  len += nl_len + strlen (m->msg);
557 
558 	m = m->next;
559      }
560 
561    if (len)
562      len -= nl_len;			       /* last \n not needed */
563 
564    if (NULL == (err = _pSLallocate_slstring (len)))
565      return NULL;
566 
567    err_max = err + len;
568    err1 = err;
569    m = q->head;
570    while (m != NULL)
571      {
572 	if (m->msg_type == type)
573 	  {
574 	     SLstrlen_Type dlen = strlen (m->msg);
575 	     strcpy (err1, m->msg);
576 	     err1 += dlen;
577 	     if (nl_len && (err1 != err_max))
578 	       *err1++ = '\n';
579 	  }
580 	m = m->next;
581      }
582    *err1 = 0;
583 
584    return _pSLcreate_via_alloced_slstring (err, len);
585 }
586 
_pSLerr_print_message_queue(void)587 void _pSLerr_print_message_queue (void)
588 {
589    print_queue ();
590 }
591 
592 static volatile int Suspend_Error_Messages = 0;
_pSLerr_resume_messages(void)593 int _pSLerr_resume_messages (void)
594 {
595    if (Suspend_Error_Messages == 0)
596      return 0;
597 
598    Suspend_Error_Messages--;
599    if (Suspend_Error_Messages == 0)
600      print_queue ();
601    return 0;
602 }
603 
_pSLerr_suspend_messages(void)604 int _pSLerr_suspend_messages (void)
605 {
606    Suspend_Error_Messages++;
607    return 0;
608 }
609 
_pSLerr_free_queued_messages(void)610 void _pSLerr_free_queued_messages (void)
611 {
612    Static_Error_Message = NULL;
613    free_queued_messages (Active_Error_Queue);
614 }
615 
set_error(int error)616 static void set_error (int error)
617 {
618    /* Only allow an error to be cleared (error==0), but not changed
619     * if there already is an error.
620     */
621    if ((error == 0)
622        || (_pSLang_Error == 0))
623      {
624 	Static_Error_Message = NULL;
625 	_pSLang_Error = error;
626      }
627 
628    if (_pSLinterpreter_Error_Hook != NULL)
629      (*_pSLinterpreter_Error_Hook) (_pSLang_Error);
630 }
631 
verror_va(int err_code,SLCONST char * fmt,va_list ap)632 static void verror_va (int err_code, SLCONST char *fmt, va_list ap)
633 {
634    char err [4096];
635 
636    if (-1 == _pSLerr_init ())
637      {
638 	print_queue ();
639 	return;
640      }
641 
642    if (err_code == 0)
643      err_code = SL_INTRINSIC_ERROR;
644 
645    if (_pSLang_Error == 0)
646      set_error (err_code);
647 
648    if (fmt == NULL)
649      return;
650 
651    (void) SLvsnprintf (err, sizeof (err), (SLFUTURE_CONST char *)fmt, ap);
652 
653    if (Suspend_Error_Messages)
654      (void) queue_message (Active_Error_Queue, err, _SLERR_MSG_ERROR);
655    else
656      print_error (_SLERR_MSG_ERROR, err);
657 }
658 
SLang_verror_va(int err_code,SLFUTURE_CONST char * fmt,va_list ap)659 void SLang_verror_va (int err_code, SLFUTURE_CONST char *fmt, va_list ap)
660 {
661    verror_va (err_code, fmt, ap);
662 }
663 
SLang_verror(int err_code,SLFUTURE_CONST char * fmt,...)664 void SLang_verror (int err_code, SLFUTURE_CONST char *fmt, ...)
665 {
666    va_list ap;
667 
668    va_start(ap, fmt);
669    verror_va (err_code, fmt, ap);
670    va_end(ap);
671 }
672 
_pSLang_verror(int err_code,SLCONST char * fmt,...)673 void _pSLang_verror (int err_code, SLCONST char *fmt, ...)
674 {
675    va_list ap;
676 
677    va_start(ap, fmt);
678    verror_va (err_code, fmt, ap);
679    va_end(ap);
680 }
681 
_pSLerr_traceback_msg(SLFUTURE_CONST char * fmt,...)682 int _pSLerr_traceback_msg (SLFUTURE_CONST char *fmt, ...)
683 {
684    va_list ap;
685    char msg [4096];
686 
687    va_start(ap, fmt);
688    (void) SLvsnprintf (msg, sizeof (msg), fmt, ap);
689    va_end(ap);
690 
691    return queue_message (Active_Error_Queue, msg, _SLERR_MSG_TRACEBACK);
692 }
693 
SLang_exit_error(SLFUTURE_CONST char * fmt,...)694 void SLang_exit_error (SLFUTURE_CONST char *fmt, ...)
695 {
696    va_list ap;
697 
698    print_queue ();
699    va_start (ap, fmt);
700    if (SLang_Exit_Error_Hook != NULL)
701      {
702 	(*SLang_Exit_Error_Hook) (fmt, ap);
703 	exit (1);
704      }
705 
706    if (fmt != NULL)
707      {
708 	vfprintf (stderr, fmt, ap);
709 	fputs ("\n", stderr);
710 	fflush (stderr);
711      }
712    va_end (ap);
713 
714    exit (1);
715 }
716 
SLang_set_error(int error)717 int SLang_set_error (int error)
718 {
719    set_error (error);
720 
721    if (error == 0)
722      return 0;
723 
724    if (error == SL_UserBreak_Error)
725      {
726 	/* This function may be called from a SIGINT handler, in which case the
727 	 * error code will be SL_UserBreak_Error.
728 	 */
729 	/* print_error (_SLERR_MSG_ERROR, SLerr_strerror (_pSLang_Error)); */
730 	Static_Error_Message = SLerr_strerror (error);
731 	return 0;
732      }
733 
734    /* If a string is not in the message queue, then add one. */
735    if (Active_Error_Queue != NULL)
736      {
737 	Error_Message_Type *m = Active_Error_Queue->head;
738 	while (m != NULL)
739 	  {
740 	     if (m->msg_type == _SLERR_MSG_ERROR)
741 	       return 0;
742 	     m = m->next;
743 	  }
744      }
745 
746    _pSLang_verror (_pSLang_Error, "%s", SLerr_strerror (_pSLang_Error));
747    return 0;
748 }
749 
SLang_get_error(void)750 int SLang_get_error (void)
751 {
752    return _pSLang_Error;
753 }
754 
SLang_vmessage(SLFUTURE_CONST char * fmt,...)755 void SLang_vmessage (SLFUTURE_CONST char *fmt, ...)
756 {
757    va_list ap;
758 
759    if (fmt == NULL)
760      return;
761 
762    va_start (ap, fmt);
763 
764    if (SLang_VMessage_Hook != NULL)
765      (*SLang_VMessage_Hook) (fmt, ap);
766    else
767      {
768 	vfprintf (stdout, fmt, ap);
769 	fputs ("\n", stdout);
770 	(void) fflush (stdout);
771      }
772 
773    va_end (ap);
774 }
775 
776 /* This routine does not queue messages.  It is used for tracing, etc. */
_pSLerr_dump_msg(SLFUTURE_CONST char * fmt,...)777 void _pSLerr_dump_msg (SLFUTURE_CONST char *fmt, ...)
778 {
779    va_list ap;
780 
781    va_start (ap, fmt);
782    if (SLang_Dump_Routine != NULL)
783      {
784 	char buf[1024];
785 	(void) SLvsnprintf (buf, sizeof (buf), fmt, ap);
786 	(*SLang_Dump_Routine) (buf);
787      }
788    else
789      {
790 	vfprintf (stderr, fmt, ap);
791 	fflush (stderr);
792      }
793    va_end (ap);
794 }
795 
_pSLerr_set_error_queue(_pSLerr_Error_Queue_Type * q)796 int _pSLerr_set_error_queue (_pSLerr_Error_Queue_Type *q)
797 {
798    if (q == NULL)
799      {
800 	q = Default_Error_Queue;
801 	if (Default_Error_Queue == NULL)
802 	  return _pSLerr_init ();
803      }
804    Active_Error_Queue = q;
805    return 0;
806 }
807 
808 #if defined(__WIN32__)
809 #include <crtdbg.h>  /* For _CrtSetReportMode */
810 /* See <https://msdn.microsoft.com/en-us/library/ksazx244%28v=vs.140%29.aspx>
811  * for an explanation of the invalid_parm_handler.  The default
812  * handler will cause the program to terminate on code such as:
813  *
814  *  FILE *fp = fdopen (fd);
815  *  close (fd);
816  *  fclose (fp);  <--- underlying descriptor has been closed.
817  *
818  * On POSIX systems, fclose will fail with errno == EBADF.
819  */
invalid_parm_handler(const wchar_t * expression,const wchar_t * function,const wchar_t * file,unsigned int line,uintptr_t pReserved)820 static void invalid_parm_handler (const wchar_t* expression,
821 				  const wchar_t* function,
822 				  const wchar_t* file,
823 				  unsigned int line,
824 				  uintptr_t pReserved)
825 {
826    (void) expression;
827    (void) function;
828    (void) file;
829    (void) line;
830    (void) pReserved;
831 }
832 #endif
833 
_pSLerr_deinit(void)834 void _pSLerr_deinit (void)
835 {
836    deinit_exceptions ();
837    _pSLerr_delete_error_queue (Default_Error_Queue);
838    Suspend_Error_Messages = 0;
839    Default_Error_Queue = NULL;
840    Active_Error_Queue = NULL;
841    Static_Error_Message = NULL;
842 }
843 
_pSLerr_init(void)844 int _pSLerr_init (void)
845 {
846    static int inited = 0;
847 
848 #ifdef __WIN32__
849    (void) _set_invalid_parameter_handler (invalid_parm_handler);
850    /* Disable the message box for assertions. */
851    _CrtSetReportMode(_CRT_ASSERT, 0);
852 #endif
853 
854    if (Default_Error_Queue == NULL)
855      {
856 	Suspend_Error_Messages = 0;
857 	if (NULL == (Default_Error_Queue = _pSLerr_new_error_queue (1)))
858 	  return -1;
859      }
860 
861    if (-1 == init_exceptions ())
862      return -1;
863 
864    if (inited == 0)
865      {
866 	inited = 1;
867 	(void) SLang_add_cleanup_function (_pSLerr_deinit);
868      }
869    return 0;
870 }
871 
872