1------------------------------------------------------------------------------ 2-- -- 3-- GNAT COMPILER COMPONENTS -- 4-- -- 5-- SYSTEM.MACHINE_STATE_OPERATIONS -- 6-- -- 7-- B o d y -- 8-- (Version for Alpha/Dec Unix) -- 9-- -- 10-- Copyright (C) 1999-2003 Ada Core Technologies, Inc. -- 11-- -- 12-- GNAT is free software; you can redistribute it and/or modify it under -- 13-- terms of the GNU General Public License as published by the Free Soft- -- 14-- ware Foundation; either version 2, or (at your option) any later ver- -- 15-- sion. GNAT is distributed in the hope that it will be useful, but WITH- -- 16-- OUT ANY WARRANTY; without even the implied warranty of MERCHANTABILITY -- 17-- or FITNESS FOR A PARTICULAR PURPOSE. See the GNU General Public License -- 18-- for more details. You should have received a copy of the GNU General -- 19-- Public License distributed with GNAT; see file COPYING. If not, write -- 20-- to the Free Software Foundation, 59 Temple Place - Suite 330, Boston, -- 21-- MA 02111-1307, USA. -- 22-- -- 23-- As a special exception, if other files instantiate generics from this -- 24-- unit, or you link this unit with other files to produce an executable, -- 25-- this unit does not by itself cause the resulting executable to be -- 26-- covered by the GNU General Public License. This exception does not -- 27-- however invalidate any other reasons why the executable file might be -- 28-- covered by the GNU Public License. -- 29-- -- 30-- GNAT was originally developed by the GNAT team at New York University. -- 31-- Extensive contributions were provided by Ada Core Technologies Inc. -- 32-- -- 33------------------------------------------------------------------------------ 34 35-- This version of System.Machine_State_Operations is for use on 36-- Alpha systems running DEC Unix. 37 38with System.Memory; 39 40package body System.Machine_State_Operations is 41 42 use System.Exceptions; 43 44 pragma Linker_Options ("-lexc"); 45 -- Needed for definitions of exc_capture_context and exc_virtual_unwind 46 47 ---------------------------- 48 -- Allocate_Machine_State -- 49 ---------------------------- 50 51 function Allocate_Machine_State return Machine_State is 52 use System.Storage_Elements; 53 54 function c_machine_state_length return Storage_Offset; 55 pragma Import (C, c_machine_state_length, "__gnat_machine_state_length"); 56 57 begin 58 return Machine_State 59 (Memory.Alloc (Memory.size_t (c_machine_state_length))); 60 end Allocate_Machine_State; 61 62 ------------------- 63 -- Enter_Handler -- 64 ------------------- 65 66 procedure Enter_Handler (M : Machine_State; Handler : Handler_Loc) is 67 procedure c_enter_handler (M : Machine_State; Handler : Handler_Loc); 68 pragma Import (C, c_enter_handler, "__gnat_enter_handler"); 69 70 begin 71 c_enter_handler (M, Handler); 72 end Enter_Handler; 73 74 ---------------- 75 -- Fetch_Code -- 76 ---------------- 77 78 function Fetch_Code (Loc : Code_Loc) return Code_Loc is 79 begin 80 return Loc; 81 end Fetch_Code; 82 83 ------------------------ 84 -- Free_Machine_State -- 85 ------------------------ 86 87 procedure Free_Machine_State (M : in out Machine_State) is 88 begin 89 Memory.Free (Address (M)); 90 M := Machine_State (Null_Address); 91 end Free_Machine_State; 92 93 ------------------ 94 -- Get_Code_Loc -- 95 ------------------ 96 97 function Get_Code_Loc (M : Machine_State) return Code_Loc is 98 Asm_Call_Size : constant := 4; 99 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 -- Code_Loc returned by c_get_code_loc is the return point but here we 104 -- want Get_Code_Loc to return the call point. Under DEC Unix a call 105 -- asm instruction takes 4 bytes. So we must remove this value from 106 -- c_get_code_loc to have the call point. 107 108 Loc : constant Code_Loc := c_get_code_loc (M); 109 110 begin 111 if Loc = 0 then 112 return 0; 113 else 114 return Loc - Asm_Call_Size; 115 end if; 116 end Get_Code_Loc; 117 118 -------------------------- 119 -- Machine_State_Length -- 120 -------------------------- 121 122 function Machine_State_Length 123 return System.Storage_Elements.Storage_Offset 124 is 125 use System.Storage_Elements; 126 127 function c_machine_state_length return Storage_Offset; 128 pragma Import (C, c_machine_state_length, "__gnat_machine_state_length"); 129 130 begin 131 return c_machine_state_length; 132 end Machine_State_Length; 133 134 --------------- 135 -- Pop_Frame -- 136 --------------- 137 138 procedure Pop_Frame 139 (M : Machine_State; 140 Info : Subprogram_Info_Type) 141 is 142 pragma Warnings (Off, Info); 143 144 procedure exc_virtual_unwind 145 (Fcn : System.Address; 146 M : Machine_State); 147 pragma Import (C, exc_virtual_unwind, "exc_virtual_unwind"); 148 149 begin 150 exc_virtual_unwind (System.Null_Address, M); 151 end Pop_Frame; 152 153 ----------------------- 154 -- Set_Machine_State -- 155 ----------------------- 156 157 procedure Set_Machine_State (M : Machine_State) is 158 procedure c_capture_context (M : Machine_State); 159 pragma Import (C, c_capture_context, "exc_capture_context"); 160 161 begin 162 c_capture_context (M); 163 Pop_Frame (M, System.Null_Address); 164 end Set_Machine_State; 165 166 ------------------------------ 167 -- Set_Signal_Machine_State -- 168 ------------------------------ 169 170 procedure Set_Signal_Machine_State 171 (M : Machine_State; 172 Context : System.Address) 173 is 174 pragma Warnings (Off, M); 175 pragma Warnings (Off, Context); 176 177 begin 178 null; 179 end Set_Signal_Machine_State; 180 181end System.Machine_State_Operations; 182