gcc/m2/gm2-libs-iso/EXCEPTIONS.mod

   1 (* EXCEPTIONS.mod implement the ISO EXCEPTIONS specification.
   2
   3 Copyright (C) 2003-2024 Free Software Foundation, Inc.
   4 Contributed by Gaius Mulley <gaius.mulley@southwales.ac.uk>.
   5
   6 This file is part of GNU Modula-2.
   7
   8 GNU Modula-2 is free software; you can redistribute it and/or modify
   9 it under the terms of the GNU General Public License as published by
  10 the Free Software Foundation; either version 3, or (at your option)
  11 any later version.
  12
  13 GNU Modula-2 is distributed in the hope that it will be useful, but
  14 WITHOUT ANY WARRANTY; without even the implied warranty of
  15 MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE.  See the GNU
  16 General Public License for more details.
  17
  18 Under Section 7 of GPL version 3, you are granted additional
  19 permissions described in the GCC Runtime Library Exception, version
  20 3.1, as published by the Free Software Foundation.
  21
  22 You should have received a copy of the GNU General Public License and
  23 a copy of the GCC Runtime Library Exception along with this program;
  24 see the files COPYING3 and COPYING.RUNTIME respectively.  If not, see
  25 <http://www.gnu.org/licenses/>.  *)
  26
  27 IMPLEMENTATION MODULE EXCEPTIONS ;
  28
  29 IMPORT RTExceptions ;
  30 IMPORT M2EXCEPTION ;
  31 IMPORT M2RTS ;
  32 IMPORT ASCII ;
  33
  34 FROM SYSTEM IMPORT ADR ;
  35 FROM Storage IMPORT ALLOCATE ;
  36
  37
  38 TYPE
  39    ExceptionSource = POINTER TO RECORD
  40                                    eh: RTExceptions.EHBlock ;
  41                                 END ;
  42    (* values of this type are used within library modules to
  43       identify the source of raised exceptions *)
  44
  45
  46 PROCEDURE AllocateSource (VAR newSource: ExceptionSource) ;
  47   (* Allocates a unique value of type ExceptionSource *)
  48 BEGIN
  49    NEW(newSource) ;
  50    WITH newSource^ DO
  51       eh := RTExceptions.InitExceptionBlock()
  52    END
  53 END AllocateSource ;
  54
  55
  56 PROCEDURE RAISE (source: ExceptionSource;
  57                  number: ExceptionNumber;
  58                  message: ARRAY OF CHAR) ;
  59   (* Associates the given values of source, number and message with
  60      the current context and raises an exception.
  61   *)
  62 BEGIN
  63    RTExceptions.SetExceptionSource(source) ;
  64    RTExceptions.SetExceptionBlock(source^.eh) ;
  65    RTExceptions.Raise(number, ADR(__FILE__), __LINE__, __COLUMN__, ADR(__FUNCTION__), ADR(message)) ;
  66    (* we should never reach here as Raise should jump to the exception handler *)
  67    M2RTS.Halt('should never return from RTException.Raise',
  68               __FILE__, __FUNCTION__, __LINE__)
  69 END RAISE ;
  70
  71
  72 PROCEDURE CurrentNumber (source: ExceptionSource) : ExceptionNumber ;
  73   (* If the current coroutine is in the exceptional execution state
  74      because of the raising of an exception from source, returns the
  75      corresponding number, and otherwise raises an exception.
  76   *)
  77 BEGIN
  78    IF RTExceptions.IsInExceptionState()
  79    THEN
  80       RETURN( RTExceptions.GetNumber(source^.eh) )
  81    ELSE
  82       RTExceptions.Raise(ORD(M2EXCEPTION.coException),
  83                          ADR(__FILE__), __LINE__, __COLUMN__, ADR(__FUNCTION__),
  84                          ADR('current coroutine is not in the exceptional execution state'))
  85    END
  86 END CurrentNumber ;
  87
  88
  89 PROCEDURE GetMessage (VAR text: ARRAY OF CHAR) ;
  90   (* If the current coroutine is in the exceptional execution state,
  91      returns the possibly truncated string associated with the
  92      current context.  Otherwise, in normal execution state,
  93      returns the empty string.
  94   *)
  95 VAR
  96    p   : POINTER TO CHAR ;
  97    i, h: CARDINAL ;
  98 BEGIN
  99    IF RTExceptions.IsInExceptionState()
 100    THEN
 101       h := HIGH(text) ;
 102       i := 0 ;
 103       p := RTExceptions.GetTextBuffer(RTExceptions.GetExceptionBlock()) ;
 104       WHILE (p#NIL) AND (p^#ASCII.nul) DO
 105          text[i] := p^ ;
 106          INC(i) ;
 107          INC(p)
 108       END ;
 109       IF i<=h
 110       THEN
 111          text[i] := ASCII.nul
 112       END
 113    ELSE
 114       text[0] := ASCII.nul
 115    END
 116 END GetMessage ;
 117
 118
 119 PROCEDURE IsCurrentSource (source: ExceptionSource) : BOOLEAN ;
 120   (* If the current coroutine is in the exceptional execution state
 121      because of the raising of an exception from source, returns TRUE,
 122      and otherwise returns FALSE.
 123   *)
 124 BEGIN
 125    RETURN( RTExceptions.IsInExceptionState() AND (source=RTExceptions.GetExceptionSource()) )
 126 END IsCurrentSource ;
 127
 128
 129 PROCEDURE IsExceptionalExecution () : BOOLEAN ;
 130   (* If the current coroutine is in the exceptional execution state
 131      because of the raising of an exception, returns TRUE,
 132      and otherwise returns FALSE.
 133   *)
 134 BEGIN
 135    RETURN( RTExceptions.IsInExceptionState() )
 136 END IsExceptionalExecution ;
 137
 138
 139 END EXCEPTIONS.