home *** CD-ROM | disk | FTP | other *** search
/ OS/2 Shareware BBS: 10 Tools / 10-Tools.zip / adav313.zip / gnat-3_13p-os2-bin-20010916.zip / emx / gnatlib / a-except.ads < prev    next >
Text File  |  2001-07-08  |  15KB  |  314 lines
  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. --                            $Revision: 1.40 $
  10. --                                                                          --
  11. --          Copyright (C) 1992-2000 Free Software Foundation, Inc.          --
  12. --                                                                          --
  13. -- This specification is derived from the Ada Reference Manual for use with --
  14. -- GNAT. The copyright notice above, and the license provisions that follow --
  15. -- apply solely to the  contents of the part following the private keyword. --
  16. --                                                                          --
  17. -- GNAT is free software;  you can  redistribute it  and/or modify it under --
  18. -- terms of the  GNU General Public License as published  by the Free Soft- --
  19. -- ware  Foundation;  either version 2,  or (at your option) any later ver- --
  20. -- sion.  GNAT is distributed in the hope that it will be useful, but WITH- --
  21. -- OUT ANY WARRANTY;  without even the  implied warranty of MERCHANTABILITY --
  22. -- or FITNESS FOR A PARTICULAR PURPOSE.  See the GNU General Public License --
  23. -- for  more details.  You should have  received  a copy of the GNU General --
  24. -- Public License  distributed with GNAT;  see file COPYING.  If not, write --
  25. -- to  the Free Software Foundation,  59 Temple Place - Suite 330,  Boston, --
  26. -- MA 02111-1307, USA.                                                      --
  27. --                                                                          --
  28. -- As a special exception,  if other files  instantiate  generics from this --
  29. -- unit, or you link  this unit with other files  to produce an executable, --
  30. -- this  unit  does not  by itself cause  the resulting  executable  to  be --
  31. -- covered  by the  GNU  General  Public  License.  This exception does not --
  32. -- however invalidate  any other reasons why  the executable file  might be --
  33. -- covered by the  GNU Public License.                                      --
  34. --                                                                          --
  35. -- GNAT was originally developed  by the GNAT team at  New York University. --
  36. -- It is now maintained by Ada Core Technologies Inc (http://www.gnat.com). --
  37. --                                                                          --
  38. ------------------------------------------------------------------------------
  39.  
  40. pragma Polling (Off);
  41. --  We must turn polling off for this unit, because otherwise we get
  42. --  elaboration circularities with ourself.
  43.  
  44. with System;
  45. with System.Standard_Library;
  46.  
  47. package Ada.Exceptions is
  48.  
  49.    type Exception_Id is private;
  50.    Null_Id : constant Exception_Id;
  51.  
  52.    type Exception_Occurrence is limited private;
  53.    type Exception_Occurrence_Access is access all Exception_Occurrence;
  54.  
  55.    Null_Occurrence : constant Exception_Occurrence;
  56.  
  57.    function Exception_Name (X : Exception_Occurrence) return String;
  58.    --  Same as Exception_Name (Exception_Identity (X))
  59.  
  60.    function Exception_Name (X : Exception_Id) return String;
  61.  
  62.    procedure Raise_Exception (E : in Exception_Id; Message : in String := "");
  63.    pragma Export (Ada, Raise_Exception, "__gnat_raise_exception");
  64.    --  The Export allows this routine to be accessed from Pure units.
  65.    --  Note: it would be really nice to give a pragma No_Return for this
  66.    --  procedure, but it would be wrong, since Raise_Exception does return
  67.    --  if given the null exception. However we do special case the name in
  68.    --  the test in the compiler for issuing a warning for a missing return
  69.    --  after this call. Program_Error seems reasonable enough in such a case.
  70.  
  71.    function Exception_Message (X : Exception_Occurrence) return String;
  72.  
  73.    procedure Reraise_Occurrence (X : Exception_Occurrence);
  74.  
  75.    function Exception_Identity (X : Exception_Occurrence) return Exception_Id;
  76.  
  77.    function Exception_Information (X : Exception_Occurrence) return String;
  78.    --  The format of the exception information is as follows:
  79.    --
  80.    --    exception name (as in Exception_Name)
  81.    --    message (or a null line if no message)
  82.    --    PID=nnnn
  83.    --    16#xxxx_xxxx# or 16#xxxx_xxxx_xxxx_xxxx#
  84.    --    16#xxxx_xxxx# or 16#xxxx_xxxx_xxxx_xxxx#
  85.    --    ...
  86.    --
  87.    --  The lines are separated by an ASCII.CR/ASCII.LF sequence.
  88.    --  The nnnn is the partition Id given as decimal digits.
  89.    --  One 16#...# lines represent traceback program counter locations,
  90.    --  in order with the first one being the exception location. All hex
  91.    --  characters are upper case letters.
  92.  
  93.    --  Note on ordering: the compiler uses the Save_Occurrence procedure, but
  94.    --  not the function from Rtsfind, so it is important that the procedure
  95.    --  come first, since Rtsfind finds the first matching entity.
  96.  
  97.    procedure Save_Occurrence
  98.      (Target :    out Exception_Occurrence;
  99.       Source : in     Exception_Occurrence);
  100.  
  101.    function Save_Occurrence
  102.      (Source : in Exception_Occurrence)
  103.       return Exception_Occurrence_Access;
  104.  
  105.    function Allocate_Machine_State return System.Address;
  106.    --  Calls target-dependent routine to allocate a Machine_State.
  107.    --  A separate Machine_State is allocated for each task and
  108.    --  stored in the TSD. The Machine_State is used to restore
  109.    --  registers while propagating exceptions using the Zero Cost
  110.    --  exception model. The returned value is the address of the
  111.    --  allocated machine state.
  112.  
  113.    procedure Deallocate_Machine_State (M : in out System.Address);
  114.    --  Deallocates a Machine_State allocated created by
  115.    --  Allocate_Machine_State. The parameter M is the address of
  116.    --  the machine state to be deallocated.
  117.  
  118.    function Current_Target_Exception return Exception_Occurrence;
  119.    --  This routine should return the current raised exception on targets
  120.    --  which have built-in exception handling such as the Java Virtual
  121.    --  Machine. For other targets this routine is simply ignored. Currently,
  122.    --  only JGNAT uses this. See 4jexcept.ads for details.
  123.  
  124. private
  125.    package SSL renames System.Standard_Library;
  126.  
  127.    subtype EOA is Exception_Occurrence_Access;
  128.  
  129.    Exception_Msg_Max_Length : constant := 200;
  130.  
  131.    ------------------
  132.    -- Exception_Id --
  133.    ------------------
  134.  
  135.    subtype Code_Loc is System.Address;
  136.    --  Code location used in building exception tables and for call
  137.    --  addresses when propagating an exception (also traceback table)
  138.    --  Values of this type are created by using Label'Address or
  139.    --  extracted from machine states using Get_Code_Loc.
  140.  
  141.    Null_Loc : constant Code_Loc := System.Null_Address;
  142.    --  Null code location, used to flag outer level frame
  143.  
  144.    type Exception_Id is new SSL.Exception_Data_Ptr;
  145.  
  146.    function EId_To_String (X : Exception_Id) return String;
  147.    function String_To_EId (S : String) return Exception_Id;
  148.    pragma Stream_Convert (Exception_Id, String_To_EId, EId_To_String);
  149.    --  Functions for implementing Exception_Id stream attributes
  150.  
  151.    Null_Id : constant Exception_Id := null;
  152.  
  153.    -------------------------
  154.    -- Private Subprograms --
  155.    -------------------------
  156.  
  157.    function Exception_Name_Simple (X : Exception_Occurrence) return String;
  158.    --  Like Exception_Name, but returns the simple non-qualified name of
  159.    --  the exception. This is used to implement the Exception_Name function
  160.    --  in Current_Exceptions (the DEC compatible unit). It is called from
  161.    --  the compiler generated code (using Rtsfind, which does not respect
  162.    --  the private barrier, so we can place this function in the private
  163.    --  part where the compiler can find it, but the spec is unchanged.)
  164.  
  165.    procedure Raise_No_Msg (E : Exception_Id);
  166.    pragma No_Return (Raise_No_Msg);
  167.    --  Raises an exception with no message with given exception id value.
  168.    --  Abort is deferred before the raise call.
  169.  
  170.    procedure Raise_From_Signal_Handler
  171.      (E : Exception_Id;
  172.       M : SSL.Big_String_Ptr);
  173.    pragma Export
  174.      (Ada, Raise_From_Signal_Handler,
  175.            "ada__exceptions__raise_from_signal_handler");
  176.    pragma No_Return (Raise_From_Signal_Handler);
  177.    --  This routine is used to raise an exception from a signal handler.
  178.    --  The signal handler has already stored the machine state (i.e. the
  179.    --  state that corresponds to the location at which the signal was
  180.    --  raised). E is the Exception_Id specifying what exception is being
  181.    --  raised, and M is a pointer to a null-terminated string which is the
  182.    --  message to be raised. Note that this routine never returns, so it is
  183.    --  permissible to simply jump to this routine, rather than call it. This
  184.    --  may be appropriate for systems where the right way to get out of a
  185.    --  signal handler is to alter the PC value in the machine state or in
  186.    --  some other way ask the operating system to return here rather than
  187.    --  to the original location.
  188.  
  189.    procedure Raise_With_C_Msg
  190.      (E : Exception_Id;
  191.       M : SSL.Big_String_Ptr);
  192.    pragma Export (Ada, Raise_With_C_Msg, "ada__exceptions__raise_with_c_msg");
  193.    pragma No_Return (Raise_With_C_Msg);
  194.    --  Raises an exception with with given exception id value and message.
  195.    --  M is a null terminated string with the message to be raised. Abort
  196.    --  is deferred before the raise call.
  197.  
  198.    procedure Reraise_Occurrence_No_Defer (X : Exception_Occurrence);
  199.    --  Exactly like Reraise_Occurrence, except that abort is not deferred
  200.    --  before the call. This is used in generated code when it is known
  201.    --  that abort is already deferred.
  202.  
  203.    procedure SDP_Table_Build
  204.      (SDP_Addresses   : System.Address;
  205.       SDP_Count       : Natural;
  206.       Elab_Addresses  : System.Address;
  207.       Elab_Addr_Count : Natural);
  208.    pragma Export (C, SDP_Table_Build, "__gnat_SDP_Table_Build");
  209.    --  This is the routine that is called at the start of execution to build
  210.    --  and sort the list of subprogram descriptor pointers:
  211.    --
  212.    --    SDP_Addresses    Address of the start of the list of addresses of
  213.    --                     __gnat_unit_name__SDP values constructed for each
  214.    --                     unit, (see System.Exceptions).
  215.    --
  216.    --    SDP_Count        Number of entries in SDP_Addresses
  217.    --
  218.    --    Elab_Addresses   Address of the start of a list of addresses of
  219.    --                     generated Ada elaboration routines, as well as
  220.    --                     one extra entry for the generated main program.
  221.    --                     These are used to generate the dummy SDP's that
  222.    --                     mark the outer scope.
  223.    --
  224.    --    Elab_Addr_Count  Number of entries in Elab_Addresses
  225.  
  226.    procedure Break_Start;
  227.    pragma Export (C, Break_Start, "__gnat_break_start");
  228.    --  This is a dummy procedure that is called at the start of execution.
  229.    --  Its sole purpose is to provide a well defined point for the placement
  230.    --  of a main program breakpoint. We put the routine in Ada.Exceptions so
  231.    --  that the standard mechanism of always stepping up from breakpoints
  232.    --  within Ada.Exceptions leaves us sitting in the main program.
  233.  
  234.    -----------------------
  235.    -- Polling Interface --
  236.    -----------------------
  237.  
  238.    --  The GNAT compiler has an option to generate polling calls to the Poll
  239.    --  routine in this package. Specifying the -gnatP option for a compilation
  240.    --  causes a call to Ada.Exceptions.Poll to be generated on every subprogram
  241.    --  entry and on every iteration of a loop, thus avoiding the possibility of
  242.    --  a case of unbounded time between calls.
  243.  
  244.    --  This polling interface may be used for instrumentation or debugging
  245.    --  purposes (e.g. implementing watchpoints in software or in the debugger).
  246.  
  247.    --  In the GNAT technology itself, this interface is used to implement
  248.    --  immediate aynschronous transfer of control and immediate abort on
  249.    --  targets which do not provide for one thread interrupting another.
  250.  
  251.    --  Note: this used to be in a separate unit called System.Poll, but that
  252.    --  caused horrible circular elaboration problems between System.Poll and
  253.    --  Ada.Exceptions. One way of solving such circularities is unification!
  254.  
  255.    procedure Poll;
  256.    --  Check for asynchronous abort. Note that we do not inline the body.
  257.    --  This makes the interface more useful for debugging purposes.
  258.  
  259.    --------------------------
  260.    -- Exception_Occurrence --
  261.    --------------------------
  262.  
  263.    Max_Tracebacks : constant := 50;
  264.    --  Maximum number of trace backs stored in exception occurrence
  265.  
  266.    type Tracebacks_Array is array (1 .. Max_Tracebacks) of Code_Loc;
  267.    --  Traceback array stored in exception occurrence
  268.  
  269.    type Exception_Occurrence is record
  270.       Id : Exception_Id;
  271.       --  Exception_Identity for this exception occurrence
  272.       --  WARNING System.System.Finalization_Implementation.Finalize_List
  273.       --  relies on the fact that this field is always first in the exception
  274.       --  occurrence
  275.  
  276.       Msg_Length : Natural := 0;
  277.       --  Length of message (zero = no message)
  278.  
  279.       Msg : String (1 .. Exception_Msg_Max_Length);
  280.       --  Characters of message
  281.  
  282.       Cleanup_Flag : Boolean;
  283.       --  The cleanup flag is normally False, it is set True for an exception
  284.       --  occurrence passed to a cleanup routine, and will still be set True
  285.       --  when the cleanup routine does a Reraise_Occurrence call using this
  286.       --  exception occurrence. This is used to avoid recording a bogus trace
  287.       --  back entry from this reraise call.
  288.  
  289.       Pid : Natural;
  290.       --  Partition_Id for partition raising exception
  291.  
  292.       Num_Tracebacks : Natural range 0 .. Max_Tracebacks := 0;
  293.       --  Number of traceback entries stored
  294.  
  295.       Tracebacks : Tracebacks_Array;
  296.       --  Stored tracebacks (in Tracebacks (1 .. Num_Tracebacks)
  297.    end record;
  298.  
  299.    function EO_To_String (X : Exception_Occurrence) return String;
  300.    function String_To_EO (S : String) return Exception_Occurrence;
  301.    pragma Stream_Convert (Exception_Occurrence, String_To_EO, EO_To_String);
  302.    --  Functions for implementing Exception_Occurrence stream attributes
  303.  
  304.    Null_Occurrence : constant Exception_Occurrence := (
  305.      Id             => Null_Id,
  306.      Msg_Length     => 0,
  307.      Msg            => (others => ' '),
  308.      Cleanup_Flag   => False,
  309.      Pid            => 0,
  310.      Num_Tracebacks => 0,
  311.      Tracebacks     => (others => Null_Loc));
  312.  
  313. end Ada.Exceptions;
  314.