+2011-08-04 Hristian Kirtchev <kirtchev@adacore.com>
+
+ * exp_ch7.adb (Build_Raise_Statement): Remove the specialized
+ processing for .NET/JVM. These targets can now benefit from
+ Raise_From_Controlled_Operation and they share the same processing with
+ standard targets.
+ (Establish_Transient_Scope): Remove the restriction for .NET/JVM.
+ These targets need transient scopes in order to properly finalize short
+ lived controlled objects.
+ (Make_Handler_For_Ctrl_Operation): Remove the specialized processing for
+ NET/JVM. These targets can now benefit from
+ Raise_From_Controlled_Operation and they share the same processing with
+ standard targets.
+
+2011-08-04 Geert Bosch <bosch@adacore.com>
+
+ * tracebak.c (STOP_FRAME): Stop at any next pointer outside the stack
+
+2011-08-04 Ed Schonberg <schonberg@adacore.com>
+
+ * exp_aggr.adb (Has_Visible_Private_Ancestor): subsidiary routine to
+ Expand_Record_Aggregate, to determine whether aggregate must be
+ expanded into assignments. This is the case if the ancestor part is
+ private, regarless of the setting of the flag Has_Private_Ancestor.
+
+2011-08-04 Ed Falis <falis@adacore.com>
+
+ * vxaddr2line.adb: Add support for e500v2 and for Linux hosts
+
+2011-08-04 Bob Duff <duff@adacore.com>
+
+ * sinfo.ads: Fix comment.
+
+2011-08-04 Steve Baird <baird@adacore.com>
+
+ * bindgen.adb (Get_Ada_Main_Name): If CodePeer_Mode is set, then
+ choose a package name in much the same way as is
+ done for JGNAT when VM_Target /= No_VM, except that
+ a slightly more distinctive prefix string is used.
+
+2011-08-04 Emmanuel Briot <briot@adacore.com>
+
+ * makeutl.adb (Complete_Mains): no longer accept unit names on the
+ gnatmake command line.
+ This behavior was never documented (and was supported only because of
+ an early bug in the code). This case might lead to ambiguous cases
+ (between unit names and truncated base names without suffixes).
+
2011-08-04 Hristian Kirtchev <kirtchev@adacore.com>
* a-tags.ads, a-tags.adb (Unregister_Tag): New routine.
begin
-- The main program generated by JGNAT expects a package called
-- ada_<main procedure>.
-
if VM_Target /= No_VM then
Get_Name_String (Units.Table (First_Unit_Entry).Uname);
return "ada_" & Get_Main_Unit_Name (Name_Buffer (1 .. Name_Len - 2));
end if;
+ -- For CodePeer, we want reproducible names (independent of other
+ -- mains that may or may not be present) that don't collide
+ -- when analyzing multiple mains and which are easily recognizable
+ -- as "ada_main" names.
+ if CodePeer_Mode then
+ Get_Name_String (Units.Table (First_Unit_Entry).Uname);
+ return "ada_main_for_" &
+ Get_Main_Unit_Name (Name_Buffer (1 .. Name_Len - 2));
+ end if;
+
-- This loop tries the following possibilities in order
-- <Ada_Main>
-- <Ada_Main>_01
Comp : Entity_Id;
New_Comp : Node_Id;
+ function Has_Visible_Private_Ancestor (Id : E) return Boolean;
+ -- If any ancestor of the current type is private, the aggregate
+ -- cannot be built in place. We canot rely on Has_Private_Ancestor,
+ -- because it will not be set when type and its parent are in the
+ -- same scope, and the parent component needs expansion.
+
+ -----------------------------------
+ -- Has_Visible_Private_Ancestor --
+ -----------------------------------
+
+ function Has_Visible_Private_Ancestor (Id : E) return Boolean is
+ R : constant Entity_Id := Root_Type (Id);
+ T1 : Entity_Id := Id;
+ begin
+ loop
+ if Is_Private_Type (T1) then
+ return True;
+
+ elsif T1 = R then
+ return False;
+
+ else
+ T1 := Etype (T1);
+ end if;
+ end loop;
+ end Has_Visible_Private_Ancestor;
+
-- Start of processing for Expand_Record_Aggregate
begin
-- If an ancestor is private, some components are not inherited and
-- we cannot expand into a record aggregate
- elsif Has_Private_Ancestor (Typ) then
+ elsif Has_Visible_Private_Ancestor (Typ) then
Convert_To_Assignments (N, Typ);
-- ??? The following was done to compile fxacc00.ads in the ACVCs. Gigi
Params := New_List (New_Reference_To (E_Id, Loc));
- -- .NET/JVM
+ -- Standard run-time, .NET/JVM targets, this case handles finalization
+ -- exceptions raised during an abort.
- if VM_Target /= No_VM then
- Proc_Id := RTE (RE_Reraise_Occurrence);
-
- -- Standard run-time library, this case handles finalization exceptions
- -- raised during an abort.
-
- elsif RTE_Available (RE_Raise_From_Controlled_Operation) then
+ if RTE_Available (RE_Raise_From_Controlled_Operation) then
Proc_Id := RTE (RE_Raise_From_Controlled_Operation);
Append_To (Params, New_Reference_To (Abort_Id, Loc));
Wrap_Node : Node_Id;
begin
- -- Nothing to do for virtual machines where memory is GCed
-
- if VM_Target /= No_VM then
- return;
- end if;
-
-- Do not create a transient scope if we are already inside one
for S in reverse Scope_Stack.First .. Scope_Stack.Last loop
elsif Scope_Stack.Table (S).Entity = Standard_Standard then
exit;
-
end if;
end loop;
-- Procedure call or raise statement
begin
- -- .NET/JVM runtime: add choice parameter E and pass it to Reraise_
- -- Occurrence.
-
- if VM_Target /= No_VM then
- E_Occ := Make_Defining_Identifier (Loc, Name_E);
- Raise_Node :=
- Make_Procedure_Call_Statement (Loc,
- Name =>
- New_Reference_To (RTE (RE_Reraise_Occurrence), Loc),
- Parameter_Associations => New_List (
- New_Reference_To (E_Occ, Loc)));
-
- -- Standard runtime: add choice parameter E and pass it to Raise_From_
- -- Controlled_Operation so that the original exception name and message
- -- can be recorded in the exception message for Program_Error.
+ -- Standard runtime, .NET/JVM targets: add choice parameter E and pass
+ -- it to Raise_From_Controlled_Operation so that the original exception
+ -- name and message can be recorded in the exception message for
+ -- Program_Error.
- elsif RTE_Available (RE_Raise_From_Controlled_Operation) then
+ if RTE_Available (RE_Raise_From_Controlled_Operation) then
E_Occ := Make_Defining_Identifier (Loc, Name_E);
Raise_Node :=
Make_Procedure_Call_Statement (Loc,
function Find_File_Add_Extension
(Tree : Project_Tree_Ref;
- Root_Project : Project_Id;
Base_Main : String) return Prj.Source_Id;
-- Search for Main in the project, adding body or spec extensions.
function Find_File_Add_Extension
(Tree : Project_Tree_Ref;
- Root_Project : Project_Id;
Base_Main : String) return Prj.Source_Id
is
Spec_Source : Prj.Source_Id := No_Source;
Source : Prj.Source_Id;
- Project : Project_Id;
Iter : Source_Iterator;
Suffix : File_Name_Type;
begin
Source := No_Source;
- Project := Root_Project;
- while Source = No_Source
- and then Project /= No_Project
+ Iter := For_Each_Source (Tree); -- In all projects
loop
- Iter := For_Each_Source (Tree, Project);
- loop
- Source := Prj.Element (Iter);
- exit when Source = No_Source;
+ Source := Prj.Element (Iter);
+ exit when Source = No_Source;
- if Source.Kind = Impl then
- Get_Name_String (Source.File);
+ if Source.Kind = Impl then
+ Get_Name_String (Source.File);
- if Name_Len > Base_Main'Length
- and then Name_Buffer (1 .. Base_Main'Length) = Base_Main
- then
- Suffix :=
- Source.Language.Config.Naming_Data.Body_Suffix;
+ if Name_Len > Base_Main'Length
+ and then Name_Buffer (1 .. Base_Main'Length) = Base_Main
+ then
+ Suffix :=
+ Source.Language.Config.Naming_Data.Body_Suffix;
- exit when Suffix /= No_File and then
- Name_Buffer (Base_Main'Length + 1 .. Name_Len) =
- Get_Name_String (Suffix);
- end if;
+ exit when Suffix /= No_File and then
+ Name_Buffer (Base_Main'Length + 1 .. Name_Len) =
+ Get_Name_String (Suffix);
+ end if;
- elsif Source.Kind = Spec then
- -- A spec needs to be taken into account unless there is
- -- also a body. So we delay the decision for them.
+ elsif Source.Kind = Spec then
+ -- A spec needs to be taken into account unless there is
+ -- also a body. So we delay the decision for them.
- Get_Name_String (Source.File);
+ Get_Name_String (Source.File);
- if Name_Len > Base_Main'Length
- and then Name_Buffer (1 .. Base_Main'Length) = Base_Main
- then
- Suffix :=
- Source.Language.Config.Naming_Data.Spec_Suffix;
+ if Name_Len > Base_Main'Length
+ and then Name_Buffer (1 .. Base_Main'Length) = Base_Main
+ then
+ Suffix :=
+ Source.Language.Config.Naming_Data.Spec_Suffix;
- if Suffix /= No_File
- and then
- Name_Buffer (Base_Main'Length + 1 .. Name_Len) =
- Get_Name_String (Suffix)
- then
- Spec_Source := Source;
- end if;
+ if Suffix /= No_File
+ and then
+ Name_Buffer (Base_Main'Length + 1 .. Name_Len) =
+ Get_Name_String (Suffix)
+ then
+ Spec_Source := Source;
end if;
end if;
+ end if;
- Next (Iter);
- end loop;
-
- Project := Project.Extends;
+ Next (Iter);
end loop;
if Source = No_Source then
if Source = No_Source then
Source := Find_File_Add_Extension
- (Tree, File.Project, Get_Name_String (Main_Id));
+ (Tree, Get_Name_String (Main_Id));
end if;
if Is_Absolute
Source := No_Source;
end if;
- if Source = No_Source
- and then not Is_Absolute
- then
-
- -- Still not found? Maybe we have a unit name
-
- declare
- Unit : constant Unit_Index :=
- Units_Htable.Get
- (File.Tree.Units_HT,
- Name_Id (Main_Id));
-
- begin
- if Unit /= No_Unit_Index then
- Source := Unit.File_Names (Impl);
-
- if Source = No_Source then
- Source := Unit.File_Names (Spec);
- end if;
- end if;
- end;
- end if;
-
if Source /= No_Source then
-- If we have found a multi-unit source file but
Shared => Project_Tree.Shared,
Force_Lower_Case_Index => False,
Allow_Wildcards => True);
+
+ -- If not found, try without extension.
+ -- That's because gnatmake accepts truncated file names
+ -- in Builder'Switches
+
+ if Switches_For_Main = Nil_Variable_Value
+ and then Source.Unit /= null
+ then
+ Switches_For_Main := Value_Of
+ (Name => Source.Unit.Name,
+ Attribute_Or_Array_Name => Name_Switches,
+ In_Package => Builder_Package,
+ Shared => Project_Tree.Shared,
+ Force_Lower_Case_Index => False,
+ Allow_Wildcards => True);
+ end if;
end if;
if Index = 1 then
-- used only internally currently, but is considered to be syntactic.
-- At the moment, the only cleanup action allowed is a single call to
-- a parameterless procedure, and the Identifier field of the node is
- -- the procedure to be called. Also there is a current restriction
- -- that exception handles and a cleanup cannot be present in the same
- -- frame, so at least one of Exception_Handlers or the Identifier must
- -- be missing.
-
- -- Actually, more accurately, this restriction applies to the original
- -- source program. In the expanded tree, if the At_End_Proc field is
- -- present, then there will also be an exception handler of the form:
+ -- the procedure to be called. The cleanup action occurs whenever the
+ -- sequence of statements is left for any reason. The possible reasons
+ -- are:
+ -- 1. reaching the end of the sequence
+ -- 2. exit, return, or goto
+ -- 3. exception or abort
+ -- For some back ends, such as gcc with ZCX, "at end" is implemented
+ -- entirely in the back end. In this case, a handled sequence of
+ -- statements with an "at end" cannot also have exception handlers.
+ -- For other back ends, such as gcc with SJLJ and .NET, the
+ -- implementation is split between the front end and back end; the front
+ -- end implements 3, and the back end implements 1 and 2. In this case,
+ -- if there is an "at end", the front end inserts the appropriate
+ -- exception handler, and this handler takes precedence over "at end"
+ -- in case of exception.
+
+ -- The inserted exception handler is of the form:
-- when all others =>
-- cleanup;
-- raise;
- -- where cleanup is the procedure to be generated. The reason we do
- -- this is so that the front end can handle the necessary entries in
- -- the exception tables, and other exception handler actions required
- -- as part of the normal handling for exception handlers.
+ -- where cleanup is the procedure to be called. The reason we do this is
+ -- so that the front end can handle the necessary entries in the
+ -- exception tables, and other exception handler actions required as
+ -- part of the normal handling for exception handlers.
-- The AT END cleanup handler protects only the sequence of statements
-- (not the associated declarations of the parent), just like exception
#define STOP_FRAME(CURRENT, TOP_STACK) \
(IS_BAD_PTR((long)(CURRENT)) \
|| IS_BAD_PTR((long)(CURRENT)->return_address) \
- || (CURRENT)->return_address == 0|| (CURRENT)->next == 0 \
+ || (CURRENT)->return_address == 0 \
+ || (void *) ((CURRENT)->next) < (TOP_STACK) \
|| (void *) (CURRENT) < (TOP_STACK))
#define BASE_SKIP (1+FRAME_LEVEL)
-- --
-- B o d y --
-- --
--- Copyright (C) 2002-2009, AdaCore --
+-- Copyright (C) 2002-2011, AdaCore --
-- --
-- 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- --
-- All supported architectures
type Architecture is
- (SOLARIS_I586,
- WINDOWS_POWERPC,
+ (DEC_ALPHA,
+ LINUX_E500V2,
+ LINUX_I586,
+ LINUX_POWERPC,
+ WINDOWS_E500V2,
WINDOWS_I586,
WINDOWS_M68K,
- SOLARIS_POWERPC,
- DEC_ALPHA);
+ WINDOWS_POWERPC,
+ SOLARIS_E500V2,
+ SOLARIS_I586,
+ SOLARIS_POWERPC);
type Arch_Record is record
Addr2line_Binary : String_Access;
-- Configuration for each of the architectures
Arch_List : array (Architecture'Range) of Arch_Record :=
- (WINDOWS_POWERPC =>
+ (DEC_ALPHA =>
+ (Addr2line_Binary => null,
+ Nm_Binary => null,
+ Addr_Digits_To_Skip => 8,
+ Bt_Offset_From_Call => 0),
+ LINUX_E500V2 =>
(Addr2line_Binary => null,
Nm_Binary => null,
Addr_Digits_To_Skip => 0,
Bt_Offset_From_Call => -4),
- WINDOWS_M68K =>
+ LINUX_I586 =>
+ (Addr2line_Binary => null,
+ Nm_Binary => null,
+ Addr_Digits_To_Skip => 0,
+ Bt_Offset_From_Call => -2),
+ LINUX_POWERPC =>
(Addr2line_Binary => null,
Nm_Binary => null,
Addr_Digits_To_Skip => 0,
Bt_Offset_From_Call => -4),
- WINDOWS_I586 =>
+ SOLARIS_E500V2 =>
+ (Addr2line_Binary => null,
+ Nm_Binary => null,
+ Addr_Digits_To_Skip => 0,
+ Bt_Offset_From_Call => -4),
+ SOLARIS_I586 =>
(Addr2line_Binary => null,
Nm_Binary => null,
Addr_Digits_To_Skip => 0,
(Addr2line_Binary => null,
Nm_Binary => null,
Addr_Digits_To_Skip => 0,
- Bt_Offset_From_Call => 0),
- SOLARIS_I586 =>
+ Bt_Offset_From_Call => -4),
+ WINDOWS_E500V2 =>
+ (Addr2line_Binary => null,
+ Nm_Binary => null,
+ Addr_Digits_To_Skip => 0,
+ Bt_Offset_From_Call => -4),
+ WINDOWS_I586 =>
(Addr2line_Binary => null,
Nm_Binary => null,
Addr_Digits_To_Skip => 0,
Bt_Offset_From_Call => -2),
- DEC_ALPHA =>
+ WINDOWS_M68K =>
(Addr2line_Binary => null,
Nm_Binary => null,
- Addr_Digits_To_Skip => 8,
- Bt_Offset_From_Call => 0)
+ Addr_Digits_To_Skip => 0,
+ Bt_Offset_From_Call => -4),
+ WINDOWS_POWERPC =>
+ (Addr2line_Binary => null,
+ Nm_Binary => null,
+ Addr_Digits_To_Skip => 0,
+ Bt_Offset_From_Call => -4)
);
-- Current architecture
projects / gcc.git / commitdiff