+2012-07-09 Tristan Gingold <gingold@adacore.com>
+
+ * a-exexpr-gcc.adb (CleanupUnwind_Handler): Now imported from
+ raise-gcc.c
+ * raise-gcc.c (__gnat_cleanupunwind_handler): Defined.
+ Strictly follow the ABI convention on ia64.
+
+2012-07-09 Gary Dismukes <dismukes@adacore.com>
+
+ * a-ststio.ads: Add pragma Preelaborate, per AI05-0283.
+ * i-cstrea.ads (max_path_len): Change from variable to deferred
+ constant to allow it to be used as a bound in string component
+ in type System.File_IO.Temp_File_Record.
+ * s-os_lib.ads, s-commun.ads, s-ficobl.ads, s-fileio.ads: Add pragma
+ Preelaborate.
+ * s-fileio.adb (Get_Case_Sensitive): Move function inside
+ procedure Open.
+ (File_Names_Case_Sensitive): Move variable inside
+ procedure Open, to avoid violation of Preelaborate restriction
+ (due to call to Get_Case_Sensitive).
+
+2012-07-09 Ed Schonberg <schonberg@adacore.com>
+
+ * layout.adb (Set_Elem_Alignment): Protect against meaningless
+ size clause, to prevent overflow in internal computation of
+ alignment.
+
2012-07-09 Robert Dewar <dewar@adacore.com>
* freeze.adb, prj-util.adb, prj-util.ads, sem_ch13.adb: Minor
------------------------------------------------
-- These come from "C++ ABI for Itanium: Exception handling", which is
- -- the reference for GCC. They are used only when we are relying on
- -- back-end tables for exception propagation, which in turn is currently
- -- only the case for Zero_Cost_Exceptions in GNAT5.
+ -- the reference for GCC.
-- Return codes from the GCC runtime functions used to propagate
-- an exception.
URC_CONTINUE_UNWIND);
pragma Unreferenced
- (URC_FOREIGN_EXCEPTION_CAUGHT,
+ (URC_NO_REASON,
+ URC_FOREIGN_EXCEPTION_CAUGHT,
URC_PHASE2_ERROR,
URC_PHASE1_ERROR,
URC_NORMAL_STOP,
UA_CLEANUP_PHASE : constant Unwind_Action := 2;
UA_HANDLER_FRAME : constant Unwind_Action := 4;
UA_FORCE_UNWIND : constant Unwind_Action := 8;
- UA_END_OF_STACK : constant Unwind_Action := 16; -- GCC extension ?
+ UA_END_OF_STACK : constant Unwind_Action := 16; -- GCC extension
pragma Unreferenced
(UA_SEARCH_PHASE,
UA_CLEANUP_PHASE,
UA_HANDLER_FRAME,
- UA_FORCE_UNWIND);
+ UA_FORCE_UNWIND,
+ UA_END_OF_STACK);
-- Mandatory common header for any exception object handled by the
-- GCC unwinding runtime.
UW_Exception : not null GCC_Exception_Access;
UW_Context : System.Address;
UW_Argument : System.Address) return Unwind_Reason_Code;
+ pragma Import (C, CleanupUnwind_Handler,
+ "__gnat_cleanupunwind_handler");
-- Hook called at each step of the forced unwinding we perform to
-- trigger cleanups found during the propagation of an unhandled
-- exception.
Free (Copy);
end GNAT_GCC_Exception_Cleanup;
- ---------------------------
- -- CleanupUnwind_Handler --
- ---------------------------
-
- function CleanupUnwind_Handler
- (UW_Version : Integer;
- UW_Phases : Unwind_Action;
- UW_Eclass : Exception_Class;
- UW_Exception : not null GCC_Exception_Access;
- UW_Context : System.Address;
- UW_Argument : System.Address) return Unwind_Reason_Code
- is
- pragma Unreferenced (UW_Version, UW_Eclass, UW_Context, UW_Argument);
-
- begin
- -- Terminate when the end of the stack is reached
-
- if UW_Phases >= UA_END_OF_STACK then
- Unhandled_Except_Handler (UW_Exception);
- end if;
-
- -- We know there is at least one cleanup further up. Return so that it
- -- is searched and entered, after which Unwind_Resume will be called
- -- and this hook will gain control again.
-
- return URC_NO_REASON;
- end CleanupUnwind_Handler;
-
-------------------------
-- Setup_Current_Excep --
-------------------------
-- --
-- S p e c --
-- --
--- Copyright (C) 1992-2011, Free Software Foundation, Inc. --
+-- Copyright (C) 1992-2012, 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 --
package Ada.Streams.Stream_IO is
+ pragma Preelaborate;
+
type Stream_Access is access all Root_Stream_Type'Class;
type File_Type is limited private;
-- --
-- S p e c --
-- --
--- Copyright (C) 1995-2010, Free Software Foundation, Inc. --
+-- Copyright (C) 1995-2012, 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- --
-- pass an actual parameter for buffer that is big enough for any full
-- path name. Use max_path_len given below as the size of buffer.
- max_path_len : Integer;
- -- Maximum length of an allowable full path name on the system,
- -- including a terminating NUL character.
+ max_path_len : constant Integer;
+ -- max_path_len : Integer;
+ -- Maximum length of an allowable full path name on the system,including a
+ -- terminating NUL character. Declared as a constant to allow references
+ -- from other preelaborated GNAT library packages.
private
-- The following functions are specialized in the body depending on the
-- the type, or the maximum allowed alignment.
declare
- S : constant Int := UI_To_Int (Esize (E)) / SSU;
+ S : Int;
+
A : Nat;
Max_Alignment : Nat;
begin
+ -- The given esize may be larger that int'last because of a previous
+ -- error, and the call to UI_To_Int will fail, so use default.
+
+ if Esize (E) / SSU > Ttypes.Maximum_Alignment then
+ S := Ttypes.Maximum_Alignment;
+
+ else
+ S := UI_To_Int (Esize (E)) / SSU;
+ end if;
+
-- If the default alignment of "double" floating-point types is
-- specifically capped, enforce the cap.
#if defined (__hpux__) && defined (USE_LIBUNWIND_EXCEPTIONS)
/* HP-UX B.11.31 ia64 libunwind doesn't have _Unwind_GetIPInfo. */
#undef HAVE_GETIPINFO
+#define _UA_END_OF_STACK 0
#endif
/* The names of a couple of "standard" routines for unwinding/propagation
__gnat_Unwind_ForcedUnwind (_Unwind_Exception *, void *, void *);
extern void __gnat_setup_current_excep (_Unwind_Exception *);
+extern void __gnat_unhandled_except_handler (_Unwind_Exception *);
#include "dwarf2.h"
#include "unwind-dw2-fde.h"
return _URC_INSTALL_CONTEXT;
}
+_Unwind_Reason_Code
+__gnat_cleanupunwind_handler (int version,
+ _Unwind_Action phases,
+ _Unwind_Exception_Class eclass,
+ struct _Unwind_Exception *exception,
+ struct _Unwind_Context *context,
+ void *arg)
+{
+ /* Terminate when the end of the stack is reached. */
+ if ((phases & _UA_END_OF_STACK) != 0
+#ifdef __ia64__
+ /* Strictely follow the ia64 ABI: when end of stack is reached,
+ the callback will be called with a NULL stack pointer. */
+ || _Unwind_GetREG (context, 12) == 0
+#endif
+ )
+ __gnat_unhandled_except_handler (exception);
+
+ /* We know there is at least one cleanup further up. Return so that it
+ is searched and entered, after which Unwind_Resume will be called
+ and this hook will gain control again. */
+ return _URC_NO_REASON;
+}
+
/* Define the consistently named wrappers imported by Propagate_Exception. */
#ifdef __USING_SJLJ_EXCEPTIONS__
-- --
-- S p e c --
-- --
--- Copyright (C) 2001-2009, AdaCore --
+-- Copyright (C) 2001-2012, AdaCore --
-- --
-- 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- --
package System.Communication is
+ pragma Preelaborate;
+
function Last_Index
(First : Ada.Streams.Stream_Element_Offset;
Count : CRTL.size_t) return Ada.Streams.Stream_Element_Offset;
-- --
-- S p e c --
-- --
--- Copyright (C) 1992-2011, Free Software Foundation, Inc. --
+-- Copyright (C) 1992-2012, 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- --
package System.File_Control_Block is
+ pragma Preelaborate;
+
----------------------------
-- Ada File Control Block --
----------------------------
-- --
-- B o d y --
-- --
--- Copyright (C) 1992-2010, Free Software Foundation, Inc. --
+-- Copyright (C) 1992-2012, 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- --
(C, text_translation_required, "__gnat_text_translation_required");
-- If true, add appropriate suffix to control string for Open
- function Get_Case_Sensitive return Integer;
- pragma Import (C, Get_Case_Sensitive,
- "__gnat_get_file_names_case_sensitive");
- File_Names_Case_Sensitive : constant Boolean := Get_Case_Sensitive /= 0;
- -- Set to indicate whether the operating system convention is for file
- -- names to be case sensitive (e.g., in Unix, set True), or non case
- -- sensitive (e.g., in Windows, set False).
-
-----------------------
-- Local Subprograms --
-----------------------
pragma Import (C, Tmp_Name, "__gnat_tmp_name");
-- Set buffer (a String address) with a temporary filename
+ function Get_Case_Sensitive return Integer;
+ pragma Import (C, Get_Case_Sensitive,
+ "__gnat_get_file_names_case_sensitive");
+
+ File_Names_Case_Sensitive : constant Boolean := Get_Case_Sensitive /= 0;
+ -- Set to indicate whether the operating system convention is for file
+ -- names to be case sensitive (e.g., in Unix, set True), or not case
+ -- sensitive (e.g., in Windows, set False). Declared locally to avoid
+ -- breaking the Preelaborate rule that disallows function calls at the
+ -- library level.
+
Stream : FILEs := C_Stream;
-- Stream which we open in response to this request
-- --
-- S p e c --
-- --
--- Copyright (C) 1992-2009, Free Software Foundation, Inc. --
+-- Copyright (C) 1992-2012, 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- --
package System.File_IO is
+ pragma Preelaborate;
+
package FCB renames System.File_Control_Block;
package ICS renames Interfaces.C_Streams;
package System.OS_Lib is
pragma Elaborate_Body (OS_Lib);
+ pragma Preelaborate;
+
-----------------------
-- String Operations --
-----------------------