gcc/ada/5smastop.adb

   1 ------------------------------------------------------------------------------
   2 --                                                                          --
   3 --                         GNAT COMPILER COMPONENTS                         --
   4 --                                                                          --
   5 --                     SYSTEM.MACHINE_STATE_OPERATIONS                      --
   6 --                                                                          --
   7 --                                 B o d y                                  --
   8 --            (Version using the GCC stack unwinding mechanism)             --
   9 --                                                                          --
  10 --                            $Revision: 1.3 $
  11 --                                                                          --
  12 --           Copyright (C) 1999-2001 Ada Core Technologies, Inc.            --
  13 --                                                                          --
  14 -- GNAT is free software;  you can  redistribute it  and/or modify it under --
  15 -- terms of the  GNU General Public License as published  by the Free Soft- --
  16 -- ware  Foundation;  either version 2,  or (at your option) any later ver- --
  17 -- sion.  GNAT is distributed in the hope that it will be useful, but WITH- --
  18 -- OUT ANY WARRANTY;  without even the  implied warranty of MERCHANTABILITY --
  19 -- or FITNESS FOR A PARTICULAR PURPOSE.  See the GNU General Public License --
  20 -- for  more details.  You should have  received  a copy of the GNU General --
  21 -- Public License  distributed with GNAT;  see file COPYING.  If not, write --
  22 -- to  the Free Software Foundation,  59 Temple Place - Suite 330,  Boston, --
  23 -- MA 02111-1307, USA.                                                      --
  24 --                                                                          --
  25 -- As a special exception,  if other files  instantiate  generics from this --
  26 -- unit, or you link  this unit with other files  to produce an executable, --
  27 -- this  unit  does not  by itself cause  the resulting  executable  to  be --
  28 -- covered  by the  GNU  General  Public  License.  This exception does not --
  29 -- however invalidate  any other reasons why  the executable file  might be --
  30 -- covered by the  GNU Public License.                                      --
  31 --                                                                          --
  32 -- GNAT was originally developed  by the GNAT team at  New York University. --
  33 -- It is now maintained by Ada Core Technologies Inc (http://www.gnat.com). --
  34 --                                                                          --
  35 ------------------------------------------------------------------------------
  36
  37 --  This version of System.Machine_State_Operations is for use on
  38 --  systems where the GCC stack unwinding mechanism is supported.
  39 --  It is currently only used on Solaris
  40
  41 package body System.Machine_State_Operations is
  42
  43    use System.Storage_Elements;
  44    use System.Exceptions;
  45
  46    ----------------------------
  47    -- Allocate_Machine_State --
  48    ----------------------------
  49
  50    function Allocate_Machine_State return Machine_State is
  51       function Machine_State_Length return Storage_Offset;
  52       pragma Import (C, Machine_State_Length, "__gnat_machine_state_length");
  53
  54       function Gnat_Malloc (Size : Storage_Offset) return Machine_State;
  55       pragma Import (C, Gnat_Malloc, "__gnat_malloc");
  56
  57    begin
  58       return Gnat_Malloc (Machine_State_Length);
  59    end Allocate_Machine_State;
  60
  61    -------------------
  62    -- Enter_Handler --
  63    -------------------
  64
  65    procedure Enter_Handler (M : Machine_State; Handler : Handler_Loc) is
  66       procedure c_enter_handler (m : Machine_State; handler : Handler_Loc);
  67       pragma Import (C, c_enter_handler, "__gnat_enter_handler");
  68
  69    begin
  70       c_enter_handler (M, Handler);
  71    end Enter_Handler;
  72
  73    ----------------
  74    -- Fetch_Code --
  75    ----------------
  76
  77    function Fetch_Code (Loc : Code_Loc) return Code_Loc is
  78    begin
  79       return Loc;
  80    end Fetch_Code;
  81
  82    ------------------------
  83    -- Free_Machine_State --
  84    ------------------------
  85
  86    procedure Free_Machine_State (M : in out Machine_State) is
  87       procedure Gnat_Free (M : in Machine_State);
  88       pragma Import (C, Gnat_Free, "__gnat_free");
  89
  90    begin
  91       Gnat_Free (M);
  92       M := Machine_State (Null_Address);
  93    end Free_Machine_State;
  94
  95    ------------------
  96    -- Get_Code_Loc --
  97    ------------------
  98
  99    function Get_Code_Loc (M : Machine_State) return Code_Loc is
 100       function c_get_code_loc (m : Machine_State) return Code_Loc;
 101       pragma Import (C, c_get_code_loc, "__gnat_get_code_loc");
 102
 103    begin
 104       return c_get_code_loc (M);
 105    end Get_Code_Loc;
 106
 107    --------------------------
 108    -- Machine_State_Length --
 109    --------------------------
 110
 111    function Machine_State_Length return Storage_Offset is
 112
 113       function c_machine_state_length return Storage_Offset;
 114       pragma Import (C, c_machine_state_length, "__gnat_machine_state_length");
 115
 116    begin
 117       return c_machine_state_length;
 118    end Machine_State_Length;
 119
 120    ---------------
 121    -- Pop_Frame --
 122    ---------------
 123
 124    procedure Pop_Frame
 125      (M    : Machine_State;
 126       Info : Subprogram_Info_Type)
 127    is
 128       procedure c_pop_frame (m : Machine_State);
 129       pragma Import (C, c_pop_frame, "__gnat_pop_frame");
 130
 131    begin
 132       c_pop_frame (M);
 133    end Pop_Frame;
 134
 135    -----------------------
 136    -- Set_Machine_State --
 137    -----------------------
 138
 139    procedure Set_Machine_State (M : Machine_State) is
 140       procedure c_set_machine_state (m : Machine_State);
 141       pragma Import (C, c_set_machine_state, "__gnat_set_machine_state");
 142
 143    begin
 144       c_set_machine_state (M);
 145       Pop_Frame (M, System.Null_Address);
 146    end Set_Machine_State;
 147
 148    ------------------------------
 149    -- Set_Signal_Machine_State --
 150    ------------------------------
 151
 152    procedure Set_Signal_Machine_State
 153      (M       : Machine_State;
 154       Context : System.Address) is
 155    begin
 156       null;
 157    end Set_Signal_Machine_State;
 158
 159 end System.Machine_State_Operations;