a-tags.ads, a-tags.adb (Tag_Size): This constant is now internal to the package.

2007-04-20  Javier Miranda  <miranda@adacore.com>

	* a-tags.ads, a-tags.adb (Tag_Size): This constant is now internal to
	the package.
	(Object_Specific_Data_Array): This is now internal to the package.
	(Object_Specific_Data): This is now internal to the package.
	(Select_Specific_Data_Element): This is now internal to the package.
	(Select_Specific_Data_Array): This is now internal to the package.
	(Select_Specific_Data): This is now internal to the package.
	(Offset_To_Top_Function_Ptr): This is now public.
	(To_Offset_To_Top_Function_Ptr): Removed.
	(Storage_Offset_Ptr,To_Storage_Offset_Ptr): These declarations are now
	 local to subprogram Offset_To_Top.
	(Predefined_DT): Removed.
	(Typeinfo_Ptr): Removed.
	(OSD): This function is now internal to this package.
	(SSD): This function is now internal to this package.
	(DT): New function that displaces the pointer to the table of primitives
	 to get access to the enclosing wrapper record.
	(IW_Membership): Code cleanup.
	(Offset_To_Top): Code cleanup.
	(Predefined_DT): Removed.
	(Register_Interface_Tag): Removed.
	(Set_Interface_Table): Removed.
	(Set_Offset_Index): Removed.
	(Set_Offset_To_Top): Code cleanup.
	(Set_OSD): Removed.
	(Set_Signature): Removed.
	(Set_SSD): Removed.
	(Set_Tagged_Kind): Removed.
	(Typeinfo_Ptr): Removed.
	(TSD): Removed.
	(Displace): Add missing check on null actual.

	* exp_disp.ads, exp_disp.adb
	(Select_Expansion_Utilities): Removed.
	(Build_Common_Dispatching_Select_Statements): Moved to exp_atags.
	(Expand_Dispatching_Call): Update calls to Get_Prim_Op_Address because
	the interface requires a new parameter.
	(Make_Disp_Asynchronous_Select_Spec, Make_Disp_Conditional_Select_Spec,
	Make_Disp_Get_Prim_Op_Kind_Spec, Make_Disp_Timed_Select_Spec): Replace
	calls to subprograms Build_T, Build_S, etc. by the corresponding code.
	Done to remove package Select_Expansion_Utilities.
	(Make_DT): New implementation for statically allocated dispatch tables.
	(Make_Secondary_DT): Moved to the scope of Make_DT.
	(Register_Primitive): Code cleanup plus incoporate the use of the new
	function DT_Address_Attribute.
	(Expand_Interface_Thunk): The profile of this subprogram has been
	changed to return the Thunk_Id and the corresponding code.
	(Fill_DT_Entry): Removed. Its functionality is now provided by
	subprogram Register_Primitive.
	(Fill_Secondary_DT_Entry): Removed. Its functionality is now provided by
	subprogram Register_Primitive.
	(Register_Primitive): New subprogram that incorporates the previous
	functionalities of Fill_DT_Entry and Fill_Secondary_DT_Entry.
	(Build_Common_Dispatching_Select_Statements): Remove formal Typ. This
	was only required to call Make_DT_Access_Action, which is now removed.
	(Ada_Actions): Removed
	(Action_Is_Proc): Removed
	(Action_Nb_Arg): Removed
	Replace all the calls to Make_DT_Access_Action by direct calls to
	Make_Procedure_Call_Statement or Make_Function_Call.
	(Set_DTC_Entity_Value): New subprogram.
	(Set_All_DT_Position): Add call to new subprogram Set_DTC_Entity_Value.
	(Expand_Interface_Thunk): Add missing support for primitives that are
	functions with a controlling result (case in which there is no need
	to generate the thunk).

	* exp_atag.ads, exp_atag.adb
	(Build_DT): New subprogram that displaces the pointer to reference the
	base of the wrapper record.
	(Build_Typeinfo_Offset): Removed.
	(RTE_Tag_Node): Removed.
	(Build_Common_Dispatching_Select_Statements): Moved here from exp_disp
	(Build_Get_RC_Offset): Removed.
	(Build_Inherit_Predefined_Prims): Removed.
	(Build_Inherit_TSD: Removed.
	(Build_New_TSD): Removed.
	(Build_Set_External_Tag): Removed.
	(Build_Set_Predefined_Prim_Op_Address): Add documentation.
	(Build_Set_Prim_Op_Address): Add documentation.
	(Build_Set_TSD): Removed.

	* rtsfind.ads, rtsfind.adb
	(Load_Fail): If load fails and we are not in configurable run-time
	mode, then raise Unrecoverable_Error.
	(Text_IO_Kludge): Generate an error message if a run-time library is
	not available in a given run-time (ie. zfp run-time).
	(RTE_Record_Component): Add code to check that the component we search
	for is not found in two records in the given run-time package.
	(RE_DT_Offset_To_Top_Size, RE_DT_Predef_Prims_Size): Removed
	(RE_DT_Predef_Prims_Offset): New entity
	(RE_Static_Offset_To_Top): New entity
	(RE_HT_Link): New entity.
	(System_Address_Image): Addition of this run-time package.
	(RE_Address_Image): New entity.
	(RE_Abstract_Interface): Removed.
	(RE_Default_Prim_Op_Count): Removed.
	(RE_DT_Entry_Size): Removed.
	(RE_DT_Min_Prologue_Size): Removed.
	(RE_DT_Prologue_Size): Removed.
	(RE_Ifaces_Table_Ptr): Removed.
	(RE_Interface_Data_Ptr): Removed.
	(RE_Type_Specific_Data): Removed.
	(RE_Primary_DT): Removed.
	(RE_Register_Interface_Tag): Removed.
	(RE_Set_Offset_Index): Removed.
	(RE_Set_OSD): Removed.
	(RE_Set_SSD): Removed.
	(RE_Set_Signature): Removed.
	(RE_Set_Tagged_Kind): Removed.
	(RE_Address_Array): New entity.
	(RE_DT): New entity.
	(RE_Iface_Tag): New entity.
	(RE_Interfaces_Table): New entity.
	(RE_No_Dispatch_Table): New entity.
	(RE_NDT_Prims_Ptr): New entity.
	(RE_NDT_TSD): New entity.
	(RE_Num_Prims): New entity.
	(RE_Offset_To_Top_Function_Ptr): New entity.
	(RE_OSD_Table): New entity.
	(RE_OSD_Num_Prims): New entity.
	(RE_Predef_Prims): New entity
	(RE_Predef_Prims_Table_Ptr): New entity.
	(RE_Primary_DT): New entity.
	(RE_Signature): New entity.
	(RE_SSD): New entity.
	(RE_TSD): New entity.
	(RE_Type_Specific_Data): New entity.
	(RE_Tag_Kind): New entity.

From-SVN: r125379

gcc/ada/exp_atag.ads

@@ -6,7 +6,7 @@
 --                                                                          --
 --                                 S p e c                                  --
 --                                                                          --
---            Copyright (C) 2006, Free Software Foundation, Inc.            --
+--          Copyright (C) 2006-2007, 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- --
@@ -28,18 +28,24 @@
 --  subprograms of package Ada.Tags
 
 with Types; use Types;
+with Uintp; use Uintp;
 
 package Exp_Atag is
 
+   procedure Build_Common_Dispatching_Select_Statements
+     (Loc    : Source_Ptr;
+      DT_Ptr : Entity_Id;
+      Stmts  : List_Id);
+   --  Ada 2005 (AI-345): Generate statements that are common between timed,
+   --  asynchronous, and conditional select expansion.
+
    function Build_CW_Membership
      (Loc          : Source_Ptr;
       Obj_Tag_Node : Node_Id;
       Typ_Tag_Node : Node_Id) return Node_Id;
-   --  Build code that returns true if Obj_Tag is in Typ_Tag'Class. Each
-   --  dispatch table contains a reference to a table of ancestors (stored
-   --  in the first part of the Tags_Table) and a count of the level of
-   --  inheritance "Idepth". Obj is in Typ'Class if Typ'Tag is in the table
-   --  of ancestors that are contained in the dispatch table referenced by
+   --  Build code that returns true if Obj_Tag is in Typ_Tag'Class. Each DT
+   --  has a table of ancestors and its inheritance level (Idepth). Obj is in
+   --  Typ'Class if Typ'Tag is found in the table of ancestors referenced by
    --  Obj'Tag. Knowing the level of inheritance of both types, this can be
    --  computed in constant time by the formula:
    --
@@ -54,9 +60,9 @@ package Exp_Atag is
    --  Generates: TSD (Tag).Access_Level
 
    function Build_Get_Predefined_Prim_Op_Address
-     (Loc           : Source_Ptr;
-      Tag_Node      : Node_Id;
-      Position_Node : Node_Id) return Node_Id;
+     (Loc      : Source_Ptr;
+      Tag_Node : Node_Id;
+      Position : Uint) return Node_Id;
    --  Given a pointer to a dispatch table (T) and a position in the DT, build
    --  code that gets the address of the predefined virtual function stored in
    --  it (used for dispatching calls).
@@ -64,29 +70,22 @@ package Exp_Atag is
    --  Generates: Predefined_DT (Tag).D (Position);
 
    function Build_Get_Prim_Op_Address
-     (Loc           : Source_Ptr;
-      Tag_Node      : Node_Id;
-      Position_Node : Node_Id) return Node_Id;
+     (Loc      : Source_Ptr;
+      Typ      : Entity_Id;
+      Tag_Node : Node_Id;
+      Position : Uint) return Node_Id;
    --  Build code that retrieves the address of the virtual function stored in
    --  a given position of the dispatch table (used for dispatching calls).
    --
    --  Generates: To_Tag (Tag).D (Position);
 
-   function Build_Get_RC_Offset
-     (Loc        : Source_Ptr;
-      Tag_Node   : Node_Id) return Node_Id;
-   --  Build code that retrieves the Offset of the implicit record controller
-   --  when the object has controlled components. O otherwise.
-   --
-   --  Generates: TSD (T).RC_Offset;
-
-   function Build_Get_Remotely_Callable
-     (Loc        : Source_Ptr;
-      Tag_Node   : Node_Id) return Node_Id;
-   --  Build code that retrieves the value previously saved by Set_Remotely
-   --  Callable
+   function Build_Get_Transportable
+     (Loc      : Source_Ptr;
+      Tag_Node : Node_Id) return Node_Id;
+   --  Build code that retrieves the value of the Transportable flag for
+   --  the given Tag.
    --
-   --  Generates: TSD (Tag).Remotely_Callable
+   --  Generates: TSD (Tag).Transportable;
 
    function Build_Inherit_Predefined_Prims
      (Loc              : Source_Ptr;
@@ -96,6 +95,8 @@ package Exp_Atag is
    --
    --  Generates: Predefined_DT (New_T).D (All_Predefined_Prims) :=
    --               Predefined_DT (Old_T).D (All_Predefined_Prims);
+   --
+   --  Required to build the dispatch tables with the 3.4 backend.
 
    function Build_Inherit_Prims
      (Loc          : Source_Ptr;
@@ -103,80 +104,39 @@ package Exp_Atag is
       New_Tag_Node : Node_Id;
       Num_Prims    : Nat) return Node_Id;
    --  Build code that inherits Num_Prims user-defined primitives from the
-   --  dispatch table of the parent type.
+   --  dispatch table of the parent type. It is used to copy the dispatch
+   --  table of the parent in case of derivations of CPP_Class types.
    --
    --  Generates:
    --    New_Tag.Prims_Ptr (1 .. Num_Prims) :=
    --      Old_Tag.Prims_Ptr (1 .. Num_Prims);
 
-   function Build_Inherit_TSD
-     (Loc               : Source_Ptr;
-      Old_Tag_Node      : Node_Id;
-      New_Tag_Node      : Node_Id;
-      I_Depth           : Nat;
-      Parent_Num_Ifaces : Nat) return Node_Id;
-   --  Generates code that initializes the TSD of a type knowing the tag,
-   --  inheritance depth, and number of interface types of the parent type.
-   --
-   --  Generates:
-   --     --  Copy the table of ancestors of the parent
-   --
-   --     TSD (New_Tag).Tags_Table (1 .. I_Depth) :=
-   --       TSD (Old_Tag).Tags_Table (0 .. I_Depth - 1);
-   --
-   --     --  Copy the table of interfaces of the parent
-   --
-   --     if TSD (Old_Tag).Ifaces_Table_Ptr /= null then
-   --        New_Iface_Table_Ptr.Table (1 .. Parent_Num_Ifaces):=
-   --          Old_Iface_Table_Ptr.Table (1 .. Parent_Num_Ifaces);
-   --     end if;
-   --
-   --     TSD (New_Tag).Tags_Table (0) := New_Tag;
-
-   function Build_New_TSD
-     (Loc          : Source_Ptr;
-      New_Tag_Node : Node_Id) return List_Id;
-   --  Build code that initializes the TSD of a root type.
-   --  Generates: TSD (New_Tag).Tags_Table (0) := New_Tag;
-
-   function Build_Set_External_Tag
-     (Loc        : Source_Ptr;
-      Tag_Node   : Node_Id;
-      Value_Node : Node_Id) return Node_Id;
-   --  Build code that saves the address of the string containing the external
-   --  tag in the dispatch table.
-   --
-   --  Generates: TSD (Tag).External_Tag := Cstring_Ptr! (Value);
-
    function Build_Set_Predefined_Prim_Op_Address
-     (Loc           : Source_Ptr;
-      Tag_Node      : Node_Id;
-      Position_Node : Node_Id;
-      Address_Node  : Node_Id) return Node_Id;
+     (Loc          : Source_Ptr;
+      Tag_Node     : Node_Id;
+      Position     : Uint;
+      Address_Node : Node_Id) return Node_Id;
    --  Build code that saves the address of a virtual function in a given
    --  Position of the portion of the dispatch table associated with the
-   --  predefined primitives of Tag (used for overriding).
+   --  predefined primitives of Tag. Called from Exp_Disp.Fill_DT_Entry
+   --  and Exp_Disp.Fill_Secondary_DT_Entry. It is used for:
+   --   1) Filling the dispatch table of CPP_Class types.
+   --   2) Late overriding (see Check_Dispatching_Operation).
    --
    --  Generates: Predefined_DT (Tag).D (Position) := Value
 
    function Build_Set_Prim_Op_Address
-     (Loc           : Source_Ptr;
-      Tag_Node      : Node_Id;
-      Position_Node : Node_Id;
-      Address_Node  : Node_Id) return Node_Id;
+     (Loc          : Source_Ptr;
+      Typ          : Entity_Id;
+      Tag_Node     : Node_Id;
+      Position     : Uint;
+      Address_Node : Node_Id) return Node_Id;
    --  Build code that saves the address of a virtual function in a given
-   --  Position of the dispatch table associated with the Tag (used for
-   --  overriding).
+   --  Position of the dispatch table associated with the Tag. Called from
+   --  Exp_Disp.Fill_DT_Entry and Exp_Disp.Fill_Secondary_DT_Entry. Used for:
+   --   1) Filling the dispatch table of CPP_Class types.
+   --   2) Late overriding (see Check_Dispatching_Operation).
    --
    --  Generates: Tag.D (Position) := Value
 
-   function Build_Set_TSD
-     (Loc        : Source_Ptr;
-      Tag_Node   : Node_Id;
-      Value_Node : Node_Id) return Node_Id;
-   --  Build code that saves the address of the record containing the Type
-   --  Specific Data generated by GNAT.
-   --
-   --  Generates: To_Addr_Ptr (To_Address (Tag) - K_Typeinfo).all := Value
-
 end Exp_Atag;

gcc/ada/exp_disp.ads

@@ -6,7 +6,7 @@
 --                                                                          --
 --                                 S p e c                                  --
 --                                                                          --
---          Copyright (C) 1992-2006, Free Software Foundation, Inc.         --
+--          Copyright (C) 1992-2007, 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- --
@@ -111,7 +111,7 @@ package Exp_Disp is
    --      interfaces, not generated for the rest of the cases. See Expand_N_
    --      Timed_Entry_Call for more information.
 
-   --  Lifecycle of predefined primitive operations
+   --  Life cycle of predefined primitive operations
 
    --      The specifications and bodies of the PPOs are created by
    --      Make_Predefined_Primitive_Specs and Predefined_Primitive_Bodies
@@ -122,16 +122,14 @@ package Exp_Disp is
    --      PPOs are collected and added to the Primitive_Operations list of
    --      a type by the regular analysis mechanism.
 
-   --      PPOs are frozen in Predefined_Primitive_Freeze in Exp_Ch3.
+   --      PPOs are frozen by Exp_Ch3.Predefined_Primitive_Freeze.
 
-   --      Thunks for PPOs are created in Freeze_Subprogram in Exp_Ch6, by a
-   --      call to Register_Predefined_DT_Entry, also in Exp_Ch6.
+   --      Thunks for PPOs are created by Make_DT.
 
-   --      Dispatch table positions of PPOs are set in Set_All_DT_Position in
-   --      Exp_Disp.
+   --      Dispatch table positions of PPOs are set by Set_All_DT_Position.
 
-   --      Calls to PPOs procede as regular dispatching calls. If the PPO
-   --      has a thunk, a call procedes as a regular dispatching call with
+   --      Calls to PPOs proceed as regular dispatching calls. If the PPO
+   --      has a thunk, a call proceeds as a regular dispatching call with
    --      a thunk.
 
    --  Guidelines for addition of new predefined primitive operations
@@ -167,21 +165,6 @@ package Exp_Disp is
    --    Exp_Disp.Default_Prim_Op_Position - indirect use
    --    Exp_Disp.Set_All_DT_Position      - direct   use
 
-   type DT_Access_Action is
-      (IW_Membership,
-       Get_Entry_Index,
-       Get_Prim_Op_Kind,
-       Get_Tagged_Kind,
-       Register_Interface_Tag,
-       Register_Tag,
-       Set_Entry_Index,
-       Set_Offset_Index,
-       Set_OSD,
-       Set_Prim_Op_Kind,
-       Set_Signature,
-       Set_SSD,
-       Set_Tagged_Kind);
-
    procedure Expand_Dispatching_Call (Call_Node : Node_Id);
    --  Expand the call to the operation through the dispatch table and perform
    --  the required tag checks when appropriate. For CPP types tag checks are
@@ -198,41 +181,22 @@ package Exp_Disp is
    --  the object to give access to the interface tag associated with the
    --  secondary dispatch table.
 
-   function Expand_Interface_Thunk
+   procedure Expand_Interface_Thunk
      (N           : Node_Id;
       Thunk_Alias : Node_Id;
-      Thunk_Id    : Entity_Id) return Node_Id;
+      Thunk_Id    : out Entity_Id;
+      Thunk_Code  : out Node_Id);
    --  Ada 2005 (AI-251): When a tagged type implements abstract interfaces we
    --  generate additional subprograms (thunks) to have a layout compatible
    --  with the C++ ABI. The thunk modifies the value of the first actual of
    --  the call (that is, the pointer to the object) before transferring
    --  control to the target function.
-
-   function Fill_DT_Entry
-     (Loc          : Source_Ptr;
-      Prim         : Entity_Id) return Node_Id;
-   --  Generate the code necessary to fill the appropriate entry of the
-   --  dispatch table of Prim's controlling type with Prim's address.
-
-   function Fill_Secondary_DT_Entry
-     (Loc          : Source_Ptr;
-      Prim         : Entity_Id;
-      Thunk_Id     : Entity_Id;
-      Iface_DT_Ptr : Entity_Id) return Node_Id;
-   --  (Ada 2005): Generate the code necessary to fill the appropriate entry of
-   --  the secondary dispatch table of Prim's controlling type with Thunk_Id's
-   --  address.
-
-   function Make_DT_Access_Action
-     (Typ    : Entity_Id;
-      Action : DT_Access_Action;
-      Args   : List_Id) return Node_Id;
-   --  Generate a call to one of the Dispatch Table Access Subprograms defined
-   --  in Ada.Tags or in Interfaces.Cpp
+   --
+   --  Required in 3.4 case, why ??? giant comment needed for any gcc
+   --  specific code ???
 
    function Make_DT (Typ : Entity_Id) return List_Id;
-   --  Expand the declarations for the Dispatch Table (or the Vtable in
-   --  the case of type whose ancestor is a CPP_Class)
+   --  Expand the declarations for the Dispatch Table.
 
    function Make_Disp_Asynchronous_Select_Body
      (Typ : Entity_Id) return Node_Id;
@@ -284,8 +248,8 @@ package Exp_Disp is
    function Make_Disp_Timed_Select_Body
      (Typ : Entity_Id) return Node_Id;
    --  Ada 2005 (AI-345): Generate the body of the primitive operation of type
-   --  Typ used for dispatching in timed selects. Generate a null body if Nul
-   --  is an interface type.
+   --  Typ used for dispatching in timed selects. Generates a body containing
+   --  a single null-statement if Typ is an interface type.
 
    function Make_Disp_Timed_Select_Spec
      (Typ : Entity_Id) return Node_Id;
@@ -299,20 +263,19 @@ package Exp_Disp is
    --  selects. Generate code to set the primitive operation kinds and entry
    --  indices of primitive operations and primitive wrappers.
 
-   procedure Make_Secondary_DT
-     (Typ             : Entity_Id;
-      Ancestor_Typ    : Entity_Id;
-      Suffix_Index    : Nat;
-      Iface           : Entity_Id;
-      AI_Tag          : Entity_Id;
-      Acc_Disp_Tables : in out Elist_Id;
-      Result          : out List_Id);
-   --  Ada 2005 (AI-251): Expand the declarations for the Secondary Dispatch
-   --  Table of Typ associated with Iface (each abstract interface implemented
-   --  by Typ has a secondary dispatch table). The arguments Typ, Ancestor_Typ
-   --  and Suffix_Index are used to generate an unique external name which
-   --  is added at the end of Acc_Disp_Tables; this external name will be
-   --  used later by the subprogram Exp_Ch3.Build_Init_Procedure.
+   procedure Register_Primitive
+     (Loc     : Source_Ptr;
+      Prim    : Entity_Id;
+      Ins_Nod : Node_Id);
+   --  Register Prim in the corresponding 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).
 
    procedure Set_All_DT_Position (Typ : Entity_Id);
    --  Set the DT_Position field for each primitive operation. In the CPP
@@ -324,6 +287,12 @@ package Exp_Disp is
    --  be the default constructor (i.e. the function returning this type,
    --  having a pragma CPP_Constructor and no parameter)
 
+   procedure Set_DTC_Entity_Value
+     (Tagged_Type : Entity_Id;
+      Prim        : Entity_Id);
+   --  Set the definite value of the DTC_Entity value associated with a given
+   --  primitive of a tagged type.
+
    procedure Write_DT (Typ : Entity_Id);
    pragma Export (Ada, Write_DT);
    --  Debugging procedure (to be called within gdb)

gcc/ada/rtsfind.adb

@@ -6,7 +6,7 @@
 --                                                                          --
 --                                 B o d y                                  --
 --                                                                          --
---          Copyright (C) 1992-2006, Free Software Foundation, Inc.         --
+--          Copyright (C) 1992-2007, 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- --
@@ -541,7 +541,15 @@ package body Rtsfind is
          Output_Entity_Name (Id, "not available");
       end if;
 
-      raise RE_Not_Available;
+      --  In configurable run time mode, we raise RE_Not_Available, and we hope
+      --  the caller deals gracefully with this. If we are in normal full run
+      --  time mode, a load failure is considered fatal and unrecoverable.
+
+      if Configurable_Run_Time_Mode then
+         raise RE_Not_Available;
+      else
+         raise Unrecoverable_Error;
+      end if;
    end Load_Fail;
 
    --------------
@@ -683,12 +691,24 @@ package body Rtsfind is
          Set_Analyzed (Cunit (Current_Sem_Unit), True);
 
          if not Analyzed (Cunit (U.Unum)) then
-            Save_Private_Visibility;
-            Semantics (Cunit (U.Unum));
-            Restore_Private_Visibility;
 
-            if Fatal_Error (U.Unum) then
-               Load_Fail ("had semantic errors", U_Id, Id);
+            --  If the unit is already loaded through a limited_with clauses,
+            --  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
+            --  is precisely to avoid such.
+
+            if From_With_Type (Cunit_Entity (U.Unum)) then
+               null;
+
+            else
+               Save_Private_Visibility;
+               Semantics (Cunit (U.Unum));
+               Restore_Private_Visibility;
+
+               if Fatal_Error (U.Unum) then
+                  Load_Fail ("had semantic errors", U_Id, Id);
+               end if;
             end if;
          end if;
 
@@ -891,7 +911,8 @@ package body Rtsfind is
       -----------------------
 
       function Find_Local_Entity (E : RE_Id) return Entity_Id is
-         RE_Str : String renames RE_Id'Image (E);
+         RE_Str : constant String := RE_Id'Image (E);
+         Nam    : Name_Id;
          Ent    : Entity_Id;
 
          Save_Nam : constant String := Name_Buffer (1 .. Name_Len);
@@ -902,7 +923,8 @@ package body Rtsfind is
          Name_Buffer (1 .. Name_Len) :=
            RE_Str (RE_Str'First + 3 .. RE_Str'Last);
 
-         Ent := Entity_Id (Get_Name_Table_Info (Name_Find));
+         Nam := Name_Find;
+         Ent := Entity_Id (Get_Name_Table_Info (Nam));
 
          Name_Len := Save_Nam'Length;
          Name_Buffer (1 .. Name_Len) := Save_Nam;
@@ -956,9 +978,16 @@ package body Rtsfind is
             pragma Assert (Nkind (Lib_Unit) = N_Package_Declaration);
             Ename := RE_Chars (E);
 
-            --  First we search the package entity chain
+            --  First we search the package entity chain. If the package
+            --  only has a limited view, scan the corresponding list of
+            --  incomplete types.
+
+            if From_With_Type (U.Entity) then
+               Pkg_Ent := First_Entity (Limited_View (U.Entity));
+            else
+               Pkg_Ent := First_Entity (U.Entity);
+            end if;
 
-            Pkg_Ent := First_Entity (U.Entity);
             while Present (Pkg_Ent) loop
                if Ename = Chars (Pkg_Ent) then
                   RE_Table (E) := Pkg_Ent;
@@ -1067,6 +1096,7 @@ package body Rtsfind is
       U        : RT_Unit_Table_Record renames RT_Unit_Table (U_Id);
       E1       : Entity_Id;
       Ename    : Name_Id;
+      Found_E  : Entity_Id;
       Lib_Unit : Node_Id;
       Pkg_Ent  : Entity_Id;
 
@@ -1103,13 +1133,15 @@ package body Rtsfind is
       --  Search the entity in the components of record type declarations
       --  found in the package entity chain.
 
+      Found_E := Empty;
       Pkg_Ent := First_Entity (U.Entity);
       Search : while Present (Pkg_Ent) loop
          if Is_Record_Type (Pkg_Ent) then
             E1 := First_Entity (Pkg_Ent);
             while Present (E1) loop
                if Ename = Chars (E1) then
-                  exit Search;
+                  pragma Assert (not Present (Found_E));
+                  Found_E := E1;
                end if;
 
                Next_Entity (E1);
@@ -1157,7 +1189,7 @@ package body Rtsfind is
       end if;
 
       Front_End_Inlining := Save_Front_End_Inlining;
-      return Check_CRT (E, E1);
+      return Check_CRT (E, Found_E);
    end RTE_Record_Component;
 
    ------------------------------------
@@ -1366,6 +1398,12 @@ package body Rtsfind is
             end if;
          end loop;
       end if;
+
+   exception
+      --  Generate error message if run-time unit not available
+
+      when RE_Not_Available =>
+         Error_Msg_N ("& not available", Nam);
    end Text_IO_Kludge;
 
 end Rtsfind;