1------------------------------------------------------------------------------
2--                                                                          --
3--                         GNAT COMPILER COMPONENTS                         --
4--                                                                          --
5--              S Y S T E M . E X C E P T I O N S . M A C H I N E           --
6--                                                                          --
7--                                 S p e c                                  --
8--                                                                          --
9--            Copyright (C) 2013, Free Software Foundation, Inc.            --
10--                                                                          --
11-- GNAT is free software;  you can  redistribute it  and/or modify it under --
12-- terms of the  GNU General Public License as published  by the Free Soft- --
13-- ware  Foundation;  either version 3,  or (at your option) any later ver- --
14-- sion.  GNAT is distributed in the hope that it will be useful, but WITH- --
15-- OUT ANY WARRANTY;  without even the  implied warranty of MERCHANTABILITY --
16-- or FITNESS FOR A PARTICULAR PURPOSE.                                     --
17--                                                                          --
18-- As a special exception under Section 7 of GPL version 3, you are granted --
19-- additional permissions described in the GCC Runtime Library Exception,   --
20-- version 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-- GNAT was originally developed  by the GNAT team at  New York University. --
28-- Extensive contributions were provided by Ada Core Technologies Inc.      --
29--                                                                          --
30------------------------------------------------------------------------------
31
32--  Declaration of the machine exception and some associated facilities. The
33--  machine exception is the object that is propagated by low level routines
34--  and that contains the Ada exception occurrence.
35
36--  This is the version using the ARM EHABI mechanism
37
38with Ada.Unchecked_Conversion;
39with Ada.Exceptions;
40
41package System.Exceptions.Machine is
42   pragma Preelaborate;
43
44   ------------------------------------------------
45   -- Entities to interface with the GCC runtime --
46   ------------------------------------------------
47
48   --  Return codes from GCC runtime functions used to propagate an exception
49
50   type Unwind_Reason_Code is
51     (URC_OK,
52      URC_FOREIGN_EXCEPTION_CAUGHT,
53      URC_Unused2,
54      URC_Unused3,
55      URC_Unused4,
56      URC_Unused5,
57      URC_HANDLER_FOUND,
58      URC_INSTALL_CONTEXT,
59      URC_CONTINUE_UNWIND,
60      URC_FAILURE);
61
62   pragma Unreferenced
63     (URC_OK,
64      URC_FOREIGN_EXCEPTION_CAUGHT,
65      URC_Unused2,
66      URC_Unused3,
67      URC_Unused4,
68      URC_Unused5,
69      URC_HANDLER_FOUND,
70      URC_INSTALL_CONTEXT,
71      URC_CONTINUE_UNWIND,
72      URC_FAILURE);
73
74   pragma Convention (C, Unwind_Reason_Code);
75   subtype Unwind_Action is Unwind_Reason_Code;
76   --  Phase identifiers
77
78   type uint32_t is mod 2**32;
79   pragma Convention (C, uint32_t);
80
81   type uint32_t_array is array (Natural range <>) of uint32_t;
82   pragma Convention (C, uint32_t_array);
83
84   type Unwind_State is new uint32_t;
85   pragma Convention (C, Unwind_State);
86
87   US_VIRTUAL_UNWIND_FRAME  : constant Unwind_State := 0;
88   US_UNWIND_FRAME_STARTING : constant Unwind_State := 1;
89   US_UNWIND_FRAME_RESUME   : constant Unwind_State := 2;
90
91   pragma Unreferenced
92     (US_VIRTUAL_UNWIND_FRAME,
93      US_UNWIND_FRAME_STARTING,
94      US_UNWIND_FRAME_RESUME);
95
96   --  Mandatory common header for any exception object handled by the
97   --  GCC unwinding runtime.
98
99   type Exception_Class is array (0 .. 7) of Character;
100
101   GNAT_Exception_Class : constant Exception_Class := "GNU-Ada" & ASCII.NUL;
102   --  "GNU-Ada\0"
103
104   type Unwinder_Cache_Type is record
105      Reserved1 : uint32_t;
106      Reserved2 : uint32_t;
107      Reserved3 : uint32_t;
108      Reserved4 : uint32_t;
109      Reserved5 : uint32_t;
110   end record;
111
112   type Barrier_Cache_Type is record
113      Sp         : uint32_t;
114      Bitpattern : uint32_t_array (0 .. 4);
115   end record;
116
117   type Cleanup_Cache_Type is record
118     Bitpattern : uint32_t_array (0 .. 3);
119   end record;
120
121   type Pr_Cache_Type is record
122      Fnstart    : uint32_t;
123      Ehtp       : System.Address;
124      Additional : uint32_t;
125      Reserved1  : uint32_t;
126   end record;
127
128   type Unwind_Control_Block is record
129      Class   : Exception_Class;
130      Cleanup : System.Address;
131
132      --  Caches
133      Unwinder_Cache : Unwinder_Cache_Type;
134      Barrier_Cache  : Barrier_Cache_Type;
135      Cleanup_Cache  : Cleanup_Cache_Type;
136      Pr_Cache       : Pr_Cache_Type;
137   end record;
138   pragma Convention (C, Unwind_Control_Block);
139   for Unwind_Control_Block'Alignment use 8;
140   --  Map the GCC struct used for exception handling
141
142   type Unwind_Control_Block_Access is access all Unwind_Control_Block;
143   subtype GCC_Exception_Access is Unwind_Control_Block_Access;
144   --  Pointer to a UCB
145
146   procedure Unwind_DeleteException
147     (Ucbp : not null Unwind_Control_Block_Access);
148   pragma Import (C, Unwind_DeleteException, "_Unwind_DeleteException");
149   --  Procedure to free any GCC exception
150
151   --------------------------------------------------------------
152   -- GNAT Specific Entities To Deal With The GCC EH Circuitry --
153   --------------------------------------------------------------
154
155   --  A GNAT exception object to be dealt with by the personality routine
156   --  called by the GCC unwinding runtime.
157
158   type GNAT_GCC_Exception is record
159      Header : Unwind_Control_Block;
160      --  ABI Exception header first
161
162      Occurrence : aliased Ada.Exceptions.Exception_Occurrence;
163      --  The Ada occurrence
164   end record;
165
166   pragma Convention (C, GNAT_GCC_Exception);
167
168   type GNAT_GCC_Exception_Access is access all GNAT_GCC_Exception;
169
170   function To_GCC_Exception is new
171     Ada.Unchecked_Conversion (System.Address, GCC_Exception_Access);
172
173   function To_GNAT_GCC_Exception is new
174     Ada.Unchecked_Conversion
175     (GCC_Exception_Access, GNAT_GCC_Exception_Access);
176
177   function New_Occurrence return GNAT_GCC_Exception_Access is
178      (new GNAT_GCC_Exception'
179         (Header     => (Class   => GNAT_Exception_Class,
180                         Unwinder_Cache => (Reserved1 => 0,
181                                            others => <>),
182                         others => <>),
183          Occurrence => <>));
184   --  Allocate and initialize a machine occurrence
185
186end System.Exceptions.Machine;
187