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

   1 (* EXCEPTIONS.mod implement the ISO EXCEPTIONS specification.
   2
   3 Copyright (C) 2003-2021 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(__FILE__, __LINE__, __FUNCTION__, 'should never return from RTException.Raise')
  68 END RAISE ;
  69
  70
  71 PROCEDURE CurrentNumber (source: ExceptionSource) : ExceptionNumber ;
  72   (* If the current coroutine is in the exceptional execution state
  73      because of the raising of an exception from source, returns the
  74      corresponding number, and otherwise raises an exception.
  75   *)
  76 BEGIN
  77    IF RTExceptions.IsInExceptionState()
  78    THEN
  79       RETURN( RTExceptions.GetNumber(source^.eh) )
  80    ELSE
  81       RTExceptions.Raise(ORD(M2EXCEPTION.coException),
  82                          ADR(__FILE__), __LINE__, __COLUMN__, ADR(__FUNCTION__),
  83                          ADR('current coroutine is not in the exceptional execution state'))
  84    END
  85 END CurrentNumber ;
  86
  87
  88 PROCEDURE GetMessage (VAR text: ARRAY OF CHAR) ;
  89   (* If the current coroutine is in the exceptional execution state,
  90      returns the possibly truncated string associated with the
  91      current context.  Otherwise, in normal execution state,
  92      returns the empty string.
  93   *)
  94 VAR
  95    p   : POINTER TO CHAR ;
  96    i, h: CARDINAL ;
  97 BEGIN
  98    IF RTExceptions.IsInExceptionState()
  99    THEN
 100       h := HIGH(text) ;
 101       i := 0 ;
 102       p := RTExceptions.GetTextBuffer(RTExceptions.GetExceptionBlock()) ;
 103       WHILE (p#NIL) AND (p^#ASCII.nul) DO
 104          text[i] := p^ ;
 105          INC(i) ;
 106          INC(p)
 107       END ;
 108       IF i<=h
 109       THEN
 110          text[i] := ASCII.nul
 111       END
 112    ELSE
 113       text[0] := ASCII.nul
 114    END
 115 END GetMessage ;
 116
 117
 118 PROCEDURE IsCurrentSource (source: ExceptionSource) : BOOLEAN ;
 119   (* If the current coroutine is in the exceptional execution state
 120      because of the raising of an exception from source, returns TRUE,
 121      and otherwise returns FALSE.
 122   *)
 123 BEGIN
 124    RETURN( RTExceptions.IsInExceptionState() AND (source=RTExceptions.GetExceptionSource()) )
 125 END IsCurrentSource ;
 126
 127
 128 PROCEDURE IsExceptionalExecution () : BOOLEAN ;
 129   (* If the current coroutine is in the exceptional execution state
 130      because of the raising of an exception, returns TRUE,
 131      and otherwise returns FALSE.
 132   *)
 133 BEGIN
 134    RETURN( RTExceptions.IsInExceptionState() )
 135 END IsExceptionalExecution ;
 136
 137
 138 END EXCEPTIONS.