/*************************************************************************/
/* Package name  : Except.                                               */
/* Version       : 1.0                                                   */
/* Completed     : April 1993.                                           */
/* Released      : 29 September 1993.                                    */
/* First created : This package was first created in April 1993.         */
/* Summary       : This package provides Ada-like exceptions for C.      */
/* Components    : except.fw  - FunnelWeb source file.                   */
/*                 except.h   - Exported header file.                    */
/*                 except.c   - Implementation file.                     */
/*                 ex_test.c  - C test program.                          */
/* Requires      : style.h, as.h, as.c.                                  */
/* Author        : Ross N. Williams (ross@guest.adelaide.edu.au)         */
/*                 Rocksoft^tm Pty Ltd                                   */
/*                 16 Lerwick Avenue, Hazelwood Park 5066, Australia.    */
/* FTP Archive   : This file can be found in                             */
/*                 "ftp.adelaide.edu.au/pub/funnelweb/examples/"         */
/* Disclaimer    : This program is distributed WITHOUT ANY WARRANTY;     */
/*                 without even the implied warranty of MERCHANTABILITY  */
/*                 or FITNESS FOR A PARTICULAR PURPOSE.                  */
/* Copyright     : Copyright (C) Ross Williams 1993.                     */
/*                 However, permission is granted for anyone to copy,    */
/*                 modify, and distribute this work for any purpose,     */
/*                 commercial or non-commercial, so long as this notice  */
/*                 is included verbatim, and so long as all              */
/*                 modifications are recorded in the change log below.   */
/* Changes       : Please log any changes to this software either in the */
/*                 originating FunnelWeb source file, or, if you must,   */
/*                 in the C source files produced from the FunnelWeb     */
/*                 file.                                                 */
/* --<Start of Change Log>--                                             */
/* ??-Apr-93: RNW: Created this package.                                 */
/* 29-Sep-93: RNW: Released this package.                                */
/* --<End of Change Log>--                                               */
/*************************************************************************/

#include "except.h"
#include "as.h"

#if !_EX_THRD
GLOVAR _ex_cx_t *_ex_curr = NULL;
GLOVAR p_ex_t    _ex_id;
GLOVAR ptrint    _ex_info;
#endif


EXPORT string ex_str (p_ex) p_ex_t p_ex; {return p_ex;}

LOCAL void ex_bomb P_((void));
LOCAL void ex_bomb ()
{
 char s[100];
 as_wr("        Exception desc is : \""); as_wr(EX_ID); as_wl("\".");
 as_wr("        Exception id   is : ");
 sprintf(s,"%lu (= %lX)",ULONG(EX_ID),ULONG(EX_ID)); as_wl(s);
 as_wr("        Exception info is : ");
 sprintf(s,"%lu (= %lX)",ULONG(EX_INFO),ULONG(EX_INFO)); as_wl(s);
 as_bomb("Aborting program after exception error.");
}


EXPORT void _exrai (p_ex)
p_ex_t p_ex;
{
#if _EX_FAST
 as_bomb("_exrai: This function should not be called with _EX_FAST==TRUE.");
#else
 _ex_cx_t * p_curr = _EX_CURR;
 _EX_ID = p_ex;
 
 if (p_curr == NULL) {as_wl("_exrai: Unhandled exception."); ex_bomb();}
 
 if (UWIDE(&p_curr) > UWIDE(&p_curr->_ex_jmbf))
   {
    as_wl("_exrai: Target exception context is no longer legitimate.");
    as_wl("        Exception context resides beneath the top of stack.");
    as_wl("        This means that earlier on, control must have left an");
    as_wl("        exception context without first popping its handler.");
    as_wl("        Look for jumps out of exception contexts that are not");
    as_wl("        immediately preceded by calls to EX_POP.");
    ex_bomb();
   }
 
 if ((p_curr->_ex_mag1 != _EX_MAG1) || (p_curr->_ex_mag2 != _EX_MAG2))
   {
    as_wl("_exrai: Target exception context has been corrupted. This could");
    as_wl("        be because an exception context wasn't popped, or it");
    as_wl("        could be just a common garden-variety C corruption :-)");
    ex_bomb();
   }
 longjmp(p_curr->_ex_jmbf,NON_ZERO);
#endif
}


EXPORT void _expop (p_check)
_ex_cx_t *p_check;
{
#if _EX_FAST
 as_bomb("_exrai: This function should not be called with _EX_FAST==TRUE.");
#else
 _ex_cx_t * p_curr = _EX_CURR;
 
 if (p_curr != p_check)
   {
    if (p_curr == NULL)
       as_bomb("_expop: Context stack is empty.");
    else
       as_bomb("_expop: Top of context stack is not the current context.");
   }
 
 
 if ((p_curr->_ex_mag1 != _EX_MAG1) || (p_curr->_ex_mag2 != _EX_MAG2))
   {
    as_wl("_ex_rai: Target exception context has been corrupted. This could");
    as_wl("         be because an exception context wasn't popped, or it");
    as_wl("         could be just a common garden-variety C corruption :-)");
    as_bomb("Aborting program after exception error.");
   }
 
 
 p_curr->_ex_mag1 = ~_EX_MAG1;
 p_curr->_ex_mag2 = ~_EX_MAG2;
 
 _EX_CURR = p_curr->_ex_prev;
#endif
}