[multiple changes]

2009-04-15  Pascal Obry  <obry@adacore.com>

	* adaint.h (__gnat_unlink): Add spec.
	(__gnat_rename): Likewise.

2009-04-15  Vincent Celier  <celier@adacore.com>

	* prj-nmsc.adb: Minor spelling error corrections in error messages

2009-04-15  Robert Dewar  <dewar@adacore.com>

	* sinfo.ads: Minor comment update

	* opt.ads: Minor comment updates

	* checks.adb (Enable_Overflow_Check): Do not set Do_Overflow_Check for
	modular type.

2009-04-15  Ed Schonberg  <schonberg@adacore.com>

	* exp_disp.ads, exp_disp.adb (Register_Primitive): Is now a function
	that generates the code needed to update a dispatch table when a
	primitive operation is declared with a subprogram body without previous
	spec. Insertion of the generated code is responsibility of the caller.
	(Make_DT): When building static tables, append the code created by
	Register_Primitive to update a secondary table after it has been
	constructed.

	* exp_ch3.adb, exp_ch6.adb: use new version of Register_Primitive.

	* sem_disp.adb (Check_Dispatching_Operation): Call Register_Primitive
	on an overriding operation that implements an interface operation only
	if not building static dispatch tables.

2009-04-15  Hristian Kirtchev  <kirtchev@adacore.com>

	* a-caldel-vms.adb (To_Duration): Declare a "safe" end of time which
	does not cause overflow when converted to Duration. Use the safe value
	as the maximum allowable time delay..

2009-04-15  Jerome Lambourg  <lambourg@adacore.com>

	* g-comlin.adb (Set_Command_Line): When adding a switch with attached
	parameter, specify that the delimiter is NUL, otherwise "-j2" will be
	translated to "-j 2".

2009-04-15  Bob Duff  <duff@adacore.com>

	* rtsfind.adb (Maybe_Add_With): Split out procedure to add implicit
	with_clauses, to avoid code duplication. Change this processing so we
	always add a with_clause on the main unit if needed.

From-SVN: r146102

14 files changed, 209 insertions, 133 deletions

diff --git a/gcc/ada/ChangeLog b/gcc/ada/ChangeLog
index 4f33243..9cf4008 100644
--- a/gcc/ada/ChangeLog
+++ b/gcc/ada/ChangeLog
@@ -1,5 +1,57 @@
 2009-04-15  Pascal Obry  <obry@adacore.com>
 
+	* adaint.h (__gnat_unlink): Add spec.
+	(__gnat_rename): Likewise.
+
+2009-04-15  Vincent Celier  <celier@adacore.com>
+
+	* prj-nmsc.adb: Minor spelling error corrections in error messages
+
+2009-04-15  Robert Dewar  <dewar@adacore.com>
+
+	* sinfo.ads: Minor comment update
+
+	* opt.ads: Minor comment updates
+
+	* checks.adb (Enable_Overflow_Check): Do not set Do_Overflow_Check for
+	modular type.
+
+2009-04-15  Ed Schonberg  <schonberg@adacore.com>
+
+	* exp_disp.ads, exp_disp.adb (Register_Primitive): Is now a function
+	that generates the code needed to update a dispatch table when a
+	primitive operation is declared with a subprogram body without previous
+	spec. Insertion of the generated code is responsibility of the caller.
+	(Make_DT): When building static tables, append the code created by
+	Register_Primitive to update a secondary table after it has been
+	constructed.
+
+	* exp_ch3.adb, exp_ch6.adb: use new version of Register_Primitive.
+
+	* sem_disp.adb (Check_Dispatching_Operation): Call Register_Primitive
+	on an overriding operation that implements an interface operation only
+	if not building static dispatch tables.
+
+2009-04-15  Hristian Kirtchev  <kirtchev@adacore.com>
+
+	* a-caldel-vms.adb (To_Duration): Declare a "safe" end of time which
+	does not cause overflow when converted to Duration. Use the safe value
+	as the maximum allowable time delay..
+
+2009-04-15  Jerome Lambourg  <lambourg@adacore.com>
+
+	* g-comlin.adb (Set_Command_Line): When adding a switch with attached
+	parameter, specify that the delimiter is NUL, otherwise "-j2" will be
+	translated to "-j 2".
+
+2009-04-15  Bob Duff  <duff@adacore.com>
+
+	* rtsfind.adb (Maybe_Add_With): Split out procedure to add implicit
+	with_clauses, to avoid code duplication. Change this processing so we
+	always add a with_clause on the main unit if needed.
+
+2009-04-15  Pascal Obry  <obry@adacore.com>
+
 	Add support for Win32 native encoding for delete/rename routines.
 	
 	* adaint.c (__gnat_unlink): New routine.
diff --git a/gcc/ada/a-caldel-vms.adb b/gcc/ada/a-caldel-vms.adb
index b60bc8b..8b77157 100644
--- a/gcc/ada/a-caldel-vms.adb
+++ b/gcc/ada/a-caldel-vms.adb
@@ -75,8 +75,20 @@ package body Ada.Calendar.Delays is
    -----------------
 
    function To_Duration (T : Time) return Duration is
+      Safe_Ada_High : constant Time := Time_Of (2250, 1, 1, 0.0);
+      --  A value distant enough to emulate "end of time" but which does not
+      --  cause overflow.
+
+      Safe_T : Time;
+
    begin
-      return OSP.To_Duration (OSP.OS_Time (T), OSP.Absolute_Calendar);
+      if T > Safe_Ada_High then
+         Safe_T := Safe_Ada_High;
+      else
+         Safe_T := T;
+      end if;
+
+      return OSP.To_Duration (OSP.OS_Time (Safe_T), OSP.Absolute_Calendar);
    end To_Duration;
 
    --------------------
diff --git a/gcc/ada/adaint.h b/gcc/ada/adaint.h
index 3c9e4c4..925143c 100644
--- a/gcc/ada/adaint.h
+++ b/gcc/ada/adaint.h
@@ -70,6 +70,9 @@ extern int    __gnat_open_new_temp		   (char *, int);
 extern int    __gnat_mkdir			   (char *);
 extern int    __gnat_stat			   (char *,
 						    struct stat *);
+extern int    __gnat_unlink                        (char *);
+extern int    __gnat_rename                        (char *, char *);
+
 extern FILE  *__gnat_fopen			   (char *, char *, int);
 extern FILE  *__gnat_freopen			   (char *, char *, FILE *,
 				                    int);
diff --git a/gcc/ada/checks.adb b/gcc/ada/checks.adb
index 45462db..39f63f3 100644
--- a/gcc/ada/checks.adb
+++ b/gcc/ada/checks.adb
@@ -3568,6 +3568,11 @@ package body Checks is
       then
          return;
 
+      --  Nothing to do for unsigned integer types, which do not overflow
+
+      elsif Is_Modular_Integer_Type (Typ) then
+         return;
+
       --  Nothing to do if the range of the result is known OK. We skip this
       --  for conversions, since the caller already did the check, and in any
       --  case the condition for deleting the check for a type conversion is
diff --git a/gcc/ada/exp_ch3.adb b/gcc/ada/exp_ch3.adb
index 7f30178..b9b0054 100644
--- a/gcc/ada/exp_ch3.adb
+++ b/gcc/ada/exp_ch3.adb
@@ -2394,9 +2394,8 @@ package body Exp_Ch3 is
                           and then Convention (Prim) = Convention_CPP
                           and then not Present (Interface_Alias (Prim))
                         then
-                           Register_Primitive (Loc,
-                             Prim    => Prim,
-                             Ins_Nod => Last (Init_Tags_List));
+                           Append_List_To (Init_Tags_List,
+                             Register_Primitive (Loc, Prim => Prim));
                         end if;
 
                         Next_Elmt (E);
diff --git a/gcc/ada/exp_ch6.adb b/gcc/ada/exp_ch6.adb
index 2cd2f10..4bab3d2 100644
--- a/gcc/ada/exp_ch6.adb
+++ b/gcc/ada/exp_ch6.adb
@@ -4911,9 +4911,8 @@ package body Exp_Ch6 is
                      Register_Predefined_DT_Entry (Subp);
                   end if;
 
-                  Register_Primitive (Loc,
-                    Prim    => Subp,
-                    Ins_Nod => N);
+                  Insert_Actions_After (N,
+                    Register_Primitive (Loc, Prim => Subp));
                end if;
             end if;
          end;
diff --git a/gcc/ada/exp_disp.adb b/gcc/ada/exp_disp.adb
index 72131c4..3d9a4ad 100644
--- a/gcc/ada/exp_disp.adb
+++ b/gcc/ada/exp_disp.adb
@@ -6273,17 +6273,16 @@ package body Exp_Disp is
    -- Register_Primitive --
    ------------------------
 
-   procedure Register_Primitive
+   function Register_Primitive
      (Loc     : Source_Ptr;
-      Prim    : Entity_Id;
-      Ins_Nod : Node_Id)
+      Prim    : Entity_Id) return List_Id
    is
       DT_Ptr        : Entity_Id;
       Iface_Prim    : Entity_Id;
       Iface_Typ     : Entity_Id;
       Iface_DT_Ptr  : Entity_Id;
       Iface_DT_Elmt : Elmt_Id;
-      L             : List_Id;
+      L             : constant List_Id := New_List;
       Pos           : Uint;
       Tag           : Entity_Id;
       Tag_Typ       : Entity_Id;
@@ -6294,7 +6293,7 @@ package body Exp_Disp is
       pragma Assert (not Restriction_Active (No_Dispatching_Calls));
 
       if not RTE_Available (RE_Tag) then
-         return;
+         return L;
       end if;
 
       if not Present (Interface_Alias (Prim)) then
@@ -6308,7 +6307,7 @@ package body Exp_Disp is
             DT_Ptr :=
               Node (Next_Elmt (First_Elmt (Access_Disp_Table (Tag_Typ))));
 
-            Insert_After (Ins_Nod,
+            Append_To (L,
               Build_Set_Predefined_Prim_Op_Address (Loc,
                 Tag_Node     => New_Reference_To (DT_Ptr, Loc),
                 Position     => Pos,
@@ -6324,7 +6323,7 @@ package body Exp_Disp is
               and then RTE_Record_Component_Available (RE_Size_Func)
             then
                DT_Ptr := Node (First_Elmt (Access_Disp_Table (Tag_Typ)));
-               Insert_After (Ins_Nod,
+               Append_To (L,
                  Build_Set_Size_Function (Loc,
                    Tag_Node  => New_Reference_To (DT_Ptr, Loc),
                    Size_Func => Prim));
@@ -6334,7 +6333,7 @@ package body Exp_Disp is
             pragma Assert (Pos /= Uint_0 and then Pos <= DT_Entry_Count (Tag));
 
             DT_Ptr := Node (First_Elmt (Access_Disp_Table (Tag_Typ)));
-            Insert_After (Ins_Nod,
+            Append_To (L,
               Build_Set_Prim_Op_Address (Loc,
                 Typ          => Tag_Typ,
                 Tag_Node     => New_Reference_To (DT_Ptr, Loc),
@@ -6363,12 +6362,6 @@ package body Exp_Disp is
          if not Is_Ancestor (Iface_Typ, Tag_Typ)
            and then Present (Thunk_Code)
          then
-            --  Comment needed on why checks are suppressed. This is not just
-            --  efficiency, but fundamental functionality (see 1.295 RH, which
-            --  still does not answer this question) ???
-
-            Insert_Action (Ins_Nod, Thunk_Code, Suppress => All_Checks);
-
             --  Generate the code necessary to fill the appropriate entry of
             --  the secondary dispatch table of Prim's controlling type with
             --  Thunk_Id's address.
@@ -6380,7 +6373,8 @@ package body Exp_Disp is
             Iface_Prim := Interface_Alias (Prim);
             Pos        := DT_Position (Iface_Prim);
             Tag        := First_Tag_Component (Iface_Typ);
-            L          := New_List;
+
+            Prepend_To (L, Thunk_Code);
 
             if Is_Predefined_Dispatching_Operation (Prim)
               or else Is_Predefined_Dispatching_Alias (Prim)
@@ -6412,8 +6406,6 @@ package body Exp_Disp is
                          Prefix => New_Reference_To (Alias (Prim), Loc),
                          Attribute_Name  => Name_Unrestricted_Access))));
 
-               Insert_Actions_After (Ins_Nod, L);
-
             else
                pragma Assert (Pos /= Uint_0
                  and then Pos <= DT_Entry_Count (Tag));
@@ -6445,10 +6437,11 @@ package body Exp_Disp is
                          Prefix => New_Reference_To (Alias (Prim), Loc),
                          Attribute_Name => Name_Unrestricted_Access))));
 
-               Insert_Actions_After (Ins_Nod, L);
             end if;
          end if;
       end if;
+
+      return L;
    end Register_Primitive;
 
    -------------------------
diff --git a/gcc/ada/exp_disp.ads b/gcc/ada/exp_disp.ads
index abdc949..ed86669 100644
--- a/gcc/ada/exp_disp.ads
+++ b/gcc/ada/exp_disp.ads
@@ -306,19 +306,22 @@ package Exp_Disp is
    --  tagged types this routine imports the forward declaration of the tag
    --  entity, that will be declared and exported by Make_DT.
 
-   procedure Register_Primitive
+   function Register_Primitive
      (Loc     : Source_Ptr;
-      Prim    : Entity_Id;
-      Ins_Nod : Node_Id);
-   --  Register Prim in the corresponding primary or secondary dispatch table.
+      Prim    : Entity_Id) return List_Id;
+   --  Build code to register Prim in the primary or secondary dispatch table.
    --  If Prim is associated with a secondary dispatch table then generate also
    --  its thunk and register it in the associated secondary dispatch table.
    --  In general the dispatch tables are always generated by Make_DT and
    --  Make_Secondary_DT; this routine is only used in two corner cases:
+   --
    --    1) To construct the dispatch table of a tagged type whose parent
    --       is a CPP_Class (see Build_Init_Procedure).
    --    2) To handle late overriding of dispatching operations (see
-   --       Check_Dispatching_Operation).
+   --       Check_Dispatching_Operation and Make_DT).
+   --
+   --  The caller is responsible for inserting the generated code in the
+   --  proper place.
 
    procedure Set_All_DT_Position (Typ : Entity_Id);
    --  Set the DT_Position field for each primitive operation. In the CPP
diff --git a/gcc/ada/g-comlin.adb b/gcc/ada/g-comlin.adb
index 9564ff2d..1fbcda4 100644
--- a/gcc/ada/g-comlin.adb
+++ b/gcc/ada/g-comlin.adb
@@ -1277,7 +1277,7 @@ package body GNAT.Command_Line is
 
                         if Separator (Parser) = ASCII.NUL then
                            Add_Switch
-                             (Cmd, Sw & Parameter (Parser), "");
+                             (Cmd, Sw & Parameter (Parser), "", ASCII.NUL);
                         else
                            Add_Switch
                              (Cmd, Sw, Parameter (Parser), Separator (Parser));
diff --git a/gcc/ada/opt.ads b/gcc/ada/opt.ads
index 547afef..d35195d 100644
--- a/gcc/ada/opt.ads
+++ b/gcc/ada/opt.ads
@@ -1316,14 +1316,14 @@ package Opt is
    --  handlers that can never handle a local raise. This warning is only ever
    --  generated if pragma Restrictions (No_Exception_Propagation) is set. The
    --  default is not to generate the warnings except that if the source has
-   --  at least one exception, and this restriction is set, and the warning
-   --  was not explicitly turned off, then it is turned on by default.
+   --  at least one exception handler, and this restriction is set, and the
+   --  warning was not explicitly turned off, then it is turned on by default.
 
    No_Warn_On_Non_Local_Exception : Boolean := False;
    --  GNAT
    --  This is set to True if the above warning is explicitly suppressed. We
    --  use this to avoid turning it on by default when No_Exception_Propagation
-   --  restriction is set.
+   --  restriction is set and an exception handler is present.
 
    Warn_On_Obsolescent_Feature : Boolean := False;
    --  GNAT
diff --git a/gcc/ada/prj-nmsc.adb b/gcc/ada/prj-nmsc.adb
index 8a9a09b..e2d3b01 100644
--- a/gcc/ada/prj-nmsc.adb
+++ b/gcc/ada/prj-nmsc.adb
@@ -746,8 +746,8 @@ package body Prj.Nmsc is
       if Data.Qualifier = Dry and then Data.Source_Dirs /= Nil_String then
          Error_Msg
            (Project, In_Tree,
-            "an abstract project need to have no language, no sources or no " &
-            "source directories",
+            "an abstract project needs to have no language, no sources " &
+            "or no source directories",
             Data.Location);
       end if;
 
@@ -5347,7 +5347,7 @@ package body Prj.Nmsc is
             then
                Error_Msg
                  (Project, In_Tree,
-                  "a reference symbol file need to be defined",
+                  "a reference symbol file needs to be defined",
                   Lib_Symbol_Policy.Location);
             end if;
 
diff --git a/gcc/ada/rtsfind.adb b/gcc/ada/rtsfind.adb
index ebd8501..d466979 100644
--- a/gcc/ada/rtsfind.adb
+++ b/gcc/ada/rtsfind.adb
@@ -79,11 +79,16 @@ package body Rtsfind is
    --  the latter case it is critical to make a call to Set_RTU_Loaded to
    --  ensure that the entry in this table reflects the load.
 
+   --  Withed is True if an implicit with_clause has been added from some unit
+   --  other than the main unit to this unit. Withed_By_Main is the same,
+   --  except from the main unit.
+
    type RT_Unit_Table_Record is record
-      Entity : Entity_Id;
-      Uname  : Unit_Name_Type;
-      Unum   : Unit_Number_Type;
-      Withed : Boolean;
+      Entity         : Entity_Id;
+      Uname          : Unit_Name_Type;
+      Unum           : Unit_Number_Type;
+      Withed         : Boolean;
+      Withed_By_Main : Boolean;
    end record;
 
    RT_Unit_Table : array (RTU_Id) of RT_Unit_Table_Record;
@@ -106,22 +111,19 @@ package body Rtsfind is
 
    RE_Table : array (RE_Id) of Entity_Id;
 
-   --------------------------
-   -- Generation of WITH's --
-   --------------------------
+   --------------------------------
+   -- Generation of with_clauses --
+   --------------------------------
 
    --  When a unit is implicitly loaded as a result of a call to RTE, it is
-   --  necessary to create an implicit WITH to ensure that the object is
-   --  correctly loaded by the binder. We originally added such WITH clauses
-   --  only if the extended main unit required them, and added them only to the
-   --  extended main unit. They are currently added to whatever unit first
-   --  needs them, which is not necessarily the main unit. This works because
-   --  if the main unit requires some runtime unit also required by some other
-   --  unit, the other unit's implicit WITH will force a correct elaboration
-   --  order. This method is necessary for SofCheck Inspector.
-
-   --  The flag Withed in the unit table record is initially set to False. It
-   --  is set True if a WITH has been generated for the corresponding unit.
+   --  necessary to create one or two implicit with_clauses. We add such
+   --  with_clauses to the extended main unit if needed, and also to whatever
+   --  unit first needs them, which is not necessarily the main unit. The
+   --  former ensures that the object is correctly loaded by the binder. The
+   --  latter is necessary for SofCheck Inspector.
+
+   --  The flags Withed and Withed_By_Main in the unit table record are used to
+   --  avoid duplicates.
 
    -----------------------
    -- Local Subprograms --
@@ -178,6 +180,10 @@ package body Rtsfind is
    --  If the unit is a child unit, build fully qualified name for use in
    --  With_Clause.
 
+   procedure Maybe_Add_With (E : RE_Id; U : in out RT_Unit_Table_Record);
+   --  If necessary, add an implicit with_clause from the current unit to the
+   --  one represented by E and U.
+
    procedure Output_Entity_Name (Id : RE_Id; Msg : String);
    --  Output continuation error message giving qualified name of entity
    --  corresponding to Id, appending the string given by Msg. This call
@@ -661,8 +667,9 @@ package body Rtsfind is
       --  Otherwise we need to load the unit, First build unit name
       --  from the enumeration literal name in type RTU_Id.
 
-      U.Uname  := Get_Unit_Name (U_Id);
-      U.Withed := False;
+      U.Uname          := Get_Unit_Name (U_Id);
+      U.Withed         := False;
+      U.Withed_By_Main := False;
 
       --  Now do the load call, note that setting Error_Node to Empty is
       --  a signal to Load_Unit that we will regard a failure to find the
@@ -721,7 +728,7 @@ package body Rtsfind is
 
          if not Analyzed (Cunit (U.Unum)) then
 
-            --  If the unit is already loaded through a limited_with clause,
+            --  If the unit is already loaded through a limited_with_clause,
             --  the relevant entities must already be available. We do not
             --  want to load and analyze the unit because this would create
             --  a real semantic dependence when the purpose of the limited_with
@@ -784,7 +791,66 @@ package body Rtsfind is
       return Nam;
    end Make_Unit_Name;
 
-   -----------------------
+   --------------------
+   -- Maybe_Add_With --
+   --------------------
+
+   procedure Maybe_Add_With (E : RE_Id; U : in out RT_Unit_Table_Record) is
+      Is_Main : constant Boolean :=
+        In_Extended_Main_Code_Unit (Cunit_Entity (Current_Sem_Unit));
+
+   begin
+      --  We do not need to generate a with_clause for a call issued from
+      --  RTE_Component_Available.
+
+      if RTE_Available_Call then
+         return;
+      end if;
+
+      --  If the current unit is the main one, add the with_clause unless it's
+      --  already been done.
+
+      if Is_Main then
+         if U.Withed_By_Main then
+            return;
+         else
+            U.Withed_By_Main := True;
+         end if;
+
+      --  If the current unit is not the main one, add the with_clause unless
+      --  it's already been done for some non-main unit.
+
+      else
+         if U.Withed then
+            return;
+         else
+            U.Withed := True;
+         end if;
+      end if;
+
+      --  Here if we've decided to add the with_clause
+
+      declare
+         Lib_Unit : constant Node_Id := Unit (Cunit (U.Unum));
+         Withn    : constant Node_Id :=
+           Make_With_Clause (Standard_Location,
+             Name =>
+               Make_Unit_Name
+                 (E, Defining_Unit_Name (Specification (Lib_Unit))));
+
+      begin
+         Set_Library_Unit          (Withn, Cunit (U.Unum));
+         Set_Corresponding_Spec    (Withn, U.Entity);
+         Set_First_Name            (Withn, True);
+         Set_Implicit_With         (Withn, True);
+
+         Mark_Rewrite_Insertion (Withn);
+         Append (Withn, Context_Items (Cunit (Current_Sem_Unit)));
+         Check_Restriction_No_Dependence (Name (Withn), Current_Error_Node);
+      end;
+   end Maybe_Add_With;
+
+   ------------------------
    -- Output_Entity_Name --
    ------------------------
 
@@ -1063,36 +1129,8 @@ package body Rtsfind is
          end if;
       end if;
 
-      --  See if we have to generate a WITH for this entity. We generate a WITH
-      --  if we have not already added the with. The WITH is added to the
-      --  appropriate unit (the current one). We do not need to generate a WITH
-      --  for a call issued from RTE_Available.
-
    <<Found>>
-      if not U.Withed and then not RTE_Available_Call then
-         U.Withed := True;
-
-         declare
-            Withn    : Node_Id;
-            Lib_Unit : Node_Id;
-
-         begin
-            Lib_Unit := Unit (Cunit (U.Unum));
-            Withn :=
-              Make_With_Clause (Standard_Location,
-                Name =>
-                  Make_Unit_Name
-                    (E, Defining_Unit_Name (Specification (Lib_Unit))));
-            Set_Library_Unit          (Withn, Cunit (U.Unum));
-            Set_Corresponding_Spec    (Withn, U.Entity);
-            Set_First_Name            (Withn, True);
-            Set_Implicit_With         (Withn, True);
-
-            Mark_Rewrite_Insertion (Withn);
-            Append (Withn, Context_Items (Cunit (Current_Sem_Unit)));
-            Check_Restriction_No_Dependence (Name (Withn), Current_Error_Node);
-         end;
-      end if;
+      Maybe_Add_With (E, U);
 
       Front_End_Inlining := Save_Front_End_Inlining;
       return Check_CRT (E, RE_Table (E));
@@ -1197,39 +1235,7 @@ package body Rtsfind is
       --  If we didn't find the entity we want, something is wrong. The
       --  appropriate action will be taken by Check_CRT when we exit.
 
-      --  Generate a with-clause if the current unit is part of the extended
-      --  main code unit, and if we have not already added the with. The clause
-      --  is added to the appropriate unit (the current one). We do not need to
-      --  generate it for a call issued from RTE_Component_Available.
-
-      if (not U.Withed)
-        and then
-          In_Extended_Main_Code_Unit (Cunit_Entity (Current_Sem_Unit))
-        and then not RTE_Available_Call
-      then
-         U.Withed := True;
-
-         declare
-            Withn    : Node_Id;
-            Lib_Unit : Node_Id;
-
-         begin
-            Lib_Unit := Unit (Cunit (U.Unum));
-            Withn :=
-              Make_With_Clause (Standard_Location,
-                Name =>
-                  Make_Unit_Name
-                    (E, Defining_Unit_Name (Specification (Lib_Unit))));
-            Set_Library_Unit          (Withn, Cunit (U.Unum));
-            Set_Corresponding_Spec    (Withn, U.Entity);
-            Set_First_Name            (Withn, True);
-            Set_Implicit_With         (Withn, True);
-
-            Mark_Rewrite_Insertion (Withn);
-            Append (Withn, Context_Items (Cunit (Current_Sem_Unit)));
-            Check_Restriction_No_Dependence (Name (Withn), Current_Error_Node);
-         end;
-      end if;
+      Maybe_Add_With (E, U);
 
       Front_End_Inlining := Save_Front_End_Inlining;
       return Check_CRT (E, Found_E);
@@ -1334,10 +1340,11 @@ package body Rtsfind is
                --  If entry is not set, set it now
 
                if No (U.Entity) then
-                  U.Entity := E;
-                  U.Uname  := Get_Unit_Name (U_Id);
-                  U.Unum   := Unum;
-                  U.Withed := False;
+                  U := (Entity         => E,
+                        Uname          => Get_Unit_Name (U_Id),
+                        Unum           => Unum,
+                        Withed         => False,
+                        Withed_By_Main => False);
                end if;
 
                return;
diff --git a/gcc/ada/sem_disp.adb b/gcc/ada/sem_disp.adb
index 96e6bc1..fc3db82 100644
--- a/gcc/ada/sem_disp.adb
+++ b/gcc/ada/sem_disp.adb
@@ -28,6 +28,7 @@ with Debug;    use Debug;
 with Elists;   use Elists;
 with Einfo;    use Einfo;
 with Exp_Disp; use Exp_Disp;
+with Exp_Util; use Exp_Util;
 with Exp_Ch7;  use Exp_Ch7;
 with Exp_Tss;  use Exp_Tss;
 with Errout;   use Errout;
@@ -835,9 +836,9 @@ package body Sem_Disp is
                               end if;
 
                            else
-                              Register_Primitive (Sloc (Subp_Body),
-                                Prim    => Subp,
-                                Ins_Nod => Subp_Body);
+                              Insert_Actions_After (Subp_Body,
+                                Register_Primitive (Sloc (Subp_Body),
+                                Prim    => Subp));
                            end if;
 
                            Generate_Reference (Tagged_Type, Subp, 'p', False);
@@ -909,7 +910,9 @@ package body Sem_Disp is
             --  Ada 2005 (AI-251): In case of late overriding of a primitive
             --  that covers abstract interface subprograms we must register it
             --  in all the secondary dispatch tables associated with abstract
-            --  interfaces.
+            --  interfaces. We do this now only if not building static tables.
+            --  Otherwise the patch code is emitted after those tables are
+            --  built, to prevent access_before_elaboration in gigi.
 
             if Body_Is_Last_Primitive then
                declare
@@ -925,10 +928,10 @@ package body Sem_Disp is
                      if Present (Alias (Prim))
                        and then Present (Interface_Alias (Prim))
                        and then Alias (Prim) = Subp
+                       and then not Building_Static_DT (Tagged_Type)
                      then
-                        Register_Primitive (Sloc (Prim),
-                          Prim    => Prim,
-                          Ins_Nod => Subp_Body);
+                        Insert_Actions_After (Subp_Body,
+                          Register_Primitive (Sloc (Subp_Body), Prim => Prim));
                      end if;
 
                      Next_Elmt (Elmt);
diff --git a/gcc/ada/sinfo.ads b/gcc/ada/sinfo.ads
index 91d286f..ffb44d11a4 100644
--- a/gcc/ada/sinfo.ads
+++ b/gcc/ada/sinfo.ads
@@ -806,7 +806,7 @@ package Sinfo is
    --    See also the description of Do_Range_Check for this case. The only
    --    attribute references which use this flag are Pred and Succ, where it
    --    means that the result should be checked for going outside the base
-   --    range.
+   --    range. Note that this flag is not set for modular types.
 
    --  Do_Range_Check (Flag9-Sem)
    --    This flag is set on an expression which appears in a context where a