2004-06-11 Vincent Celier <celier@gnat.com>

	* mlib-tgt-vms-alpha.adb (Build_Dynamic_Library): Issue switch -R to
	gnatsym, when symbol policy is Restricted.

	* mlib-tgt-vms-ia64.adb (Build_Dynamic_Library): Issue switch -R to
	gnatsym, when symbol policy is Restricted.

	* symbols-vms-alpha.adb (Initialize): When symbol policy is Restricted,
	read the symbol file.
	(Finalize): Fail in symbol policy Restricted if a symbol in the original
	symbol file is not in the object files. Do not create a new symbol file
	when symbol policy is Restricted.

	* gnatbind.adb (Gnatbind): Initialize Snames, because Snames is used
	in Scng.

	* gnatsym.adb (Parse_Vmd_Line): Process new switch -R for symbol policy
	Restricted.
	(Usage): Line for new switch -R

	* make.adb (Initialize): When the platform is not VMS, add the
	directory where gnatmake is invoked in the front of the path, if
	gnatmake is invoked with directory information.  Change the Scan_Args
	while loop to a for loop.
	(Recursive_Compute_Depth): Remove parameter Visited. Improve efficiency:
	if Depth is equal or greater than the proposed depth, there is nothing
	to do.
	(Initialize): Call Recursive_Compute_Depth with initial Depth equal to 1
	instead of 0.

	* prj.ads: Add new symbol policy Restricted.

	* prj-dect.adb (Parse_Case_Construction): Call End_Case_Construction
	with the new parameters Check_All_Labels and Case_Location.

	* prj-nmsc.adb (Ada_Check): Process new symbol policy Restricted
	(Library_Symbol_File needs to be defined).

	* prj-strt.adb (End_Case_Construction): New parameters Check_All_Labels
	and Case_Location If Check_All_Labels is True, check that all values of
	the string type are used, and output warning(s) if they are not.

	* prj-strt.ads (End_Case_Construction): New parameters Check_All_Labels
	and Case_Location.

	* gnat_ugn.texi: Reorder subclauses in menus "Switches for gcc"

	* gnat_ugn.texi: Update documentation about the library directory in
	Library Projects.

	* makegpr.adb (Display_Command): In verbose mode, also display the
	value of the CPATH env var, when the compiler is gcc.
	(Initialize): Change the Scan_Args while loop to a for loop
	(Compile_Individual_Sources): Change directory to object directory
	before compilations.

	* symbols.ads: New symbol policy Restricted.

2004-06-11  Olivier Hainque  <hainque@act-europe.fr>

	* a-except.adb (Raise_After_Setup family): Remove. The responsibility
	is now taken care of internally in the Exception_Propagation package
	and does not require clients assistance any more.

	* a-exexpr.adb (Is_Setup_And_Not_Propagated,
	Set_Setup_And_Not_Propagated, and Clear_Setup_And_Not_Propagated): New
	functions. Helpers to maintain a predicate required in the handling of
	occurrence transfer between tasks.
	This is now handled internally and does not require clients assistance
	for the setup/propagate separation anymore.
	(Setup_Exception, Propagate_Exception): Simplify the Private_Data
	allocation strategy, handle the Setup_And_Not_Propagated predicate and
	document.

	* s-taenca.adb (Check_Exception): Use raise_with_msg instead of
	raise_after_setup, now that everything is handled internally within the
	setup/propagation engine.

2004-06-11  Hristian Kirtchev  <kirtchev@gnat.com>

	* exp_ch6.adb (Expand_Inlined_Call): Add function Formal_Is_Used_Once.
	Add additional conditions for the case of an actual being a simple
	name or literal. Improve inlining by preventing the generation
	of temporaries with a short lifetime (one use).

2004-06-11  Hristian Kirtchev  <kirtchev@gnat.com>

	PR ada/15587

	* einfo.ads: Minor comment updates for Has_Completion and
	E_Constant list of flags.

	* sem_ch3.adb (Analyze_Object_Declaration): Full constant declarations
	and constant redeclarations now set the Has_Completion flag of their
	defining identifiers.

	* sem_ch7.adb (Analyze_Package_Spec): Add procedure
	Inspect_Deferred_Constant_Completion.
	Used to detect private deferred constants that have not been completed
	either by a constant redeclaration or pragma Import. Emits error message
	"constant declaration requires initialization expression".

	* sem_prag.adb (Process_Import_Or_Interface): An Import pragma now
	completes a deferred constant.

2004-06-11  Geert Bosch  <bosch@gnat.com>

	* eval_fat.adb (Decompose_Int): Fix rounding of negative numbers.

	* s-fatgen.adb (Gradual_Scaling): Correct off-by-one error in
	calculating exponent for scaling denormal numbers.
	(Leading_Part): Properly raise Constraint_Error for zero or negative
	Adjustment.
	(Remainder): Properly raise Constraint_Error for zero divisor.

2004-06-11  Thomas Quinot  <quinot@act-europe.fr>

	* sem_util.adb: Minor reformatting.

	* exp_ch2.adb (Expand_Entry_Parameter): Generate an explicit
	dereference when accessing the entry parameter record.
	(Check_Array_Type): Always check for possible implicit dereference.
	(maybe_implicit_dereference): Rename to check_no_implicit_derefence.
	Abort if a pointer is still present (denoting that an implicit
	dereference was left in the tree by the front-end).

	* sem_attr.adb (Expand_Entry_Parameter): Generate an explicit
	dereference when accessing the entry parameter record.
	(Check_Array_Type): Always check for possible implicit dereference.
	(maybe_implicit_dereference): Rename to check_no_implicit_derefence.
	Abort if a pointer is still present (denoting that an implicit
	dereference was left in the tree by the front-end).

2004-06-11  Emmanuel Briot  <briot@act-europe.fr>

	* g-debpoo.adb (Deallocate, Dereference): Add prefix "error:" to error
	message, like the compiler itself does. Easier to parse the output.

	* g-debpoo.ads: (Allocate, Deallocate, Dereference): Add comments.

	* gnat_ugn.texi (gnatxref, gnatfind): Clarify that source names should
	be base names, and not includes directories.

2004-06-11  Arnaud Charlet  <charlet@act-europe.fr>

	* Makefile.generic ($(EXEC)): Depend on $(OBJECTS), not $(OBJ_FILES),
	so that dependencies are properly taken into account by make.

2004-06-11  Arnaud Charlet  <charlet@act-europe.fr>

	PR ada/15622
	* s-unstyp.ads, s-maccod.ads, sem_ch8.adb, s-auxdec.ads,
	exp_intr.adb, s-auxdec-vms_64.ads: Fix typo: instrinsic -> intrinsic

2004-06-11  Jerome Guitton  <guitton@act-europe.fr>

	* Makefile.in (install-gnatlib): install target-specific run-time files.

	* Make-lang.in: Remove obsolete targets.

2004-06-11  Ed Schonberg  <schonberg@gnat.com>

	* par-ch12.adb (P_Generic): Add scope before analyzing subprogram
	specification, to catch misuses of program unit names.

	* sem_res.adb (Resolve_Type_Conversion): Do not emit warnings on
	superfluous conversions in an instance.

2004-06-11  Ed Schonberg  <schonberg@gnat.com>

	PR ada/15403

	* sem_ch12.adb (Save_References): If operator node has been folded to
	enumeration literal, associated_node must be discarded.

2004-06-11  Jose Ruiz  <ruiz@act-europe.fr>

	* s-stchop-vxworks.adb: Add required pragma Convention to
	Task_Descriptor because it is updated by a C function.


git-svn-id: svn+ssh://gcc.gnu.org/svn/gcc/trunk@82973 138bc75d-0d04-0410-961f-82ee72b054a4

1 files changed, 127 insertions, 45 deletions

diff --git a/gcc/ada/a-exexpr.adb b/gcc/ada/a-exexpr.adb
index b42b3fc7fd7..0d0eb094759 100644
--- a/gcc/ada/a-exexpr.adb
+++ b/gcc/ada/a-exexpr.adb
@@ -36,6 +36,8 @@ with Interfaces;
 with Ada.Unchecked_Conversion;
 with Ada.Unchecked_Deallocation;
 
+with System.Storage_Elements;  use System.Storage_Elements;
+
 pragma Warnings (Off);
 --  Since several constructs give warnings in 3.14a1, including unreferenced
 --  variables and pragma Unreferenced itself.
@@ -170,22 +172,6 @@ package body Exception_Propagation is
    procedure Free is new Unchecked_Deallocation
      (Exception_Occurrence, EOA);
 
-   function Remove
-     (Top   : EOA;
-      Excep : GNAT_GCC_Exception_Access) return Boolean;
-   --  Remove Excep from the stack starting at Top.
-   --  Return True if Excep was found and removed, false otherwise.
-
-   --  Hooks called when entering/leaving an exception handler for a given
-   --  occurrence, aimed at handling the stack of active occurrences. The
-   --  calls are generated by gigi in tree_transform/N_Exception_Handler.
-
-   procedure Begin_Handler (GCC_Exception : GNAT_GCC_Exception_Access);
-   pragma Export (C, Begin_Handler, "__gnat_begin_handler");
-
-   procedure End_Handler (GCC_Exception : GNAT_GCC_Exception_Access);
-   pragma Export (C, End_Handler, "__gnat_end_handler");
-
    function CleanupUnwind_Handler
      (UW_Version   : Integer;
       UW_Phases    : Unwind_Action;
@@ -211,6 +197,41 @@ package body Exception_Propagation is
       UW_Argument  : System.Address);
    pragma Import (C, Unwind_ForcedUnwind, "__gnat_Unwind_ForcedUnwind");
 
+   --------------------------------------------
+   -- Occurrence stack management facilities --
+   --------------------------------------------
+
+   function Remove
+     (Top   : EOA;
+      Excep : GNAT_GCC_Exception_Access) return Boolean;
+   --  Remove Excep from the stack starting at Top.
+   --  Return True if Excep was found and removed, false otherwise.
+
+   --  Hooks called when entering/leaving an exception handler for a given
+   --  occurrence, aimed at handling the stack of active occurrences. The
+   --  calls are generated by gigi in tree_transform/N_Exception_Handler.
+
+   procedure Begin_Handler (GCC_Exception : GNAT_GCC_Exception_Access);
+   pragma Export (C, Begin_Handler, "__gnat_begin_handler");
+
+   procedure End_Handler (GCC_Exception : GNAT_GCC_Exception_Access);
+   pragma Export (C, End_Handler, "__gnat_end_handler");
+
+   --  To handle the case of a task "transferring" an exception occurrence to
+   --  another task, for instance via Exceptional_Complete_Rendezvous, we need
+   --  to be able to identify occurrences which have been Setup and not yet
+   --  Propagated. We hijack one of the common header fields for that purpose,
+   --  setting it to a special key value during the setup process, clearing it
+   --  at the very beginning of the propagation phase, and expecting it never
+   --  to be reset to the special value later on.
+
+   Setup_Key : constant := 16#DEAD_BEEF#;
+
+   function Is_Setup_And_Not_Propagated (E : EOA) return Boolean;
+
+   procedure Set_Setup_And_Not_Propagated (E : EOA);
+   procedure Clear_Setup_And_Not_Propagated (E : EOA);
+
    ------------------------------------------------------------
    -- Accessors to basic components of a GNAT exception data --
    ------------------------------------------------------------
@@ -316,11 +337,48 @@ package body Exception_Propagation is
       return URC_NO_REASON;
    end CleanupUnwind_Handler;
 
+   ---------------------------------
+   -- Is_Setup_And_Not_Propagated --
+   ---------------------------------
+
+   function Is_Setup_And_Not_Propagated (E : EOA) return Boolean is
+      GCC_E : GNAT_GCC_Exception_Access :=
+        To_GNAT_GCC_Exception (E.Private_Data);
+   begin
+      return GCC_E /= null and then GCC_E.Header.Private1 = Setup_Key;
+   end Is_Setup_And_Not_Propagated;
+
+   ------------------------------------
+   -- Clear_Setup_And_Not_Propagated --
+   ------------------------------------
+
+   procedure Clear_Setup_And_Not_Propagated (E : EOA) is
+      GCC_E : GNAT_GCC_Exception_Access :=
+        To_GNAT_GCC_Exception (E.Private_Data);
+   begin
+      pragma Assert (GCC_E /= null);
+      GCC_E.Header.Private1 := 0;
+   end Clear_Setup_And_Not_Propagated;
+
+   ----------------------------------
+   -- Set_Setup_And_Not_Propagated --
+   ----------------------------------
+
+   procedure Set_Setup_And_Not_Propagated (E : EOA) is
+      GCC_E : GNAT_GCC_Exception_Access :=
+        To_GNAT_GCC_Exception (E.Private_Data);
+   begin
+      pragma Assert (GCC_E /= null);
+      GCC_E.Header.Private1 := Setup_Key;
+   end Set_Setup_And_Not_Propagated;
+
    ---------------------
    -- Setup_Exception --
    ---------------------
 
-   --  Push the current exception occurrence on the stack before overriding it.
+   --  In this implementation of the exception propagation scheme, this
+   --  subprogram should be understood as: Setup the exception occurrence
+   --  stack headed at Current for a forthcoming raise of Excep.
 
    procedure Setup_Exception
      (Excep    : EOA;
@@ -331,38 +389,62 @@ package body Exception_Propagation is
       Next          : EOA;
       GCC_Exception : GNAT_GCC_Exception_Access;
 
-      --  Note that we make no use of the Reraised indication at this point.
-
-      --  The information is still passed around just in case of future needs,
-      --  since we've already switched between using/not-using it a number of
-      --  times.
-
    begin
-      --  If the current exception is not live, the stack is empty and there
-      --  is nothing to do. Note that the stack always appears empty for
-      --  mechanisms that do not require one. For the mechanism we implement
-      --  in this unit, the initial Private_Data allocation for an occurrence
-      --  is issued by Propagate_Exception.
 
-      if Top.Private_Data = System.Null_Address then
+      --  The exception Excep is soon to be propagated, and the storage used
+      --  for that will be the occurrence statically allocated for the current
+      --  thread. This storage might currently be used for a still active
+      --  occurrence, so we need to push it on the thread's occurrence stack
+      --  (headed at that static occurrence) before it gets clobbered.
+
+      --  What we do here is to trigger this push when need be, and allocate a
+      --  Private_Data block for the forthcoming Propagation.
+
+      --  Some tasking rendez-vous attempts lead to an occurrence transfer
+      --  from the server to the client (see Exceptional_Complete_Rendezvous).
+      --  In those cases Setup is called twice for the very same occurrence
+      --  before it gets propagated: once from the server, because this is
+      --  where the occurrence contents is elaborated and known, and then
+      --  once from the client when it detects the case and actually raises
+      --  the exception in its own context.
+
+      --  The Is_Setup_And_Not_Propagated predicate tells us when we are in
+      --  the second call to Setup for a Transferred occurrence, and there is
+      --  nothing to be done here in this situation. This predicate cannot be
+      --  True if we are dealing with a Reraise, and we may even be called
+      --  with a raw uninitialized Excep occurrence in this case so we should
+      --  not check anyway. Observe the front-end expansion for a "raise;" to
+      --  see that happening. We get a local occurrence and a direct call to
+      --  Save_Occurrence without the intermediate init-proc call.
+
+      if not Reraised and then Is_Setup_And_Not_Propagated (Excep) then
          return;
       end if;
 
-      --  Shift the contents of the Top of the stack in a freshly allocated
-      --  entry, which leaves the room in the fixed Top entry available for the
-      --  occurrence about to be propagated.
+      --  Allocate what will be the Private_Data block for the exception
+      --  to be propagated.
 
-      Next := new Exception_Occurrence;
-      Save_Occurrence_And_Private (Next.all, Top.all);
+      GCC_Exception := new GNAT_GCC_Exception;
 
-      --  Allocate Private_Data for the occurrence about to be propagated
-      --  and link everything together.
+      --  If the Top of the occurrence stack is not currently used for an
+      --  active exception (the stack is empty) we just need to setup the
+      --  Private_Data pointer.
 
-      GCC_Exception := new GNAT_GCC_Exception;
-      GCC_Exception.Next_Exception := Next;
+      --  Otherwise, we also need to shift the contents of the Top of the
+      --  stack in a freshly allocated entry and link everything together.
+
+      if Top.Private_Data /= System.Null_Address then
+         Next := new Exception_Occurrence;
+         Save_Occurrence_And_Private (Next.all, Top.all);
+
+         GCC_Exception.Next_Exception := Next;
+         Top.Private_Data := GCC_Exception.all'Address;
+      end if;
 
       Top.Private_Data := GCC_Exception.all'Address;
 
+      Set_Setup_And_Not_Propagated (Top);
+
    end Setup_Exception;
 
    -------------------
@@ -403,16 +485,16 @@ package body Exception_Propagation is
       GCC_Exception : GNAT_GCC_Exception_Access;
 
    begin
-      if Excep.Private_Data = System.Null_Address then
-         GCC_Exception := new GNAT_GCC_Exception;
-         Excep.Private_Data := GCC_Exception.all'Address;
-      else
-         GCC_Exception := To_GNAT_GCC_Exception (Excep.Private_Data);
-      end if;
+      pragma Assert (Excep.Private_Data /= System.Null_Address);
 
-      --  Fill in the useful flags for the personality routine called for each
+      --  Retrieve the Private_Data for this occurrence and set the useful
+      --  flags for the personality routine, which will be called for each
       --  frame via Unwind_RaiseException below.
 
+      GCC_Exception := To_GNAT_GCC_Exception (Excep.Private_Data);
+
+      Clear_Setup_And_Not_Propagated (Excep);
+
       GCC_Exception.Id := Excep.Id;
       GCC_Exception.N_Cleanups_To_Trigger := 0;