+2013-01-03 Thomas Quinot <quinot@adacore.com>
+
+ * sem_ch7.adb, sem_ch10.adb, einfo.adb, einfo.ads, sem_ch12.adb,
+ rtsfind.adb, sem_elab.adb, sem_ch4.adb, sem_ch8.adb
+ (Einfo.Is_Visible_Child_Unit, Einfo.Set_Is_Visible_Child_Unit):
+ Rename to Is_Visible_Lib_Unit, Set_Is_Visible_Lib_Unit, and
+ update spec accordingly (now also applies to root library units).
+ (Sem_Ch10.Analyze_Subunit.Analyze_Subunit_Context): Toggle above flag
+ on root library units, not only child units.
+ (Sem_Ch10.Install[_Limited]_Withed_Unit): Same.
+ (Sem_Ch10.Remove_Unit_From_Visibility): Reset Is_Visible_Lib_Unit
+ even for root library units.
+ (Sem_Ch8.Find_Expanded_Name): A selected component form whose prefix is
+ Standard is an expanded name for a root library unit.
+
+2013-01-03 Thomas Quinot <quinot@adacore.com>
+
+ * exp_ch3.adb: Minor reformatting.
+
+2013-01-03 Olivier Hainque <hainque@adacore.com>
+
+ * tracebak.c: Reinstate changes to support ppc-lynx178.
+
+2013-01-03 Ed Schonberg <schonberg@adacore.com>
+
+ * atree.ads: Minor reformatting and documentation enhancement.
+
2013-01-03 Ed Schonberg <schonberg@adacore.com>
* exp_ch3.adb (Expand_N_Object_Declaration): If the object has
-- entities point correctly to their original parents. The effect is thus
-- to leave the tree completely unchanged in structure, except that the
-- entity ID values of the two entities are interchanged. Neither of the
- -- two entities may be list members.
+ -- two entities may be list members. Note that entities appear on two
+ -- semantic chains: Homonym and Next_Entity: the corresponding links must
+ -- be adjusted by the caller, according to context.
function Extend_Node (Node : Node_Id) return Entity_Id;
-- This function returns a copy of its input node with an extension added.
-- No_Return Flag113
-- Delay_Cleanups Flag114
-- Never_Set_In_Source Flag115
- -- Is_Visible_Child_Unit Flag116
+ -- Is_Visible_Lib_Unit Flag116
-- Is_Unchecked_Union Flag117
-- Is_For_Access_Subtype Flag118
-- Has_Convention_Pragma Flag119
return Flag127 (Id);
end Is_Valued_Procedure;
- function Is_Visible_Child_Unit (Id : E) return B is
+ function Is_Visible_Lib_Unit (Id : E) return B is
begin
- pragma Assert (Is_Child_Unit (Id));
return Flag116 (Id);
- end Is_Visible_Child_Unit;
+ end Is_Visible_Lib_Unit;
function Is_Visible_Formal (Id : E) return B is
begin
Set_Flag127 (Id, V);
end Set_Is_Valued_Procedure;
- procedure Set_Is_Visible_Child_Unit (Id : E; V : B := True) is
+ procedure Set_Is_Visible_Lib_Unit (Id : E; V : B := True) is
begin
- pragma Assert (Is_Child_Unit (Id));
Set_Flag116 (Id, V);
- end Set_Is_Visible_Child_Unit;
+ end Set_Is_Visible_Lib_Unit;
procedure Set_Is_Visible_Formal (Id : E; V : B := True) is
begin
W ("Is_Unsigned_Type", Flag144 (Id));
W ("Is_VMS_Exception", Flag133 (Id));
W ("Is_Valued_Procedure", Flag127 (Id));
- W ("Is_Visible_Child_Unit", Flag116 (Id));
+ W ("Is_Visible_Lib_Unit", Flag116 (Id));
W ("Is_Visible_Formal", Flag206 (Id));
W ("Is_Volatile", Flag16 (Id));
W ("Itype_Printed", Flag202 (Id));
-- Defined in procedure entities. Set if an Import_Valued_Procedure
-- or Export_Valued_Procedure pragma applies to the procedure entity.
--- Is_Visible_Child_Unit (Flag116)
--- Defined in compilation units that are child units. Once compiled,
--- child units remain chained to the entities in the parent unit, and
--- a separate flag must be used to indicate whether the names are
--- visible by selected notation, or not.
+-- Is_Visible_Lib_Unit (Flag116)
+-- Defined in all (root or child) library unit entities. Once compiled,
+-- library units remain chained to the entities in the parent scope, and
+-- a separate flag must be used to indicate whether the names are visible
+-- by selected notation, or not.
-- Is_Visible_Formal (Flag206)
-- Defined in all entities. Set True for instances of the formals of a
-- Is_Private_Primitive (Flag245) (non-generic case only)
-- Is_Pure (Flag44)
-- Is_Thunk (Flag225)
- -- Is_Visible_Child_Unit (Flag116)
+ -- Is_Visible_Lib_Unit (Flag116)
-- Needs_No_Actuals (Flag22)
-- Requires_Overriding (Flag213) (non-generic case only)
-- Return_Present (Flag54)
-- In_Use (Flag8)
-- Is_Instantiated (Flag126)
-- Is_Private_Descendant (Flag53)
- -- Is_Visible_Child_Unit (Flag116)
+ -- Is_Visible_Lib_Unit (Flag116)
-- Renamed_In_Spec (Flag231) (non-generic case only)
-- Static_Elaboration_Desired (Flag77) (non-generic case only)
-- Is_Wrapper_Package (synth) (non-generic case only)
-- Is_Pure (Flag44)
-- Is_Thunk (Flag225)
-- Is_Valued_Procedure (Flag127)
- -- Is_Visible_Child_Unit (Flag116)
+ -- Is_Visible_Lib_Unit (Flag116)
-- Needs_No_Actuals (Flag22)
-- No_Return (Flag113)
-- Requires_Overriding (Flag213) (non-generic case only)
function Is_Unsigned_Type (Id : E) return B;
function Is_VMS_Exception (Id : E) return B;
function Is_Valued_Procedure (Id : E) return B;
- function Is_Visible_Child_Unit (Id : E) return B;
+ function Is_Visible_Lib_Unit (Id : E) return B;
function Is_Visible_Formal (Id : E) return B;
function Is_Volatile (Id : E) return B;
function Itype_Printed (Id : E) return B;
procedure Set_Is_Unsigned_Type (Id : E; V : B := True);
procedure Set_Is_VMS_Exception (Id : E; V : B := True);
procedure Set_Is_Valued_Procedure (Id : E; V : B := True);
- procedure Set_Is_Visible_Child_Unit (Id : E; V : B := True);
+ procedure Set_Is_Visible_Lib_Unit (Id : E; V : B := True);
procedure Set_Is_Visible_Formal (Id : E; V : B := True);
procedure Set_Is_Volatile (Id : E; V : B := True);
procedure Set_Itype_Printed (Id : E; V : B := True);
pragma Inline (Is_Unsigned_Type);
pragma Inline (Is_VMS_Exception);
pragma Inline (Is_Valued_Procedure);
- pragma Inline (Is_Visible_Child_Unit);
+ pragma Inline (Is_Visible_Lib_Unit);
pragma Inline (Is_Visible_Formal);
pragma Inline (Itype_Printed);
pragma Inline (Kill_Elaboration_Checks);
pragma Inline (Set_Is_Unsigned_Type);
pragma Inline (Set_Is_VMS_Exception);
pragma Inline (Set_Is_Valued_Procedure);
- pragma Inline (Set_Is_Visible_Child_Unit);
+ pragma Inline (Set_Is_Visible_Lib_Unit);
pragma Inline (Set_Is_Visible_Formal);
pragma Inline (Set_Is_Volatile);
pragma Inline (Set_Itype_Printed);
Subtype_Mark => New_Occurrence_Of (Typ, Loc),
Name => Convert_Tag_To_Interface (Typ, Tag_Comp)));
+ -- If the original entity comes from source, then mark the
+ -- new entity as needing debug information, even though it's
+ -- defined by a generated renaming that does not come from
+ -- source, so that Materialize_Entity will be set on the
+ -- entity when Debug_Renaming_Declaration is called during
+ -- analysis.
+
+ if Comes_From_Source (Def_Id) then
+ Set_Debug_Info_Needed (Defining_Identifier (N));
+ end if;
+
Analyze (N, Suppress => All_Checks);
-- Replace internal identifier of rewritten node by the
-- which may be a constant. Preserve entity chain because
-- itypes may have been generated already, and the full
-- chain must be preserved for final freezing. Finally,
- -- Preserve Comes_From_Source setting, so that debugging
+ -- preserve Comes_From_Source setting, so that debugging
-- and cross-referencing information is properly kept.
declare
begin
Set_Next_Entity (New_Id, Next_Entity (Def_Id));
Set_Next_Entity (Def_Id, Next_Temp);
- Set_Chars (Defining_Identifier (N), Chars (Def_Id));
+
+ Set_Chars (Defining_Identifier (N), Chars (Def_Id));
Set_Homonym (Defining_Identifier (N), Homonym (Def_Id));
- Set_Ekind (Defining_Identifier (N), Ekind (Def_Id));
+ Set_Ekind (Defining_Identifier (N), Ekind (Def_Id));
+
Set_Comes_From_Source (Def_Id, False);
Exchange_Entities (Defining_Identifier (N), Def_Id);
Set_Comes_From_Source (Def_Id, S_Flag);
end if;
Load_RTU (To_Load, Use_Setting => In_Use (Cunit_Entity (U)));
- Set_Is_Visible_Child_Unit (RT_Unit_Table (To_Load).Entity);
+ Set_Is_Visible_Lib_Unit (RT_Unit_Table (To_Load).Entity);
-- Prevent creation of an implicit 'with' from (for example)
-- Ada.Wide_Text_IO.Integer_IO to Ada.Text_IO.Integer_IO,
end if;
Unit_Name := Entity (Name (Item));
- while Is_Child_Unit (Unit_Name) loop
- Set_Is_Visible_Child_Unit (Unit_Name);
+ loop
+ Set_Is_Visible_Lib_Unit (Unit_Name);
+ exit when Scope (Unit_Name) = Standard_Standard;
Unit_Name := Scope (Unit_Name);
+
+ if No (Unit_Name) then
+ Check_Error_Detected;
+ return;
+ end if;
end loop;
if not Is_Immediately_Visible (Unit_Name) then
and then not Error_Posted (Item)
then
Unit_Name := Entity (Name (Item));
- while Is_Child_Unit (Unit_Name) loop
- Set_Is_Visible_Child_Unit (Unit_Name, False);
+ loop
+ Set_Is_Visible_Lib_Unit (Unit_Name, False);
+ exit when Scope (Unit_Name) = Standard_Standard;
Unit_Name := Scope (Unit_Name);
end loop;
E := First_Entity (Current_Scope);
while Present (E) loop
if not Is_Child_Unit (E)
- or else Is_Visible_Child_Unit (E)
+ or else Is_Visible_Lib_Unit (E)
then
Set_Is_Immediately_Visible (E);
end if;
C : Entity_Id;
begin
C := Current_Scope;
- while Present (C)
- and then Is_Child_Unit (C)
- loop
+ while Present (C) and then C /= Standard_Standard loop
Set_Is_Immediately_Visible (C);
- Set_Is_Visible_Child_Unit (C);
+ Set_Is_Visible_Lib_Unit (C);
C := Scope (C);
end loop;
end;
end In_Context;
begin
- Set_Is_Visible_Child_Unit (Id, In_Context);
+ Set_Is_Visible_Lib_Unit (Id, In_Context);
end;
end if;
end if;
if Analyzed (P_Unit)
and then
(Is_Immediately_Visible (P)
- or else (Is_Child_Package and then Is_Visible_Child_Unit (P)))
+ or else (Is_Child_Package and then Is_Visible_Lib_Unit (P)))
then
-- The presence of both the limited and the analyzed nonlimited view
Set_Ekind (P, E_Package);
Set_Etype (P, Standard_Void_Type);
Set_Scope (P, Standard_Standard);
+ Set_Is_Visible_Lib_Unit (P);
if Is_Child_Package then
Set_Is_Child_Unit (P);
- Set_Is_Visible_Child_Unit (P);
Set_Scope (P, Defining_Entity (Unit (Parent_Spec (P_Unit))));
end if;
Error_Msg_N
("instantiation depends on itself", Name (With_Clause));
- elsif not Is_Visible_Child_Unit (Uname) then
+ elsif not Is_Visible_Lib_Unit (Uname) then
-- Abandon processing in case of previous errors
return;
end if;
- Set_Is_Visible_Child_Unit (Uname);
+ Set_Is_Visible_Lib_Unit (Uname);
-- If the child unit appears in the context of its parent, it is
-- immediately visible.
-- Set flag as well on the visible entity that denotes the
-- instance, which renames the current one.
- Set_Is_Visible_Child_Unit
+ Set_Is_Visible_Lib_Unit
(Related_Instance
(Defining_Entity (Unit (Library_Unit (With_Clause)))));
end if;
end if;
elsif not Is_Immediately_Visible (Uname) then
+ Set_Is_Visible_Lib_Unit (Uname);
if not Private_Present (With_Clause)
or else Private_With_OK
then
-- not apply the check to the Standard package itself.
if Is_Child_Unit (Uname)
- and then Is_Visible_Child_Unit (Uname)
+ and then Is_Visible_Lib_Unit (Uname)
and then Ada_Version >= Ada_2005
then
declare
Decl2 := Unit_Declaration_Node (P2);
if Is_Child_Unit (U2)
- and then Is_Visible_Child_Unit (U2)
+ and then Is_Visible_Lib_Unit (U2)
then
if Is_Generic_Instance (P)
and then Nkind (Decl1) = N_Package_Declaration
---------------------------------
procedure Remove_Unit_From_Visibility (Unit_Name : Entity_Id) is
- P : constant Entity_Id := Scope (Unit_Name);
-
begin
if Debug_Flag_I then
Write_Str ("remove unit ");
Write_Eol;
end if;
- if P /= Standard_Standard then
- Set_Is_Visible_Child_Unit (Unit_Name, False);
- end if;
-
+ Set_Is_Visible_Lib_Unit (Unit_Name, False);
Set_Is_Potentially_Use_Visible (Unit_Name, False);
Set_Is_Immediately_Visible (Unit_Name, False);
and then Is_Child_Unit (E)
then
if Is_Child_Unit (E)
- and then not Is_Visible_Child_Unit (E)
+ and then not Is_Visible_Lib_Unit (E)
then
Error_Msg_NE
("generic child unit& is not visible", Gen_Id, E);
(Is_Immediately_Visible (Scope (DT))
or else
(Is_Child_Unit (Scope (DT))
- and then Is_Visible_Child_Unit (Scope (DT))))
+ and then Is_Visible_Lib_Unit (Scope (DT))))
then
Set_Etype (N, Available_View (DT));
(Is_Immediately_Visible (Scope (Typ))
or else
(Is_Child_Unit (Scope (Typ))
- and then Is_Visible_Child_Unit (Scope (Typ))))
+ and then Is_Visible_Lib_Unit (Scope (Typ))))
then
return Available_View (Typ);
else
if Is_Child_Unit (Id) then
Set_Is_Potentially_Use_Visible
- (Id, Is_Visible_Child_Unit (Id));
+ (Id, Is_Visible_Lib_Unit (Id));
else
Set_Is_Potentially_Use_Visible (Id);
end if;
end if;
if Is_New_Candidate then
- if Is_Child_Unit (Id) then
- exit when Is_Visible_Child_Unit (Id)
+ if Is_Child_Unit (Id) or else P_Name = Standard_Standard then
+ exit when Is_Visible_Lib_Unit (Id)
or else Is_Immediately_Visible (Id);
else
and then Is_Compilation_Unit (Homonym (P_Name))
and then
(Is_Immediately_Visible (Homonym (P_Name))
- or else Is_Visible_Child_Unit (Homonym (P_Name)))
+ or else Is_Visible_Lib_Unit (Homonym (P_Name)))
then
declare
H : constant Entity_Id := Homonym (P_Name);
if Is_Child_Unit (E) then
if not From_With_Type (E) then
Set_Is_Immediately_Visible (E,
- Is_Visible_Child_Unit (E) or else In_Open_Scopes (E));
+ Is_Visible_Lib_Unit (E) or else In_Open_Scopes (E));
else
pragma Assert
while Present (E) loop
if Is_Child_Unit (E) then
Set_Is_Immediately_Visible (E,
- Is_Visible_Child_Unit (E) or else In_Open_Scopes (E));
+ Is_Visible_Lib_Unit (E) or else In_Open_Scopes (E));
end if;
Next_Entity (E);
if not Is_Hidden (Id)
and then ((not Is_Child_Unit (Id))
- or else Is_Visible_Child_Unit (Id))
+ or else Is_Visible_Lib_Unit (Id))
then
Set_Is_Potentially_Use_Visible (Id);
while Present (Id) loop
if Is_Child_Unit (Id)
- and then Is_Visible_Child_Unit (Id)
+ and then Is_Visible_Lib_Unit (Id)
then
Set_Is_Potentially_Use_Visible (Id);
end if;
-- visible, and we can set the elaboration flag.
if Is_Immediately_Visible (Scop)
- or else (Is_Child_Unit (Scop) and then Is_Visible_Child_Unit (Scop))
+ or else (Is_Child_Unit (Scop) and then Is_Visible_Lib_Unit (Scop))
then
Activate_Elaborate_All_Desirable (Call, Scop);
Set_Suppress_Elaboration_Warnings (Scop, True);
PowerPC/AiX
PowerPC/Darwin
PowerPC/VxWorks
+ PowerPC/LynxOS-178
SPARC/Solaris
i386/GNU/Linux
i386/Solaris
#error Unhandled darwin architecture.
#endif
-/*------------------------ PPC AIX/Older Darwin -------------------------*/
+/*---------------------- PPC AIX/PPC Lynx 178/Older Darwin ------------------*/
#elif ((defined (_POWER) && defined (_AIX)) || \
-(defined (__ppc__) && defined (__APPLE__)))
+ (defined (__powerpc__) && defined (__Lynx__) && !defined(__ELF__)) || \
+ (defined (__ppc__) && defined (__APPLE__)))
#define USE_GENERIC_UNWINDER
should to feature a null backchain, AIX might expose a null return
address instead. */
+/* Then LynxOS-178 features yet another variation, with return_address
+ == &<entrypoint>, with two possible entry points (one for the main
+ process and one for threads). Beware that &bla returns the address
+ of a descriptor when "bla" is a function. Getting the code address
+ requires an extra dereference. */
+
+#if defined (__Lynx__)
+extern void __start(); /* process entry point. */
+extern void __runnit(); /* thread entry point. */
+#define EXTRA_STOP_CONDITION(CURRENT) \
+ ((CURRENT)->return_address == *(void**)&__start \
+ || (CURRENT)->return_address == *(void**)&__runnit)
+#else
+#define EXTRA_STOP_CONDITION(CURRENT) (0)
+#endif
+
#define STOP_FRAME(CURRENT, TOP_STACK) \
(((void *) (CURRENT) < (TOP_STACK)) \
- || (CURRENT)->return_address == NULL)
+ || (CURRENT)->return_address == NULL \
+ || EXTRA_STOP_CONDITION(CURRENT))
/* The PPC ABI has an interesting specificity: the return address saved by a
function is located in it's caller's frame, and the save operation only
projects / platform / upstream / gcc.git / commitdiff