OpenE2K/gcc
2
0
Fork 0
Code Issues Pull Requests Projects Releases Wiki Activity

[multiple changes]

Browse Source 
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).

From-SVN: r177379
This commit is contained in:
Arnaud Charlet 2011-08-04 15:20:09 +02:00
parent 87729e5ae1
commit 7ae0d98c02
8 changed files with 214 additions and 130 deletions
Show Stats Download Patch File Download Diff File Expand all files Collapse all files

48
gcc/ada/ChangeLog
View File

@ -1,3 +1,51 @@
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.

11
gcc/ada/bindgen.adb
View File

@ -3783,12 +3783,21 @@ package body Bindgen is
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

29
gcc/ada/exp_aggr.adb
View File

@ -5178,6 +5178,33 @@ package body Exp_Aggr is
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
@ -5261,7 +5288,7 @@ package body Exp_Aggr is
-- 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

39
gcc/ada/exp_ch7.adb
View File

@ -3064,15 +3064,10 @@ package body Exp_Ch7 is
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));
@ -3494,12 +3489,6 @@ package body Exp_Ch7 is
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
@ -3515,7 +3504,6 @@ package body Exp_Ch7 is
elsif Scope_Stack.Table (S).Entity = Standard_Standard then
exit;
end if;
end loop;
@ -7228,23 +7216,12 @@ package body Exp_Ch7 is
-- Procedure call or raise statement
begin
-- .NET/JVM runtime: add choice parameter E and pass it to Reraise_
-- Occurrence.
-- 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.
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.
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,

121
gcc/ada/makeutl.adb
View File

@ -1290,7 +1290,6 @@ package body Makeutl is
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.
@ -1346,66 +1345,57 @@ package body Makeutl is
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;
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);
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;
end if;
exit when Suffix /= No_File and then
Name_Buffer (Base_Main'Length + 1 .. Name_Len) =
Get_Name_String (Suffix);
end if;
Next (Iter);
end loop;
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.
Project := Project.Extends;
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 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;
if Source = No_Source then
@ -1496,7 +1486,7 @@ package body Makeutl is
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
@ -1510,29 +1500,6 @@ package body Makeutl is
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
@ -2988,6 +2955,22 @@ package body Makeutl is
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

31
gcc/ada/sinfo.ads
View File

@ -5894,23 +5894,32 @@ package Sinfo is
-- 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.
-- 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.
-- 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 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

3
gcc/ada/tracebak.c
View File

@ -339,7 +339,8 @@ struct layout
#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)

62
gcc/ada/vxaddr2line.adb
View File

@ -6,7 +6,7 @@
-- --
-- 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- --
@ -83,12 +83,17 @@ procedure VxAddr2Line is
-- 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;
@ -114,12 +119,42 @@ procedure VxAddr2Line is
-- 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),
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,
Bt_Offset_From_Call => -2),
SOLARIS_POWERPC =>
(Addr2line_Binary => null,
Nm_Binary => null,
Addr_Digits_To_Skip => 0,
Bt_Offset_From_Call => -4),
WINDOWS_E500V2 =>
(Addr2line_Binary => null,
Nm_Binary => null,
Addr_Digits_To_Skip => 0,
@ -129,21 +164,16 @@ procedure VxAddr2Line is
Nm_Binary => null,
Addr_Digits_To_Skip => 0,
Bt_Offset_From_Call => -2),
SOLARIS_POWERPC =>
WINDOWS_M68K =>
(Addr2line_Binary => null,
Nm_Binary => null,
Addr_Digits_To_Skip => 0,
Bt_Offset_From_Call => 0),
SOLARIS_I586 =>
Bt_Offset_From_Call => -4),
WINDOWS_POWERPC =>
(Addr2line_Binary => null,
Nm_Binary => null,
Addr_Digits_To_Skip => 0,
Bt_Offset_From_Call => -2),
DEC_ALPHA =>
(Addr2line_Binary => null,
Nm_Binary => null,
Addr_Digits_To_Skip => 8,
Bt_Offset_From_Call => 0)
Bt_Offset_From_Call => -4)
);
-- Current architecture