1 ------------------------------------------------------------------------------
3 -- GNAT COMPILER COMPONENTS --
5 -- SYSTEM.MACHINE_STATE_OPERATIONS --
8 -- (Version for Alpha/Dec Unix) --
12 -- Copyright (C) 1999-2001 Ada Core Technologies, Inc. --
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. --
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. --
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). --
35 ------------------------------------------------------------------------------
37 -- This version of System.Machine_State_Operations is for use on
38 -- Alpha systems running DEC Unix.
42 package body System
.Machine_State_Operations
is
44 use System
.Exceptions
;
46 pragma Linker_Options
("-lexc");
47 -- Needed for definitions of exc_capture_context and exc_virtual_unwind
49 ----------------------------
50 -- Allocate_Machine_State --
51 ----------------------------
53 function Allocate_Machine_State
return Machine_State
is
54 use System
.Storage_Elements
;
56 function c_machine_state_length
return Storage_Offset
;
57 pragma Import
(C
, c_machine_state_length
, "__gnat_machine_state_length");
61 (Memory
.Alloc
(Memory
.size_t
(c_machine_state_length
)));
62 end Allocate_Machine_State
;
68 procedure Enter_Handler
(M
: Machine_State
; Handler
: Handler_Loc
) is
69 procedure c_enter_handler
(M
: Machine_State
; Handler
: Handler_Loc
);
70 pragma Import
(C
, c_enter_handler
, "__gnat_enter_handler");
73 c_enter_handler
(M
, Handler
);
80 function Fetch_Code
(Loc
: Code_Loc
) return Code_Loc
is
85 ------------------------
86 -- Free_Machine_State --
87 ------------------------
89 procedure Free_Machine_State
(M
: in out Machine_State
) is
90 procedure Gnat_Free
(M
: in Machine_State
);
91 pragma Import
(C
, Gnat_Free
, "__gnat_free");
95 M
:= Machine_State
(Null_Address
);
96 end Free_Machine_State
;
102 function Get_Code_Loc
(M
: Machine_State
) return Code_Loc
is
103 Asm_Call_Size
: constant := 4;
105 function c_get_code_loc
(M
: Machine_State
) return Code_Loc
;
106 pragma Import
(C
, c_get_code_loc
, "__gnat_get_code_loc");
108 -- Code_Loc returned by c_get_code_loc is the return point but here we
109 -- want Get_Code_Loc to return the call point. Under DEC Unix a call
110 -- asm instruction takes 4 bytes. So we must remove this value from
111 -- c_get_code_loc to have the call point.
114 return c_get_code_loc
(M
) - Asm_Call_Size
;
117 --------------------------
118 -- Machine_State_Length --
119 --------------------------
121 function Machine_State_Length
122 return System
.Storage_Elements
.Storage_Offset
124 use System
.Storage_Elements
;
126 function c_machine_state_length
return Storage_Offset
;
127 pragma Import
(C
, c_machine_state_length
, "__gnat_machine_state_length");
130 return c_machine_state_length
;
131 end Machine_State_Length
;
139 Info
: Subprogram_Info_Type
)
141 procedure exc_virtual_unwind
142 (Fcn
: System
.Address
;
144 pragma Import
(C
, exc_virtual_unwind
, "exc_virtual_unwind");
147 exc_virtual_unwind
(System
.Null_Address
, M
);
150 -----------------------
151 -- Set_Machine_State --
152 -----------------------
154 procedure Set_Machine_State
(M
: Machine_State
) is
155 procedure c_capture_context
(M
: Machine_State
);
156 pragma Import
(C
, c_capture_context
, "exc_capture_context");
159 c_capture_context
(M
);
160 Pop_Frame
(M
, System
.Null_Address
);
161 end Set_Machine_State
;
163 ------------------------------
164 -- Set_Signal_Machine_State --
165 ------------------------------
167 procedure Set_Signal_Machine_State
169 Context
: System
.Address
) is
172 end Set_Signal_Machine_State
;
174 end System
.Machine_State_Operations
;