This patch simply moves code from the binder generated file
to a-except, to slightly simplify the binder. Preliminary
work.
No testcase as there is no functionnal change.
Tested on x86_64-pc-linux-gnu, committed on trunk
2012-05-15 Tristan Gingold <ging...@adacore.com>
* bindgen.adb (Gen_Header): Remove code to emit LE_Set.
(Gen_Finalize_Library): Replace test with
a call to __gnat_reraise_library_exception_if_any.
* s-soflin.ads (Library_Exception): Do not export.
(Library_Exception_Set): Likewise.
* a-except-2005.ads, a-except-2005.adb
(Reraise_Library_Exception_If_Any): New procedure.
Index: bindgen.adb
===================================================================
--- bindgen.adb (revision 187501)
+++ bindgen.adb (working copy)
@@ -1357,19 +1357,6 @@
procedure Gen_Header is
begin
WBI (" procedure finalize_library is");
-
- -- The following flag is used to check for library-level exceptions
- -- raised during finalization. Symbol comes from System.Soft_Links.
- -- VM targets use regular Ada to reference the entity.
-
- if VM_Target = No_VM then
- WBI (" LE_Set : Boolean;");
-
- Set_String (" pragma Import (Ada, LE_Set, ");
- Set_String ("""__gnat_library_exception_set"");");
- Write_Statement_Buffer;
- end if;
-
WBI (" begin");
end Gen_Header;
@@ -1569,28 +1556,18 @@
-- and the routine necessary to raise it.
if VM_Target = No_VM then
- WBI (" if LE_Set then");
- WBI (" declare");
- WBI (" LE : Ada.Exceptions.Exception_Occurrence;");
+ WBI (" declare");
+ WBI (" procedure Reraise_Library_Exception_If_Any;");
- Set_String (" pragma Import (Ada, LE, ");
- Set_String ("""__gnat_library_exception"");");
+ Set_String (" pragma Import (Ada, ");
+ Set_String ("Reraise_Library_Exception_If_Any, ");
+ Set_String ("""__gnat_reraise_library_exception_if_any"");");
Write_Statement_Buffer;
- Set_String (" procedure Raise_From_Controlled_");
- Set_String ("Operation (X : Ada.Exceptions.Exception_");
- Set_String ("Occurrence);");
- Write_Statement_Buffer;
+ WBI (" begin");
+ WBI (" Reraise_Library_Exception_If_Any;");
+ WBI (" end;");
- Set_String (" pragma Import (Ada, Raise_From_");
- Set_String ("Controlled_Operation, ");
- Set_String ("""__gnat_raise_from_controlled_operation"");");
- Write_Statement_Buffer;
-
- WBI (" begin");
- WBI (" Raise_From_Controlled_Operation (LE);");
- WBI (" end;");
-
-- VM-specific code, use regular Ada to produce the desired behavior
else
@@ -1599,9 +1576,10 @@
Set_String (" Ada.Exceptions.Reraise_Occurrence (");
Set_String ("System.Soft_Links.Library_Exception);");
Write_Statement_Buffer;
+
+ WBI (" end if;");
end if;
- WBI (" end if;");
WBI (" end finalize_library;");
WBI ("");
end if;
Index: s-soflin.ads
===================================================================
--- s-soflin.ads (revision 187501)
+++ s-soflin.ads (working copy)
@@ -6,7 +6,7 @@
-- --
-- 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- --
@@ -289,12 +289,10 @@
-------------------------------------
Library_Exception : EO;
- pragma Export (Ada, Library_Exception, "__gnat_library_exception");
-- Library-level finalization routines use this common reference to store
-- the first library-level exception which occurs during finalization.
Library_Exception_Set : Boolean := False;
- pragma Export (Ada, Library_Exception_Set, "__gnat_library_exception_set");
-- Used in conjunction with Library_Exception, set when an exception has
-- been stored.
Index: a-except-2005.adb
===================================================================
--- a-except-2005.adb (revision 187501)
+++ a-except-2005.adb (working copy)
@@ -6,7 +6,7 @@
-- --
-- B o d y --
-- --
--- 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- --
@@ -1287,6 +1287,19 @@
Raise_Current_Excep (Excep.Id);
end Reraise;
+ --------------------------------------
+ -- Reraise_Library_Exception_If_Any --
+ --------------------------------------
+
+ procedure Reraise_Library_Exception_If_Any is
+ LE : Exception_Occurrence;
+ begin
+ if Library_Exception_Set then
+ LE := Library_Exception;
+ Raise_From_Controlled_Operation (LE);
+ end if;
+ end Reraise_Library_Exception_If_Any;
+
------------------------
-- Reraise_Occurrence --
------------------------
Index: a-except-2005.ads
===================================================================
--- a-except-2005.ads (revision 187501)
+++ a-except-2005.ads (working copy)
@@ -6,7 +6,7 @@
-- --
-- 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 --
@@ -236,6 +236,13 @@
-- Raise Program_Error, providing information about X (an exception raised
-- during a controlled operation) in the exception message.
+ procedure Reraise_Library_Exception_If_Any;
+ pragma Export
+ (Ada, Reraise_Library_Exception_If_Any,
+ "__gnat_reraise_library_exception_if_any");
+ -- If there was an exception raised during library-level finalization,
+ -- reraise the exception.
+
procedure Reraise_Occurrence_Always (X : Exception_Occurrence);
pragma No_Return (Reraise_Occurrence_Always);
-- This differs from Raise_Occurrence only in that the caller guarantees
