File : a-except-cert.ads


   1 ------------------------------------------------------------------------------
   2 --                                                                          --
   3 --                         GNAT RUN-TIME COMPONENTS                         --
   4 --                                                                          --
   5 --                       A D A . E X C E P T I O N S                        --
   6 --                                                                          --
   7 --                                 S p e c                                  --
   8 --                                                                          --
   9 --          Copyright (C) 1992-2014, Free Software Foundation, Inc.         --
  10 --                                                                          --
  11 -- This specification is derived from the Ada Reference Manual for use with --
  12 -- GNAT. The copyright notice above, and the license provisions that follow --
  13 -- apply solely to the  contents of the part following the private keyword. --
  14 --                                                                          --
  15 -- GNAT is free software;  you can  redistribute it  and/or modify it under --
  16 -- terms of the  GNU General Public License as published  by the Free Soft- --
  17 -- ware  Foundation;  either version 3,  or (at your option) any later ver- --
  18 -- sion.  GNAT is distributed in the hope that it will be useful, but WITH- --
  19 -- OUT ANY WARRANTY;  without even the  implied warranty of MERCHANTABILITY --
  20 -- or FITNESS FOR A PARTICULAR PURPOSE.                                     --
  21 --                                                                          --
  22 --                                                                          --
  23 --                                                                          --
  24 --                                                                          --
  25 --                                                                          --
  26 -- You should have received a copy of the GNU General Public License and    --
  27 -- a copy of the GCC Runtime Library Exception along with this program;     --
  28 -- see the files COPYING3 and COPYING.RUNTIME respectively.  If not, see    --
  29 -- <http://www.gnu.org/licenses/>.                                          --
  30 --                                                                          --
  31 -- GNAT was originally developed  by the GNAT team at  New York University. --
  32 -- Extensive contributions were provided by Ada Core Technologies Inc.      --
  33 --                                                                          --
  34 ------------------------------------------------------------------------------
  35 
  36 --  This version is part of rts-cert, rts-ravenscar-cert and
  37 --  rts-ravenscar-cert-rtp. It implements Ada 83 exception handling, plus a
  38 --  subset of the operations available in Ada 95 for Exception_Occurrences
  39 --  and Exception_Ids (Exception_Name, Exception_Identity ...).
  40 
  41 with System;
  42 with System.Standard_Library;
  43 with System.Traceback_Entries;
  44 
  45 with Ada.Unchecked_Conversion;
  46 
  47 package Ada.Exceptions is
  48    pragma Preelaborate;
  49    --  In accordance with Ada 2005 AI-362
  50 
  51    type Exception_Id is private;
  52    pragma Preelaborable_Initialization (Exception_Id);
  53 
  54    Null_Id : constant Exception_Id;
  55 
  56    type Exception_Occurrence is limited private;
  57    pragma Preelaborable_Initialization (Exception_Occurrence);
  58 
  59    type Exception_Occurrence_Access is access all Exception_Occurrence;
  60 
  61    Null_Occurrence : constant Exception_Occurrence;
  62 
  63    function Exception_Name (X : Exception_Occurrence) return String;
  64    --  Same as Exception_Name (Exception_Identity (X))
  65 
  66    function Exception_Name (Id : Exception_Id) return String;
  67 
  68    procedure Raise_Exception (E : Exception_Id; Message : String := "");
  69    pragma No_Return (Raise_Exception);
  70 
  71    procedure Reraise_Occurrence (X : Exception_Occurrence);
  72    pragma No_Return (Reraise_Occurrence);
  73 
  74    function Exception_Identity (X : Exception_Occurrence) return Exception_Id;
  75 
  76    procedure Save_Occurrence
  77      (Target : out Exception_Occurrence;
  78       Source : Exception_Occurrence);
  79 
  80 private
  81    package SSL renames System.Standard_Library;
  82 
  83    subtype EOA is Exception_Occurrence_Access;
  84 
  85    ------------------
  86    -- Exception_Id --
  87    ------------------
  88 
  89    type Exception_Id is new SSL.Exception_Data_Ptr;
  90 
  91    Null_Id : constant Exception_Id := null;
  92 
  93    -------------------------
  94    -- Private Subprograms --
  95    -------------------------
  96 
  97    procedure Raise_Exception_Always (E : Exception_Id; Message : String := "");
  98    pragma No_Return (Raise_Exception_Always);
  99    pragma Export (Ada, Raise_Exception_Always, "__gnat_raise_exception");
 100 
 101    procedure Reraise_Occurrence_Always (X : Exception_Occurrence);
 102    pragma No_Return (Reraise_Occurrence_Always);
 103 
 104    procedure Reraise_Occurrence_No_Defer (X : Exception_Occurrence);
 105    pragma No_Return (Reraise_Occurrence_No_Defer);
 106 
 107    --------------------------
 108    -- Exception_Occurrence --
 109    --------------------------
 110 
 111    subtype Code_Loc is System.Address;
 112    --  Code location used for the traceback table
 113 
 114    Null_Loc : constant System.Address := System.Null_Address;
 115 
 116    package TBE renames System.Traceback_Entries;
 117 
 118    Max_Tracebacks : constant := 50;
 119    --  Maximum number of trace backs stored in exception occurrence
 120 
 121    subtype Tracebacks_Array is TBE.Tracebacks_Array (1 .. Max_Tracebacks);
 122    --  Traceback array stored in exception occurrence
 123 
 124    type Exception_Occurrence is record
 125       Id : Exception_Id;
 126       --  Exception_Identity for this exception occurrence
 127 
 128       Num_Tracebacks : Natural range 0 .. Max_Tracebacks := 0;
 129       --  Number of traceback entries stored
 130 
 131       Tracebacks : Tracebacks_Array;
 132       --  Stored tracebacks (in Tracebacks (1 .. Num_Tracebacks))
 133 
 134    end record;
 135 
 136    pragma Warnings (Off);
 137    --  Allow non-static constants in Ada 2005 mode where this package will be
 138    --  implicitly categorized as Preelaborate. See AI-362 for details. It is
 139    --  safe in the context of the run-time to violate the rules.
 140 
 141    Null_Occurrence : constant Exception_Occurrence := (
 142      Id               => Null_Id,
 143      Num_Tracebacks   => 0,
 144      Tracebacks       => (others => Null_Loc));
 145 
 146    pragma Warnings (On);
 147 
 148    --  Local binding to __builtin_longjmp.  The builtin expects a pointer
 149    --  type for the jmpbuf address argument, and System.Address doesn't work
 150    --  because this is really an integer type.
 151 
 152    type Jmpbuf_Address is access Character;
 153    function To_Jmpbuf_Address is new
 154      Ada.Unchecked_Conversion (System.Address, Jmpbuf_Address);
 155 
 156    procedure builtin_longjmp (buffer : Jmpbuf_Address; Flag : Integer);
 157    pragma No_Return (builtin_longjmp);
 158    pragma Import (Intrinsic, builtin_longjmp, "__builtin_longjmp");
 159 
 160 end Ada.Exceptions;