File : s-soflin-cert.ads


   1 ------------------------------------------------------------------------------
   2 --                                                                          --
   3 --                         GNAT COMPILER COMPONENTS                         --
   4 --                                                                          --
   5 --                    S Y S T E M . S O F T _ L I N K S                     --
   6 --                                                                          --
   7 --                                 S p e c                                  --
   8 --                                                                          --
   9 --          Copyright (C) 1992-2010, 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 --                                                                          --
  19 --                                                                          --
  20 --                                                                          --
  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 --  Ravenscar / CERT
  33 
  34 --  This package contains a set of subprogram access variables that access some
  35 --  low-level primitives that are called different depending wether tasking is
  36 --  involved or not (e.g. the Get/Set_Jmpbuf_Address that needs to provide a
  37 --  different value for each task). To avoid dragging in the tasking all the
  38 --  time, we use a system of soft links where the links are initialized to
  39 --  non-tasking versions, and then if the tasking is initialized, they are
  40 --  reset to the real tasking versions.
  41 
  42 with Ada.Exceptions;
  43 
  44 with System.Storage_Elements;
  45 
  46 package System.Soft_Links is
  47    pragma Preelaborate;
  48 
  49    subtype EOA is Ada.Exceptions.Exception_Occurrence_Access;
  50    subtype EO is Ada.Exceptions.Exception_Occurrence;
  51 
  52    --  First we have the access subprogram types used to establish the links.
  53    --  The approach is to establish variables containing access subprogram
  54    --  values which by default point to dummy no tasking versions of routines.
  55 
  56    type No_Param_Proc     is access procedure;
  57    type EO_Param_Proc     is access procedure (Excep : EO);
  58 
  59    type Get_Address_Call  is access function return Address;
  60    type Set_Address_Call  is access procedure (Addr : Address);
  61 
  62    type Get_Integer_Call  is access function return Integer;
  63    type Set_Integer_Call  is access procedure (Len : Integer);
  64 
  65    type Get_EOA_Call      is access function return EOA;
  66 
  67    --  Suppress checks on all these types, since we know corrresponding values
  68    --  can never be null (the soft links are always initialized).
  69 
  70    pragma Suppress (Access_Check, No_Param_Proc);
  71    pragma Suppress (Access_Check, Get_Address_Call);
  72    pragma Suppress (Access_Check, Set_Address_Call);
  73    pragma Suppress (Access_Check, Get_Integer_Call);
  74    pragma Suppress (Access_Check, Set_Integer_Call);
  75    pragma Suppress (Access_Check, Get_EOA_Call);
  76 
  77    procedure Null_Adafinal;
  78    --  Shuts down the runtime system (non-tasking no-finalization case,
  79    --  does nothing)
  80 
  81    Adafinal : No_Param_Proc := Null_Adafinal'Access;
  82    --  Performs the finalization of the Ada Runtime
  83 
  84    function  Get_Jmpbuf_Address_NT return  Address;
  85    procedure Set_Jmpbuf_Address_NT (Addr : Address);
  86 
  87    Get_Jmpbuf_Address : Get_Address_Call := Get_Jmpbuf_Address_NT'Access;
  88    Set_Jmpbuf_Address : Set_Address_Call := Set_Jmpbuf_Address_NT'Access;
  89 
  90    function  Get_Sec_Stack_Addr_NT return  Address;
  91    procedure Set_Sec_Stack_Addr_NT (Addr : Address);
  92 
  93    Get_Sec_Stack_Addr : Get_Address_Call := Get_Sec_Stack_Addr_NT'Access;
  94    Set_Sec_Stack_Addr : Set_Address_Call := Set_Sec_Stack_Addr_NT'Access;
  95 
  96    function  Get_Current_Excep_NT return EOA;
  97 
  98    Get_Current_Excep : Get_EOA_Call := Get_Current_Excep_NT'Access;
  99 
 100    function Get_GNAT_Exception return Ada.Exceptions.Exception_Id;
 101    pragma Inline (Get_GNAT_Exception);
 102    --  This function obtains the Exception_Id from the Exception_Occurrence
 103    --  referenced by the Current_Excep field of the task specific data.
 104 
 105    --  Export the Get/Set routines for the various Task Specific Data (TSD)
 106    --  elements as callable subprograms instead of objects of access to
 107    --  subprogram types.
 108 
 109    function  Get_Jmpbuf_Address_Soft return  Address;
 110    procedure Set_Jmpbuf_Address_Soft (Addr : Address);
 111    pragma Inline (Get_Jmpbuf_Address_Soft);
 112    pragma Inline (Set_Jmpbuf_Address_Soft);
 113 
 114    function  Get_Sec_Stack_Addr_Soft return  Address;
 115    procedure Set_Sec_Stack_Addr_Soft (Addr : Address);
 116    pragma Inline (Get_Sec_Stack_Addr_Soft);
 117    pragma Inline (Set_Sec_Stack_Addr_Soft);
 118 
 119    type Stack_Info is record
 120       Start_Address : System.Address := System.Null_Address;
 121       Size          : System.Storage_Elements.Storage_Offset;
 122    end record;
 123    pragma Suppress_Initialization (Stack_Info);
 124 
 125    type TSD is record
 126       Pri_Stack_Info : aliased Stack_Info;
 127       --  Information on stack (Base/Limit/Size) that is used
 128       --  by System.Stack_Checking. If this TSD does not belong to
 129       --  the environment task, the Size field must be initialized
 130       --  to the tasks requested stack size before the task can do
 131       --  its first stack check.
 132 
 133       pragma Warnings (Off);
 134 
 135       Jmpbuf_Address : Address := Null_Address;
 136       --  Address of jump buffer used to store the address of the current
 137       --  longjmp/setjmp buffer for exception management. These buffers are
 138       --  threaded into a stack, and the address here is the top of the stack.
 139       --  A null address means that no exception handler is currently active.
 140 
 141       Sec_Stack_Addr : Address := Null_Address;
 142       --  Address of currently allocated secondary stack
 143 
 144       pragma Warnings (On);
 145 
 146       Current_Excep : aliased EO;
 147       --  Exception occurrence that contains the information for the current
 148       --  exception. Note that any exception in the same task destroys this
 149       --  information, so the data in this variable must be copied out before
 150       --  another exception can occur.
 151       --
 152       --  Also act as a list of the active exceptions in the case of the GCC
 153       --  exception mechanism, organized as a stack with the most recent first.
 154 
 155    end record;
 156 
 157 end System.Soft_Links;