path: root/gcc/m2/mc-boot/GRTExceptions.c

/* do not edit automatically generated by mc from RTExceptions.  */
/* RTExceptions.mod runtime exception handler routines.

Copyright (C) 2008-2021 Free Software Foundation, Inc.
Contributed by Gaius Mulley <gaius.mulley@southwales.ac.uk>.

This file is part of GNU Modula-2.

GNU Modula-2 is free software; you can redistribute it and/or modify
it under the terms of the GNU General Public License as published by
the Free Software Foundation; either version 3, or (at your option)
any later version.

GNU Modula-2 is distributed in the hope that it will be useful, but
WITHOUT ANY WARRANTY; without even the implied warranty of
MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE.  See the GNU
General Public License for more details.

Under Section 7 of GPL version 3, you are granted additional
permissions described in the GCC Runtime Library Exception, version
3.1, as published by the Free Software Foundation.

You should have received a copy of the GNU General Public License and
a copy of the GCC Runtime Library Exception along with this program;
see the files COPYING3 and COPYING.RUNTIME respectively.  If not, see
<http://www.gnu.org/licenses/>.  */

#include "config.h"
#include "system.h"
#   if !defined (PROC_D)
#      define PROC_D
       typedef void (*PROC_t) (void);
       typedef struct { PROC_t proc; } PROC;
#   endif

#   if !defined (FALSE)
#      define FALSE (1==0)
#   endif

#   include "GStorage.h"
#   include "Gmcrts.h"
#ifndef __cplusplus
extern void throw (unsigned int);
#endif
#if defined(__cplusplus)
#   undef NULL
#   define NULL 0
#endif
#define _RTExceptions_H
#define _RTExceptions_C

#   include "GASCII.h"
#   include "GStrLib.h"
#   include "GStorage.h"
#   include "GSYSTEM.h"
#   include "Glibc.h"
#   include "GM2RTS.h"
#   include "GSysExceptions.h"
#   include "GM2EXCEPTION.h"

typedef struct RTExceptions_ProcedureHandler_p RTExceptions_ProcedureHandler;

#   define MaxBuffer 4096
typedef struct _T1_r _T1;

typedef char *PtrToChar;

typedef struct _T2_a _T2;

typedef struct _T3_r _T3;

typedef _T3 *Handler;

typedef _T1 *RTExceptions_EHBlock;

typedef void (*RTExceptions_ProcedureHandler_t) (void);
struct RTExceptions_ProcedureHandler_p { RTExceptions_ProcedureHandler_t proc; };

struct _T2_a { char array[MaxBuffer+1]; };
struct _T1_r {
               _T2 buffer;
               unsigned int number;
               Handler handlers;
               RTExceptions_EHBlock right;
             };

struct _T3_r {
               RTExceptions_ProcedureHandler p;
               unsigned int n;
               Handler right;
               Handler left;
               Handler stack;
             };

static unsigned int inException;
static Handler freeHandler;
static RTExceptions_EHBlock freeEHB;
static RTExceptions_EHBlock currentEHB;
static void * currentSource;

/*
   Raise - invoke the exception handler associated with, number,
           in the active EHBlock.  It keeps a record of the number
           and message in the EHBlock for later use.
*/

extern "C" void RTExceptions_Raise (unsigned int number, void * file, unsigned int line, unsigned int column, void * function, void * message);

/*
   SetExceptionBlock - sets, source, as the active EHB.
*/

extern "C" void RTExceptions_SetExceptionBlock (RTExceptions_EHBlock source);

/*
   GetExceptionBlock - returns the active EHB.
*/

extern "C" RTExceptions_EHBlock RTExceptions_GetExceptionBlock (void);

/*
   GetTextBuffer - returns the address of the EHB buffer.
*/

extern "C" void * RTExceptions_GetTextBuffer (RTExceptions_EHBlock e);

/*
   GetTextBufferSize - return the size of the EHB text buffer.
*/

extern "C" unsigned int RTExceptions_GetTextBufferSize (RTExceptions_EHBlock e);

/*
   GetNumber - return the exception number associated with,
               source.
*/

extern "C" unsigned int RTExceptions_GetNumber (RTExceptions_EHBlock source);

/*
   InitExceptionBlock - creates and returns a new exception block.
*/

extern "C" RTExceptions_EHBlock RTExceptions_InitExceptionBlock (void);

/*
   KillExceptionBlock - destroys the EHB, e, and all its handlers.
*/

extern "C" RTExceptions_EHBlock RTExceptions_KillExceptionBlock (RTExceptions_EHBlock e);

/*
   PushHandler - install a handler in EHB, e.
*/

extern "C" void RTExceptions_PushHandler (RTExceptions_EHBlock e, unsigned int number, RTExceptions_ProcedureHandler p);

/*
   PopHandler - removes the handler associated with, number, from
                EHB, e.
*/

extern "C" void RTExceptions_PopHandler (RTExceptions_EHBlock e, unsigned int number);

/*
   DefaultErrorCatch - displays the current error message in
                       the current exception block and then
                       calls HALT.
*/

extern "C" void RTExceptions_DefaultErrorCatch (void);

/*
   BaseExceptionsThrow - configures the Modula-2 exceptions to call
                         THROW which in turn can be caught by an
                         exception block.  If this is not called then
                         a Modula-2 exception will simply call an
                         error message routine and then HALT.
*/

extern "C" void RTExceptions_BaseExceptionsThrow (void);

/*
   IsInExceptionState - returns TRUE if the program is currently
                        in the exception state.
*/

extern "C" unsigned int RTExceptions_IsInExceptionState (void);

/*
   SetExceptionState - returns the current exception state and
                       then sets the current exception state to,
                       to.
*/

extern "C" unsigned int RTExceptions_SetExceptionState (unsigned int to);

/*
   SwitchExceptionState - assigns, from, with the current exception
                          state and then assigns the current exception
                          to, to.
*/

extern "C" void RTExceptions_SwitchExceptionState (unsigned int *from, unsigned int to);

/*
   GetBaseExceptionBlock - returns the initial language exception block
                           created.
*/

extern "C" RTExceptions_EHBlock RTExceptions_GetBaseExceptionBlock (void);

/*
   SetExceptionSource - sets the current exception source to, source.
*/

extern "C" void RTExceptions_SetExceptionSource (void * source);

/*
   GetExceptionSource - returns the current exception source.
*/

extern "C" void * RTExceptions_GetExceptionSource (void);

/*
   ErrorString - writes a string to stderr.
*/

static void ErrorString (const char *a_, unsigned int _a_high);

/*
   findHandler -
*/

static Handler findHandler (RTExceptions_EHBlock e, unsigned int number);

/*
   InvokeHandler - invokes the associated handler for the current
                   exception in the active EHB.
*/

static void InvokeHandler (void);

/*
   DoThrow - throw the exception number in the exception block.
*/

static void DoThrow (void);

/*
   addChar - adds, ch, to the current exception handler text buffer
             at index, i.  The index in then incremented.
*/

static void addChar (char ch, unsigned int *i);

/*
   stripPath - returns the filename from the path.
*/

static void * stripPath (void * s);

/*
   addFile - adds the filename determined by, s, however it strips
             any preceeding path.
*/

static void addFile (void * s, unsigned int *i);

/*
   addStr - adds a C string from address, s, into the current
            handler text buffer.
*/

static void addStr (void * s, unsigned int *i);

/*
   addNum - adds a number, n, to the current handler
            text buffer.
*/

static void addNum (unsigned int n, unsigned int *i);

/*
   New - returns a new EHBlock.
*/

static RTExceptions_EHBlock New (void);

/*
   NewHandler - returns a new handler.
*/

static Handler NewHandler (void);

/*
   KillHandler - returns, NIL, and places, h, onto the free list.
*/

static Handler KillHandler (Handler h);

/*
   KillHandlers - kills all handlers in the list.
*/

static Handler KillHandlers (Handler h);

/*
   InitHandler -
*/

static Handler InitHandler (Handler h, Handler l, Handler r, Handler s, unsigned int number, RTExceptions_ProcedureHandler proc);

/*
   SubHandler -
*/

static void SubHandler (Handler h);

/*
   AddHandler - add, e, to the end of the list of handlers.
*/

static void AddHandler (RTExceptions_EHBlock e, Handler h);

/*
   indexf - raise an index out of bounds exception.
*/

static void indexf (void * a);

/*
   range - raise an assignment out of range exception.
*/

static void range (void * a);

/*
   casef - raise a case selector out of range exception.
*/

static void casef (void * a);

/*
   invalidloc - raise an invalid location exception.
*/

static void invalidloc (void * a);

/*
   function - raise a ... function ... exception.  --fixme-- what does this exception catch?
*/

static void function (void * a);

/*
   wholevalue - raise an illegal whole value exception.
*/

static void wholevalue (void * a);

/*
   wholediv - raise a division by zero exception.
*/

static void wholediv (void * a);

/*
   realvalue - raise an illegal real value exception.
*/

static void realvalue (void * a);

/*
   realdiv - raise a division by zero in a real number exception.
*/

static void realdiv (void * a);

/*
   complexvalue - raise an illegal complex value exception.
*/

static void complexvalue (void * a);

/*
   complexdiv - raise a division by zero in a complex number exception.
*/

static void complexdiv (void * a);

/*
   protection - raise a protection exception.
*/

static void protection (void * a);

/*
   systemf - raise a system exception.
*/

static void systemf (void * a);

/*
   coroutine - raise a coroutine exception.
*/

static void coroutine (void * a);

/*
   exception - raise a exception exception.
*/

static void exception (void * a);

/*
   Init - initialises this module.
*/

static void Init (void);

/*
   TidyUp - deallocate memory used by this module.
*/

static void TidyUp (void);


/*
   ErrorString - writes a string to stderr.
*/

static void ErrorString (const char *a_, unsigned int _a_high)
{
  int n;
  char a[_a_high+1];

  /* make a local copy of each unbounded array.  */
  memcpy (a, a_, _a_high+1);

  n = static_cast<int> (libc_write (2, &a, static_cast<size_t> (StrLib_StrLen ((const char *) a, _a_high))));
}


/*
   findHandler -
*/

static Handler findHandler (RTExceptions_EHBlock e, unsigned int number)
{
  Handler h;

  h = e->handlers->right;
  while ((h != e->handlers) && (number != h->n))
    {
      h = h->right;
    }
  if (h == e->handlers)
    {
      return NULL;
    }
  else
    {
      return h;
    }
  /* static analysis guarentees a RETURN statement will be used before here.  */
  __builtin_unreachable ();
}


/*
   InvokeHandler - invokes the associated handler for the current
                   exception in the active EHB.
*/

static void InvokeHandler (void)
{
  Handler h;

  h = findHandler (currentEHB, currentEHB->number);
  if (h == NULL)
    {
      throw (RTExceptions_GetNumber (RTExceptions_GetExceptionBlock ()));
    }
  else
    {
      (*h->p.proc) ();
    }
}


/*
   DoThrow - throw the exception number in the exception block.
*/

static void DoThrow (void)
{
  throw (RTExceptions_GetNumber (RTExceptions_GetExceptionBlock ()));
}


/*
   addChar - adds, ch, to the current exception handler text buffer
             at index, i.  The index in then incremented.
*/

static void addChar (char ch, unsigned int *i)
{
  if (((*i) <= MaxBuffer) && (currentEHB != NULL))
    {
      currentEHB->buffer.array[(*i)] = ch;
      (*i) += 1;
    }
}


/*
   stripPath - returns the filename from the path.
*/

static void * stripPath (void * s)
{
  PtrToChar f;
  PtrToChar p;

  p = static_cast<PtrToChar> (s);
  f = static_cast<PtrToChar> (s);
  while ((*p) != ASCII_nul)
    {
      if ((*p) == '/')
        {
          p += 1;
          f = p;
        }
      else
        {
          p += 1;
        }
    }
  return reinterpret_cast<void *> (f);
  /* static analysis guarentees a RETURN statement will be used before here.  */
  __builtin_unreachable ();
}


/*
   addFile - adds the filename determined by, s, however it strips
             any preceeding path.
*/

static void addFile (void * s, unsigned int *i)
{
  PtrToChar p;

  p = static_cast<PtrToChar> (stripPath (s));
  while ((p != NULL) && ((*p) != ASCII_nul))
    {
      addChar ((*p), i);
      p += 1;
    }
}


/*
   addStr - adds a C string from address, s, into the current
            handler text buffer.
*/

static void addStr (void * s, unsigned int *i)
{
  PtrToChar p;

  p = static_cast<PtrToChar> (s);
  while ((p != NULL) && ((*p) != ASCII_nul))
    {
      addChar ((*p), i);
      p += 1;
    }
}


/*
   addNum - adds a number, n, to the current handler
            text buffer.
*/

static void addNum (unsigned int n, unsigned int *i)
{
  if (n < 10)
    {
      addChar ( ((char) ((n % 10)+ ((unsigned int) ('0')))), i);
    }
  else
    {
      addNum (n / 10, i);
      addNum (n % 10, i);
    }
}


/*
   New - returns a new EHBlock.
*/

static RTExceptions_EHBlock New (void)
{
  RTExceptions_EHBlock e;

  if (freeEHB == NULL)
    {
      Storage_ALLOCATE ((void **) &e, sizeof (_T1));
    }
  else
    {
      e = freeEHB;
      freeEHB = freeEHB->right;
    }
  return e;
  /* static analysis guarentees a RETURN statement will be used before here.  */
  __builtin_unreachable ();
}


/*
   NewHandler - returns a new handler.
*/

static Handler NewHandler (void)
{
  Handler h;

  if (freeHandler == NULL)
    {
      Storage_ALLOCATE ((void **) &h, sizeof (_T3));
    }
  else
    {
      h = freeHandler;
      freeHandler = freeHandler->right;
    }
  return h;
  /* static analysis guarentees a RETURN statement will be used before here.  */
  __builtin_unreachable ();
}


/*
   KillHandler - returns, NIL, and places, h, onto the free list.
*/

static Handler KillHandler (Handler h)
{
  h->right = freeHandler;
  freeHandler = h;
  return NULL;
  /* static analysis guarentees a RETURN statement will be used before here.  */
  __builtin_unreachable ();
}


/*
   KillHandlers - kills all handlers in the list.
*/

static Handler KillHandlers (Handler h)
{
  h->left->right = freeHandler;
  freeHandler = h;
  return NULL;
  /* static analysis guarentees a RETURN statement will be used before here.  */
  __builtin_unreachable ();
}


/*
   InitHandler -
*/

static Handler InitHandler (Handler h, Handler l, Handler r, Handler s, unsigned int number, RTExceptions_ProcedureHandler proc)
{
  h->p = proc;
  h->n = number;
  h->right = r;
  h->left = l;
  h->stack = s;
  return h;
  /* static analysis guarentees a RETURN statement will be used before here.  */
  __builtin_unreachable ();
}


/*
   SubHandler -
*/

static void SubHandler (Handler h)
{
  h->right->left = h->left;
  h->left->right = h->right;
}


/*
   AddHandler - add, e, to the end of the list of handlers.
*/

static void AddHandler (RTExceptions_EHBlock e, Handler h)
{
  h->right = e->handlers;
  h->left = e->handlers->left;
  e->handlers->left->right = h;
  e->handlers->left = h;
}


/*
   indexf - raise an index out of bounds exception.
*/

static void indexf (void * a)
{
  RTExceptions_Raise ( ((unsigned int) (M2EXCEPTION_indexException)), const_cast<void*> (reinterpret_cast<const void*>("/home/gaius/GM2/graft-combine/gcc-git-devel-m2link/gcc/m2/gm2-libs/RTExceptions.mod")), 612, 9, const_cast<void*> (reinterpret_cast<const void*>("indexf")), const_cast<void*> (reinterpret_cast<const void*>("array index out of bounds")));
}


/*
   range - raise an assignment out of range exception.
*/

static void range (void * a)
{
  RTExceptions_Raise ( ((unsigned int) (M2EXCEPTION_rangeException)), const_cast<void*> (reinterpret_cast<const void*>("/home/gaius/GM2/graft-combine/gcc-git-devel-m2link/gcc/m2/gm2-libs/RTExceptions.mod")), 624, 9, const_cast<void*> (reinterpret_cast<const void*>("range")), const_cast<void*> (reinterpret_cast<const void*>("assignment out of range")));
}


/*
   casef - raise a case selector out of range exception.
*/

static void casef (void * a)
{
  RTExceptions_Raise ( ((unsigned int) (M2EXCEPTION_caseSelectException)), const_cast<void*> (reinterpret_cast<const void*>("/home/gaius/GM2/graft-combine/gcc-git-devel-m2link/gcc/m2/gm2-libs/RTExceptions.mod")), 636, 9, const_cast<void*> (reinterpret_cast<const void*>("casef")), const_cast<void*> (reinterpret_cast<const void*>("case selector out of range")));
}


/*
   invalidloc - raise an invalid location exception.
*/

static void invalidloc (void * a)
{
  RTExceptions_Raise ( ((unsigned int) (M2EXCEPTION_invalidLocation)), const_cast<void*> (reinterpret_cast<const void*>("/home/gaius/GM2/graft-combine/gcc-git-devel-m2link/gcc/m2/gm2-libs/RTExceptions.mod")), 648, 9, const_cast<void*> (reinterpret_cast<const void*>("invalidloc")), const_cast<void*> (reinterpret_cast<const void*>("invalid address referenced")));
}


/*
   function - raise a ... function ... exception.  --fixme-- what does this exception catch?
*/

static void function (void * a)
{
  RTExceptions_Raise ( ((unsigned int) (M2EXCEPTION_functionException)), const_cast<void*> (reinterpret_cast<const void*>("/home/gaius/GM2/graft-combine/gcc-git-devel-m2link/gcc/m2/gm2-libs/RTExceptions.mod")), 660, 9, const_cast<void*> (reinterpret_cast<const void*>("function")), const_cast<void*> (reinterpret_cast<const void*>("... function ... ")));  /* --fixme-- what has happened ?  */
}


/*
   wholevalue - raise an illegal whole value exception.
*/

static void wholevalue (void * a)
{
  RTExceptions_Raise ( ((unsigned int) (M2EXCEPTION_wholeValueException)), const_cast<void*> (reinterpret_cast<const void*>("/home/gaius/GM2/graft-combine/gcc-git-devel-m2link/gcc/m2/gm2-libs/RTExceptions.mod")), 672, 9, const_cast<void*> (reinterpret_cast<const void*>("wholevalue")), const_cast<void*> (reinterpret_cast<const void*>("illegal whole value exception")));
}


/*
   wholediv - raise a division by zero exception.
*/

static void wholediv (void * a)
{
  RTExceptions_Raise ( ((unsigned int) (M2EXCEPTION_wholeDivException)), const_cast<void*> (reinterpret_cast<const void*>("/home/gaius/GM2/graft-combine/gcc-git-devel-m2link/gcc/m2/gm2-libs/RTExceptions.mod")), 684, 9, const_cast<void*> (reinterpret_cast<const void*>("wholediv")), const_cast<void*> (reinterpret_cast<const void*>("illegal whole value exception")));
}


/*
   realvalue - raise an illegal real value exception.
*/

static void realvalue (void * a)
{
  RTExceptions_Raise ( ((unsigned int) (M2EXCEPTION_realValueException)), const_cast<void*> (reinterpret_cast<const void*>("/home/gaius/GM2/graft-combine/gcc-git-devel-m2link/gcc/m2/gm2-libs/RTExceptions.mod")), 696, 9, const_cast<void*> (reinterpret_cast<const void*>("realvalue")), const_cast<void*> (reinterpret_cast<const void*>("illegal real value exception")));
}


/*
   realdiv - raise a division by zero in a real number exception.
*/

static void realdiv (void * a)
{
  RTExceptions_Raise ( ((unsigned int) (M2EXCEPTION_realDivException)), const_cast<void*> (reinterpret_cast<const void*>("/home/gaius/GM2/graft-combine/gcc-git-devel-m2link/gcc/m2/gm2-libs/RTExceptions.mod")), 708, 9, const_cast<void*> (reinterpret_cast<const void*>("realdiv")), const_cast<void*> (reinterpret_cast<const void*>("real number division by zero exception")));
}


/*
   complexvalue - raise an illegal complex value exception.
*/

static void complexvalue (void * a)
{
  RTExceptions_Raise ( ((unsigned int) (M2EXCEPTION_complexValueException)), const_cast<void*> (reinterpret_cast<const void*>("/home/gaius/GM2/graft-combine/gcc-git-devel-m2link/gcc/m2/gm2-libs/RTExceptions.mod")), 720, 9, const_cast<void*> (reinterpret_cast<const void*>("complexvalue")), const_cast<void*> (reinterpret_cast<const void*>("illegal complex value exception")));
}


/*
   complexdiv - raise a division by zero in a complex number exception.
*/

static void complexdiv (void * a)
{
  RTExceptions_Raise ( ((unsigned int) (M2EXCEPTION_complexDivException)), const_cast<void*> (reinterpret_cast<const void*>("/home/gaius/GM2/graft-combine/gcc-git-devel-m2link/gcc/m2/gm2-libs/RTExceptions.mod")), 732, 9, const_cast<void*> (reinterpret_cast<const void*>("complexdiv")), const_cast<void*> (reinterpret_cast<const void*>("complex number division by zero exception")));
}


/*
   protection - raise a protection exception.
*/

static void protection (void * a)
{
  RTExceptions_Raise ( ((unsigned int) (M2EXCEPTION_protException)), const_cast<void*> (reinterpret_cast<const void*>("/home/gaius/GM2/graft-combine/gcc-git-devel-m2link/gcc/m2/gm2-libs/RTExceptions.mod")), 744, 9, const_cast<void*> (reinterpret_cast<const void*>("protection")), const_cast<void*> (reinterpret_cast<const void*>("protection exception")));
}


/*
   systemf - raise a system exception.
*/

static void systemf (void * a)
{
  RTExceptions_Raise ( ((unsigned int) (M2EXCEPTION_sysException)), const_cast<void*> (reinterpret_cast<const void*>("/home/gaius/GM2/graft-combine/gcc-git-devel-m2link/gcc/m2/gm2-libs/RTExceptions.mod")), 756, 9, const_cast<void*> (reinterpret_cast<const void*>("systemf")), const_cast<void*> (reinterpret_cast<const void*>("system exception")));
}


/*
   coroutine - raise a coroutine exception.
*/

static void coroutine (void * a)
{
  RTExceptions_Raise ( ((unsigned int) (M2EXCEPTION_coException)), const_cast<void*> (reinterpret_cast<const void*>("/home/gaius/GM2/graft-combine/gcc-git-devel-m2link/gcc/m2/gm2-libs/RTExceptions.mod")), 768, 9, const_cast<void*> (reinterpret_cast<const void*>("coroutine")), const_cast<void*> (reinterpret_cast<const void*>("coroutine exception")));
}


/*
   exception - raise a exception exception.
*/

static void exception (void * a)
{
  RTExceptions_Raise ( ((unsigned int) (M2EXCEPTION_exException)), const_cast<void*> (reinterpret_cast<const void*>("/home/gaius/GM2/graft-combine/gcc-git-devel-m2link/gcc/m2/gm2-libs/RTExceptions.mod")), 780, 9, const_cast<void*> (reinterpret_cast<const void*>("exception")), const_cast<void*> (reinterpret_cast<const void*>("exception exception")));
}


/*
   Init - initialises this module.
*/

static void Init (void)
{
  inException = FALSE;
  freeHandler = NULL;
  freeEHB = NULL;
  currentEHB = RTExceptions_InitExceptionBlock ();
  currentSource = NULL;
  RTExceptions_BaseExceptionsThrow ();
  SysExceptions_InitExceptionHandlers ((SysExceptions_PROCEXCEPTION) {(SysExceptions_PROCEXCEPTION_t) indexf}, (SysExceptions_PROCEXCEPTION) {(SysExceptions_PROCEXCEPTION_t) range}, (SysExceptions_PROCEXCEPTION) {(SysExceptions_PROCEXCEPTION_t) casef}, (SysExceptions_PROCEXCEPTION) {(SysExceptions_PROCEXCEPTION_t) invalidloc}, (SysExceptions_PROCEXCEPTION) {(SysExceptions_PROCEXCEPTION_t) function}, (SysExceptions_PROCEXCEPTION) {(SysExceptions_PROCEXCEPTION_t) wholevalue}, (SysExceptions_PROCEXCEPTION) {(SysExceptions_PROCEXCEPTION_t) wholediv}, (SysExceptions_PROCEXCEPTION) {(SysExceptions_PROCEXCEPTION_t) realvalue}, (SysExceptions_PROCEXCEPTION) {(SysExceptions_PROCEXCEPTION_t) realdiv}, (SysExceptions_PROCEXCEPTION) {(SysExceptions_PROCEXCEPTION_t) complexvalue}, (SysExceptions_PROCEXCEPTION) {(SysExceptions_PROCEXCEPTION_t) complexdiv}, (SysExceptions_PROCEXCEPTION) {(SysExceptions_PROCEXCEPTION_t) protection}, (SysExceptions_PROCEXCEPTION) {(SysExceptions_PROCEXCEPTION_t) systemf}, (SysExceptions_PROCEXCEPTION) {(SysExceptions_PROCEXCEPTION_t) coroutine}, (SysExceptions_PROCEXCEPTION) {(SysExceptions_PROCEXCEPTION_t) exception});
}


/*
   TidyUp - deallocate memory used by this module.
*/

static void TidyUp (void)
{
  Handler f;
  RTExceptions_EHBlock e;

  if (currentEHB != NULL)
    {
      currentEHB = RTExceptions_KillExceptionBlock (currentEHB);
    }
  while (freeHandler != NULL)
    {
      f = freeHandler;
      freeHandler = freeHandler->right;
      Storage_DEALLOCATE ((void **) &f, sizeof (_T3));
    }
  while (freeEHB != NULL)
    {
      e = freeEHB;
      freeEHB = freeEHB->right;
      Storage_DEALLOCATE ((void **) &e, sizeof (_T1));
    }
}


/*
   Raise - invoke the exception handler associated with, number,
           in the active EHBlock.  It keeps a record of the number
           and message in the EHBlock for later use.
*/

extern "C" void RTExceptions_Raise (unsigned int number, void * file, unsigned int line, unsigned int column, void * function, void * message)
{
  unsigned int i;

  currentEHB->number = number;
  i = 0;
  addFile (file, &i);
  addChar (':', &i);
  addNum (line, &i);
  addChar (':', &i);
  addNum (column, &i);
  addChar (':', &i);
  addChar (' ', &i);
  addChar ('I', &i);
  addChar ('n', &i);
  addChar (' ', &i);
  addStr (function, &i);
  addChar (ASCII_nl, &i);
  addFile (file, &i);
  addChar (':', &i);
  addNum (line, &i);
  addChar (':', &i);
  addNum (column, &i);
  addChar (':', &i);
  addStr (message, &i);
  addChar (ASCII_nl, &i);
  addChar (ASCII_nul, &i);
  InvokeHandler ();
}


/*
   SetExceptionBlock - sets, source, as the active EHB.
*/

extern "C" void RTExceptions_SetExceptionBlock (RTExceptions_EHBlock source)
{
  currentEHB = source;
}


/*
   GetExceptionBlock - returns the active EHB.
*/

extern "C" RTExceptions_EHBlock RTExceptions_GetExceptionBlock (void)
{
  return currentEHB;
  /* static analysis guarentees a RETURN statement will be used before here.  */
  __builtin_unreachable ();
}


/*
   GetTextBuffer - returns the address of the EHB buffer.
*/

extern "C" void * RTExceptions_GetTextBuffer (RTExceptions_EHBlock e)
{
  return &e->buffer;
  /* static analysis guarentees a RETURN statement will be used before here.  */
  __builtin_unreachable ();
}


/*
   GetTextBufferSize - return the size of the EHB text buffer.
*/

extern "C" unsigned int RTExceptions_GetTextBufferSize (RTExceptions_EHBlock e)
{
  return sizeof (e->buffer);
  /* static analysis guarentees a RETURN statement will be used before here.  */
  __builtin_unreachable ();
}


/*
   GetNumber - return the exception number associated with,
               source.
*/

extern "C" unsigned int RTExceptions_GetNumber (RTExceptions_EHBlock source)
{
  return source->number;
  /* static analysis guarentees a RETURN statement will be used before here.  */
  __builtin_unreachable ();
}


/*
   InitExceptionBlock - creates and returns a new exception block.
*/

extern "C" RTExceptions_EHBlock RTExceptions_InitExceptionBlock (void)
{
  RTExceptions_EHBlock e;

  e = New ();
  e->number = UINT_MAX;
  e->handlers = NewHandler ();  /* add the dummy onto the head  */
  e->handlers->right = e->handlers;  /* add the dummy onto the head  */
  e->handlers->left = e->handlers;
  e->right = e;
  return e;
  /* static analysis guarentees a RETURN statement will be used before here.  */
  __builtin_unreachable ();
}


/*
   KillExceptionBlock - destroys the EHB, e, and all its handlers.
*/

extern "C" RTExceptions_EHBlock RTExceptions_KillExceptionBlock (RTExceptions_EHBlock e)
{
  e->handlers = KillHandlers (e->handlers);
  e->right = freeEHB;
  freeEHB = e;
  return NULL;
  /* static analysis guarentees a RETURN statement will be used before here.  */
  __builtin_unreachable ();
}


/*
   PushHandler - install a handler in EHB, e.
*/

extern "C" void RTExceptions_PushHandler (RTExceptions_EHBlock e, unsigned int number, RTExceptions_ProcedureHandler p)
{
  Handler h;
  Handler i;

  h = findHandler (e, number);
  if (h == NULL)
    {
      i = InitHandler (NewHandler (), NULL, NULL, NULL, number, p);
    }
  else
    {
      /* remove, h,  */
      SubHandler (h);
      /* stack it onto a new handler  */
      i = InitHandler (NewHandler (), NULL, NULL, h, number, p);
    }
  /* add new handler  */
  AddHandler (e, i);
}


/*
   PopHandler - removes the handler associated with, number, from
                EHB, e.
*/

extern "C" void RTExceptions_PopHandler (RTExceptions_EHBlock e, unsigned int number)
{
  Handler h;
  Handler i;

  h = findHandler (e, number);
  if (h != NULL)
    {
      /* remove, h,  */
      SubHandler (h);
      if (h->stack != NULL)
        {
          AddHandler (e, h->stack);
        }
      h = KillHandler (h);
    }
}


/*
   DefaultErrorCatch - displays the current error message in
                       the current exception block and then
                       calls HALT.
*/

extern "C" void RTExceptions_DefaultErrorCatch (void)
{
  RTExceptions_EHBlock e;
  int n;

  e = RTExceptions_GetExceptionBlock ();
  n = static_cast<int> (libc_write (2, RTExceptions_GetTextBuffer (e), libc_strlen (RTExceptions_GetTextBuffer (e))));
  M2RTS_HALT (-1);
  __builtin_unreachable ();
}


/*
   BaseExceptionsThrow - configures the Modula-2 exceptions to call
                         THROW which in turn can be caught by an
                         exception block.  If this is not called then
                         a Modula-2 exception will simply call an
                         error message routine and then HALT.
*/

extern "C" void RTExceptions_BaseExceptionsThrow (void)
{
  M2EXCEPTION_M2Exceptions i;

  for (i=M2EXCEPTION_indexException; i<=M2EXCEPTION_exException; i= static_cast<M2EXCEPTION_M2Exceptions>(static_cast<int>(i+1)))
    {
      RTExceptions_PushHandler (RTExceptions_GetExceptionBlock (), (unsigned int ) (i), (RTExceptions_ProcedureHandler) {(RTExceptions_ProcedureHandler_t) DoThrow});
    }
}


/*
   IsInExceptionState - returns TRUE if the program is currently
                        in the exception state.
*/

extern "C" unsigned int RTExceptions_IsInExceptionState (void)
{
  return inException;
  /* static analysis guarentees a RETURN statement will be used before here.  */
  __builtin_unreachable ();
}


/*
   SetExceptionState - returns the current exception state and
                       then sets the current exception state to,
                       to.
*/

extern "C" unsigned int RTExceptions_SetExceptionState (unsigned int to)
{
  unsigned int old;

  old = inException;
  inException = to;
  return old;
  /* static analysis guarentees a RETURN statement will be used before here.  */
  __builtin_unreachable ();
}


/*
   SwitchExceptionState - assigns, from, with the current exception
                          state and then assigns the current exception
                          to, to.
*/

extern "C" void RTExceptions_SwitchExceptionState (unsigned int *from, unsigned int to)
{
  (*from) = inException;
  inException = to;
}


/*
   GetBaseExceptionBlock - returns the initial language exception block
                           created.
*/

extern "C" RTExceptions_EHBlock RTExceptions_GetBaseExceptionBlock (void)
{
  if (currentEHB == NULL)
    {
      M2RTS_Halt ((const char *) "/home/gaius/GM2/graft-combine/gcc-git-devel-m2link/gcc/m2/gm2-libs/RTExceptions.mod", 83, 598, (const char *) "GetBaseExceptionBlock", 21, (const char *) "currentEHB has not been initialized yet", 39);
    }
  else
    {
      return currentEHB;
    }
  ReturnException ("/home/gaius/GM2/graft-combine/gcc-git-devel-m2link/gcc/m2/gm2-libs/RTExceptions.def", 25, 1);
  __builtin_unreachable ();
}


/*
   SetExceptionSource - sets the current exception source to, source.
*/

extern "C" void RTExceptions_SetExceptionSource (void * source)
{
  currentSource = source;
}


/*
   GetExceptionSource - returns the current exception source.
*/

extern "C" void * RTExceptions_GetExceptionSource (void)
{
  return currentSource;
  /* static analysis guarentees a RETURN statement will be used before here.  */
  __builtin_unreachable ();
}

extern "C" void _M2_RTExceptions_init (__attribute__((unused)) int argc, __attribute__((unused)) char *argv[])
{
  Init ();
}

extern "C" void _M2_RTExceptions_finish (__attribute__((unused)) int argc, __attribute__((unused)) char *argv[])
{
  TidyUp ();
}