+++ /dev/null
-------------------------------------------------------------------------------
--- --
--- 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;
+++ /dev/null
-------------------------------------------------------------------------------
--- --
--- 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;
+++ /dev/null
-------------------------------------------------------------------------------
--- --
--- 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;
+++ /dev/null
-------------------------------------------------------------------------------
--- --
--- 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;
+++ /dev/null
-------------------------------------------------------------------------------
--- --
--- 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;
* 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>
projects / gcc.git / commitdiff