slang/slerr.c

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