Commit b291953f by Arnaud Charlet Committed by Arnaud Charlet

1aexcept.adb, [...]: Removed, unused.

	* 1aexcept.adb, 1aexcept.ads, 1ic.ads, 1ssecsta.adb,
	1ssecsta.ads: Removed, unused.

From-SVN: r76404
parent b7e429ab
------------------------------------------------------------------------------
-- --
-- GNAT COMPILER COMPONENTS --
-- --
-- A D A . E X C E P T I O N S --
-- --
-- B o d y --
-- --
-- Copyright (C) 1992-2001 Free Software Foundation, Inc. --
-- --
-- GNAT is free software; you can redistribute it and/or modify it under --
-- terms of the GNU General Public License as published by the Free Soft- --
-- ware Foundation; either version 2, or (at your option) any later ver- --
-- sion. GNAT is distributed in the hope that it will be useful, but WITH- --
-- OUT ANY WARRANTY; without even the implied warranty of MERCHANTABILITY --
-- or FITNESS FOR A PARTICULAR PURPOSE. See the GNU General Public License --
-- for more details. You should have received a copy of the GNU General --
-- Public License distributed with GNAT; see file COPYING. If not, write --
-- to the Free Software Foundation, 59 Temple Place - Suite 330, Boston, --
-- MA 02111-1307, USA. --
-- --
-- As a special exception, if other files instantiate generics from this --
-- unit, or you link this unit with other files to produce an executable, --
-- this unit does not by itself cause the resulting executable to be --
-- covered by the GNU General Public License. This exception does not --
-- however invalidate any other reasons why the executable file might be --
-- covered by the GNU Public License. --
-- --
-- GNAT was originally developed by the GNAT team at New York University. --
-- Extensive contributions were provided by Ada Core Technologies Inc. --
-- --
------------------------------------------------------------------------------
package body Ada.Exceptions is
procedure Last_Chance_Handler (Msg : System.Address; Line : Integer);
pragma Import (C, Last_Chance_Handler, "__gnat_last_chance_handler");
pragma No_Return (Last_Chance_Handler);
---------------------
-- Raise_Exception --
---------------------
procedure Raise_Exception (E : Exception_Id; Message : String := "") is
begin
Last_Chance_Handler (Message'Address, 0);
end Raise_Exception;
end Ada.Exceptions;
------------------------------------------------------------------------------
-- --
-- GNAT RUN-TIME COMPONENTS --
-- --
-- A D A . E X C E P T I O N S --
-- (Version for No Exception Handlers) --
-- --
-- S p e c --
-- --
-- Copyright (C) 1992-2003 Free Software Foundation, Inc. --
-- --
-- This specification is derived from the Ada Reference Manual for use with --
-- GNAT. The copyright notice above, and the license provisions that follow --
-- apply solely to the contents of the part following the private keyword. --
-- --
-- GNAT is free software; you can redistribute it and/or modify it under --
-- terms of the GNU General Public License as published by the Free Soft- --
-- ware Foundation; either version 2, or (at your option) any later ver- --
-- sion. GNAT is distributed in the hope that it will be useful, but WITH- --
-- OUT ANY WARRANTY; without even the implied warranty of MERCHANTABILITY --
-- or FITNESS FOR A PARTICULAR PURPOSE. See the GNU General Public License --
-- for more details. You should have received a copy of the GNU General --
-- Public License distributed with GNAT; see file COPYING. If not, write --
-- to the Free Software Foundation, 59 Temple Place - Suite 330, Boston, --
-- MA 02111-1307, USA. --
-- --
-- As a special exception, if other files instantiate generics from this --
-- unit, or you link this unit with other files to produce an executable, --
-- this unit does not by itself cause the resulting executable to be --
-- covered by the GNU General Public License. This exception does not --
-- however invalidate any other reasons why the executable file might be --
-- covered by the GNU Public License. --
-- --
-- GNAT was originally developed by the GNAT team at New York University. --
-- Extensive contributions were provided by Ada Core Technologies Inc. --
-- --
------------------------------------------------------------------------------
-- This version is for use when the restriction No_Exception_Handlers
-- is enabled.
with System;
package Ada.Exceptions is
type Exception_Id is private;
Null_Id : constant Exception_Id;
procedure Raise_Exception (E : Exception_Id; Message : String := "");
-- Unconditionally call __gnat_last_chance_handler.
-- Message should be a null terminated string.
pragma No_Return (Raise_Exception);
private
------------------
-- Exception_Id --
------------------
type Exception_Id is new System.Address;
Null_Id : constant Exception_Id := Exception_Id (System.Null_Address);
pragma Inline_Always (Raise_Exception);
end Ada.Exceptions;
------------------------------------------------------------------------------
-- --
-- GNAT COMPILER COMPONENTS --
-- --
-- I N T E R F A C E S . C --
-- --
-- S p e c --
-- --
-- This specification is adapted from the Ada Reference Manual for use with --
-- GNAT Hi Integrity Edition. In accordance with the copyright of that --
-- document, you can freely copy and modify this specification, provided --
-- that if you redistribute a modified version, any changes that you have --
-- made are clearly indicated. --
-- --
------------------------------------------------------------------------------
-- This version contains only the type definitions for standard interfacing
-- with C. All functions have been removed from the original spec.
package Interfaces.C is
pragma Pure (C);
-- Declaration's based on C's <limits.h>
CHAR_BIT : constant := 8;
SCHAR_MIN : constant := -128;
SCHAR_MAX : constant := 127;
UCHAR_MAX : constant := 255;
-- Signed and Unsigned Integers. Note that in GNAT, we have ensured that
-- the standard predefined Ada types correspond to the standard C types
type int is new Integer;
type short is new Short_Integer;
type long is new Long_Integer;
type signed_char is range SCHAR_MIN .. SCHAR_MAX;
for signed_char'Size use CHAR_BIT;
type unsigned is mod 2 ** int'Size;
type unsigned_short is mod 2 ** short'Size;
type unsigned_long is mod 2 ** long'Size;
type unsigned_char is mod (UCHAR_MAX + 1);
for unsigned_char'Size use CHAR_BIT;
subtype plain_char is unsigned_char;
type ptrdiff_t is
range -(2 ** (Standard'Address_Size - 1)) ..
+(2 ** (Standard'Address_Size - 1) - 1);
type size_t is mod 2 ** Standard'Address_Size;
-- Floating-Point
type C_float is new Float;
type double is new Standard.Long_Float;
type long_double is new Standard.Long_Long_Float;
----------------------------
-- Characters and Strings --
----------------------------
type char is new Character;
nul : constant char := char'First;
type char_array is array (size_t range <>) of aliased char;
for char_array'Component_Size use CHAR_BIT;
------------------------------------
-- Wide Character and Wide String --
------------------------------------
type wchar_t is new Wide_Character;
for wchar_t'Size use Standard'Wchar_T_Size;
wide_nul : constant wchar_t := wchar_t'First;
type wchar_array is array (size_t range <>) of aliased wchar_t;
end Interfaces.C;
------------------------------------------------------------------------------
-- --
-- GNAT COMPILER COMPONENTS --
-- --
-- S Y S T E M . S E C O N D A R Y _ S T A C K --
-- --
-- B o d y --
-- --
-- Copyright (C) 1992-2004 Free Software Foundation, Inc. --
-- --
-- GNAT is free software; you can redistribute it and/or modify it under --
-- terms of the GNU General Public License as published by the Free Soft- --
-- ware Foundation; either version 2, or (at your option) any later ver- --
-- sion. GNAT is distributed in the hope that it will be useful, but WITH- --
-- OUT ANY WARRANTY; without even the implied warranty of MERCHANTABILITY --
-- or FITNESS FOR A PARTICULAR PURPOSE. See the GNU General Public License --
-- for more details. You should have received a copy of the GNU General --
-- Public License distributed with GNAT; see file COPYING. If not, write --
-- to the Free Software Foundation, 59 Temple Place - Suite 330, Boston, --
-- MA 02111-1307, USA. --
-- --
-- As a special exception, if other files instantiate generics from this --
-- unit, or you link this unit with other files to produce an executable, --
-- this unit does not by itself cause the resulting executable to be --
-- covered by the GNU General Public License. This exception does not --
-- however invalidate any other reasons why the executable file might be --
-- covered by the GNU Public License. --
-- --
-- GNAT was originally developed by the GNAT team at New York University. --
-- Extensive contributions were provided by Ada Core Technologies Inc. --
-- --
------------------------------------------------------------------------------
-- This is the HI-E version of this package.
with Unchecked_Conversion;
package body System.Secondary_Stack is
use type SSE.Storage_Offset;
type Memory is array (Mark_Id range <>) of SSE.Storage_Element;
type Stack_Id is record
Top : Mark_Id;
Last : Mark_Id;
Mem : Memory (1 .. Mark_Id'Last);
end record;
pragma Suppress_Initialization (Stack_Id);
type Stack_Ptr is access Stack_Id;
function From_Addr is new Unchecked_Conversion (Address, Stack_Ptr);
function Get_Sec_Stack return Stack_Ptr;
pragma Import (C, Get_Sec_Stack, "__gnat_get_secondary_stack");
-- Return the address of the secondary stack.
-- In a multi-threaded environment, Sec_Stack should be a thread-local
-- variable.
-- Possible implementation of Get_Sec_Stack in a single-threaded
-- environment:
--
-- Chunk : aliased Memory (1 .. Default_Secondary_Stack_Size);
-- for Chunk'Alignment use Standard'Maximum_Alignment;
-- -- The secondary stack.
--
-- function Get_Sec_Stack return Stack_Ptr is
-- begin
-- return From_Addr (Chunk'Address);
-- end Get_Sec_Stack;
--
-- begin
-- SS_Init (Chunk'Address, Default_Secondary_Stack_Size);
-- end System.Secondary_Stack;
-----------------
-- SS_Allocate --
-----------------
procedure SS_Allocate
(Address : out System.Address;
Storage_Size : SSE.Storage_Count)
is
Max_Align : constant Mark_Id := Mark_Id (Standard'Maximum_Alignment);
Max_Size : constant Mark_Id :=
((Mark_Id (Storage_Size) + Max_Align - 1) / Max_Align)
* Max_Align;
Sec_Stack : constant Stack_Ptr := Get_Sec_Stack;
begin
if Sec_Stack.Top + Max_Size > Sec_Stack.Last then
raise Storage_Error;
end if;
Address := Sec_Stack.Mem (Sec_Stack.Top)'Address;
Sec_Stack.Top := Sec_Stack.Top + Max_Size;
end SS_Allocate;
-------------
-- SS_Free --
-------------
procedure SS_Free (Stk : in out System.Address) is
begin
Stk := Null_Address;
end SS_Free;
-------------
-- SS_Init --
-------------
procedure SS_Init
(Stk : System.Address;
Size : Natural := Default_Secondary_Stack_Size)
is
Stack : Stack_Ptr := From_Addr (Stk);
begin
pragma Assert (Size >= 2 * Mark_Id'Max_Size_In_Storage_Elements);
Stack.Top := Stack.Mem'First;
Stack.Last := Mark_Id (Size) - 2 * Mark_Id'Max_Size_In_Storage_Elements;
end SS_Init;
-------------
-- SS_Mark --
-------------
function SS_Mark return Mark_Id is
begin
return Get_Sec_Stack.Top;
end SS_Mark;
----------------
-- SS_Release --
----------------
procedure SS_Release (M : Mark_Id) is
begin
Get_Sec_Stack.Top := M;
end SS_Release;
end System.Secondary_Stack;
------------------------------------------------------------------------------
-- --
-- GNAT COMPILER COMPONENTS --
-- --
-- S Y S T E M . S E C O N D A R Y _ S T A C K --
-- --
-- S p e c --
-- --
-- Copyright (C) 1992-2003 Free Software Foundation, Inc. --
-- --
-- GNAT is free software; you can redistribute it and/or modify it under --
-- terms of the GNU General Public License as published by the Free Soft- --
-- ware Foundation; either version 2, or (at your option) any later ver- --
-- sion. GNAT is distributed in the hope that it will be useful, but WITH- --
-- OUT ANY WARRANTY; without even the implied warranty of MERCHANTABILITY --
-- or FITNESS FOR A PARTICULAR PURPOSE. See the GNU General Public License --
-- for more details. You should have received a copy of the GNU General --
-- Public License distributed with GNAT; see file COPYING. If not, write --
-- to the Free Software Foundation, 59 Temple Place - Suite 330, Boston, --
-- MA 02111-1307, USA. --
-- --
-- As a special exception, if other files instantiate generics from this --
-- unit, or you link this unit with other files to produce an executable, --
-- this unit does not by itself cause the resulting executable to be --
-- covered by the GNU General Public License. This exception does not --
-- however invalidate any other reasons why the executable file might be --
-- covered by the GNU Public License. --
-- --
-- GNAT was originally developed by the GNAT team at New York University. --
-- Extensive contributions were provided by Ada Core Technologies Inc. --
-- --
------------------------------------------------------------------------------
-- Version for use in HI-E mode
with System.Storage_Elements;
package System.Secondary_Stack is
package SSE renames System.Storage_Elements;
Default_Secondary_Stack_Size : Natural := 10 * 1024;
-- Default size of a secondary stack. May be modified by binder -D switch
procedure SS_Init
(Stk : System.Address;
Size : Natural := Default_Secondary_Stack_Size);
-- Initialize the secondary stack with a main stack of the given Size.
--
-- Stk is an "in" parameter that is already pointing to a memory area of
-- size Size.
--
-- The secondary stack is fixed, and any attempt to allocate more than the
-- initial size will result in a Storage_Error being raised.
procedure SS_Allocate
(Address : out System.Address;
Storage_Size : SSE.Storage_Count);
-- Allocate enough space for a 'Storage_Size' bytes object with Maximum
-- alignment. The address of the allocated space is returned in 'Address'
procedure SS_Free (Stk : in out System.Address);
-- Release the memory allocated for the Secondary Stack. That is to say,
-- all the allocated chuncks.
-- Upon return, Stk will be set to System.Null_Address
type Mark_Id is private;
-- Type used to mark the stack.
function SS_Mark return Mark_Id;
-- Return the Mark corresponding to the current state of the stack
procedure SS_Release (M : Mark_Id);
-- Restore the state of the stack corresponding to the mark M. If an
-- additional chunk have been allocated, it will never be freed during a
private
SS_Pool : Integer;
-- Unused entity that is just present to ease the sharing of the pool
-- mechanism for specific allocation/deallocation in the compiler
type Mark_Id is new SSE.Integer_Address;
end System.Secondary_Stack;
...@@ -65,7 +65,8 @@ ...@@ -65,7 +65,8 @@
* Makefile.in: Remove mention of Makefile.adalib, unused. * Makefile.in: Remove mention of Makefile.adalib, unused.
* Makefile.adalib: Removed, unused. * Makefile.adalib, 1aexcept.adb, 1aexcept.ads, 1ic.ads, 1ssecsta.adb,
1ssecsta.ads: Removed, unused.
2004-01-21 Javier Miranda <miranda@gnat.com> 2004-01-21 Javier Miranda <miranda@gnat.com>
......
Markdown is supported
0% or
You are about to add 0 people to the discussion. Proceed with caution.
Finish editing this message first!
Please register or to comment