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

[multiple changes] 

2011-08-03  Olivier Hainque  <hainque@adacore.com>

	* tracebak.c (STOP_FRAME ppc AIX): Stop at null return address as well.

2011-08-03  Ed Schonberg  <schonberg@adacore.com>

	* sem_ch8.adb (Analyze_Object_Renaming): if the renamed object is an
	explicit dereference of an unconstrained type, create a constrained
	subtype for it, as is done for function calls that return an
	unconstrained type.

2011-08-03  Thomas Quinot  <quinot@adacore.com>

	* g-pehage.adb (Finalize): Avoid possible double-free.

2011-08-03  Steve Baird  <baird@adacore.com>

	* exp_attr.adb (Expand_N_Attribute_Reference): Don't expand
	Elab_Spec/Body attrs in CodePeer_Mode.

2011-08-03  Javier Miranda  <miranda@adacore.com>

	* exp_aggr.adb (Flatten): Convert to positional form aggregates whose
	low bound is not known at compile time but they have no others choice.
	Done because in this case the bounds can be obtained directly from the
	aggregate.

2011-08-03  Ed Falis  <falis@adacore.com>

	* s-tasinf-vxworks.ads: Update comment to reflect 0 indexing of CPUs
	on VxWorks SMP. Remove unusable constant ANY_CPU.

From-SVN: r177242
This commit is contained in:
Arnaud Charlet 2011-08-03 10:32:57 +02:00
parent a96ca6001f
commit 3f5a8feea3
7 changed files with 151 additions and 46 deletions
Show Stats Download Patch File Download Diff File Expand all files Collapse all files

32
gcc/ada/ChangeLog
View File

@ -1,3 +1,35 @@
2011-08-03 Olivier Hainque <hainque@adacore.com>
* tracebak.c (STOP_FRAME ppc AIX): Stop at null return address as well.
2011-08-03 Ed Schonberg <schonberg@adacore.com>
* sem_ch8.adb (Analyze_Object_Renaming): if the renamed object is an
explicit dereference of an unconstrained type, create a constrained
subtype for it, as is done for function calls that return an
unconstrained type.
2011-08-03 Thomas Quinot <quinot@adacore.com>
* g-pehage.adb (Finalize): Avoid possible double-free.
2011-08-03 Steve Baird <baird@adacore.com>
* exp_attr.adb (Expand_N_Attribute_Reference): Don't expand
Elab_Spec/Body attrs in CodePeer_Mode.
2011-08-03 Javier Miranda <miranda@adacore.com>
* exp_aggr.adb (Flatten): Convert to positional form aggregates whose
low bound is not known at compile time but they have no others choice.
Done because in this case the bounds can be obtained directly from the
aggregate.
2011-08-03 Ed Falis <falis@adacore.com>
* s-tasinf-vxworks.ads: Update comment to reflect 0 indexing of CPUs
on VxWorks SMP. Remove unusable constant ANY_CPU.
2011-08-03 Emmanuel Briot <briot@adacore.com>
* gnatcmd.adb, make.adb, prj-part.adb, prj-part.ads, prj-makr.adb,

40
gcc/ada/exp_aggr.adb
View File

@ -3825,6 +3825,8 @@ package body Exp_Aggr is
Lov : Uint;
Hiv : Uint;
Others_Present : Boolean := False;
begin
if Nkind (Original_Node (N)) = N_String_Literal then
return True;
@ -3839,8 +3841,44 @@ package body Exp_Aggr is
Lov := Expr_Value (Lo);
Hiv := Expr_Value (Hi);
-- Check if there is an others choice
if Present (Component_Associations (N)) then
declare
Assoc : Node_Id;
Choice : Node_Id;
begin
Assoc := First (Component_Associations (N));
while Present (Assoc) loop
Choice := First (Choices (Assoc));
while Present (Choice) loop
if Nkind (Choice) = N_Others_Choice then
Others_Present := True;
end if;
Next (Choice);
end loop;
Next (Assoc);
end loop;
end;
end if;
-- If the low bound is not known at compile time and others is not
-- present we can proceed since the bounds can be obtained from the
-- aggregate.
-- Note: This case is required in VM platforms since their backends
-- normalize array indexes in the range 0 .. N-1. Hence, if we do
-- not flat an array whose bounds cannot be obtained from the type
-- of the index the backend has no way to properly generate the code.
-- See ACATS c460010 for an example.
if Hiv < Lov
or else not Compile_Time_Known_Value (Blo)
or else (not Compile_Time_Known_Value (Blo)
and then Others_Present)
then
return False;
end if;

9
gcc/ada/exp_attr.adb
View File

@ -6,7 +6,7 @@
-- --
-- B o d y --
-- --
-- Copyright (C) 1992-2010, Free Software Foundation, Inc. --
-- Copyright (C) 1992-2011, 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- --
@ -1808,6 +1808,13 @@ package body Exp_Attr is
when Attribute_Elab_Body |
Attribute_Elab_Spec =>
-- Leave attribute unexpanded in CodePeer mode: the gnat2scil
-- back-end knows how to handle this attribute directly.
if CodePeer_Mode then
return;
end if;
Elab_Body : declare
Ent : constant Entity_Id := Make_Temporary (Loc, 'E');
Str : String_Id;

28
gcc/ada/g-pehage.adb
View File

@ -6,7 +6,7 @@
-- --
-- B o d y --
-- --
-- Copyright (C) 2002-2010, 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- --
@ -103,7 +103,7 @@ package body GNAT.Perfect_Hash_Generators is
No_Table : constant Table_Id := -1;
type Word_Type is new String_Access;
procedure Free_Word (W : in out Word_Type);
procedure Free_Word (W : in out Word_Type) renames Free;
function New_Word (S : String) return Word_Type;
procedure Resize_Word (W : in out Word_Type; Len : Natural);
@ -913,8 +913,14 @@ package body GNAT.Perfect_Hash_Generators is
-- ones) to avoid memory leaks.
for W in 0 .. WT.Last loop
Free_Word (WT.Table (W));
-- Note: WT.Table (NK) is a temporary variable, do not free it since
-- this would cause a double free.
if W /= NK then
Free_Word (WT.Table (W));
end if;
end loop;
WT.Release;
IT.Release;
@ -948,17 +954,6 @@ package body GNAT.Perfect_Hash_Generators is
Min_Key_Len := 0;
end Finalize;
---------------
-- Free_Word --
---------------
procedure Free_Word (W : in out Word_Type) is
begin
if W /= null then
Free (W);
end if;
end Free_Word;
----------------------------
-- Generate_Mapping_Table --
----------------------------
@ -1258,6 +1253,11 @@ package body GNAT.Perfect_Hash_Generators is
-- explicitly initialized to null.
WT.Set_Last (Reduced (NK - 1));
-- Note: Reduced (0) = NK + 1
WT.Table (NK) := null;
for W in 0 .. NK - 1 loop
WT.Table (Reduced (W)) := null;
end loop;

7
gcc/ada/s-tasinf-vxworks.ads
View File

@ -6,7 +6,7 @@
-- --
-- S p e c --
-- --
-- Copyright (C) 1992-2009, Free Software Foundation, Inc. --
-- Copyright (C) 1992-2011, 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- --
@ -76,10 +76,7 @@ package System.Task_Info is
------------------
subtype Task_Info_Type is Interfaces.C.int;
-- This is a CPU number (positive)
Any_CPU : constant Task_Info_Type := 0;
-- Allow task to run on any CPU
-- This is a CPU number (natural - CPUs are 0-indexed on VxWorks)
use type Interfaces.C.int;

72
gcc/ada/sem_ch8.adb
View File

@ -688,9 +688,55 @@ package body Sem_Ch8 is
T : Entity_Id;
T2 : Entity_Id;
procedure Check_Constrained_Object;
-- If the nominal type is unconstrained but the renamed object is
-- constrained, as can happen with renaming an explicit dereference or
-- a function return, build a constrained subtype from the object. If
-- the renaming is for a formal in an accept statement, the analysis
-- has already established its actual subtype. This is only relevant
-- if the renamed object is an explicit dereference.
function In_Generic_Scope (E : Entity_Id) return Boolean;
-- Determine whether entity E is inside a generic cope
------------------------------
-- Check_Constrained_Object --
------------------------------
procedure Check_Constrained_Object is
Loc : constant Source_Ptr := Sloc (N);
Subt : Entity_Id;
begin
if (Nkind (Nam) = N_Function_Call
or else Nkind (Nam) = N_Explicit_Dereference)
and then Is_Composite_Type (Etype (Nam))
and then not Is_Constrained (Etype (Nam))
and then not Has_Unknown_Discriminants (Etype (Nam))
and then Expander_Active
then
-- If Actual_Sbutype is already set, nothing to do.
if (Ekind (Id) = E_Variable
or else Ekind (Id) = E_Constant)
and then Present (Actual_Subtype (Id))
then
null;
else
Subt := Make_Temporary (Loc, 'T');
Remove_Side_Effects (Nam);
Insert_Action (N,
Make_Subtype_Declaration (Loc,
Defining_Identifier => Subt,
Subtype_Indication =>
Make_Subtype_From_Expr (Nam, Etype (Nam))));
Rewrite (Subtype_Mark (N), New_Occurrence_Of (Subt, Loc));
Set_Etype (Nam, Subt);
end if;
end if;
end Check_Constrained_Object;
----------------------
-- In_Generic_Scope --
----------------------
@ -910,33 +956,11 @@ package body Sem_Ch8 is
Nam);
end if;
-- If the function call returns an unconstrained type, we must
-- build a constrained subtype for the new entity, in a way
-- similar to what is done for an object declaration with an
-- unconstrained nominal type.
if Is_Composite_Type (Etype (Nam))
and then not Is_Constrained (Etype (Nam))
and then not Has_Unknown_Discriminants (Etype (Nam))
and then Expander_Active
then
declare
Loc : constant Source_Ptr := Sloc (N);
Subt : constant Entity_Id := Make_Temporary (Loc, 'T');
begin
Remove_Side_Effects (Nam);
Insert_Action (N,
Make_Subtype_Declaration (Loc,
Defining_Identifier => Subt,
Subtype_Indication =>
Make_Subtype_From_Expr (Nam, Etype (Nam))));
Rewrite (Subtype_Mark (N), New_Occurrence_Of (Subt, Loc));
Set_Etype (Nam, Subt);
end;
end if;
end case;
end if;
Check_Constrained_Object;
-- An object renaming requires an exact match of the type. Class-wide
-- matching is not allowed.

9
gcc/ada/tracebak.c
View File

@ -219,7 +219,14 @@ struct layout
#define FRAME_OFFSET(FP) 0
#define PC_ADJUST -4
#define STOP_FRAME(CURRENT, TOP_STACK) ((void *) (CURRENT) < (TOP_STACK))
/* Eventhough the base PPC ABI states that a toplevel frame entry
should to feature a null backchain, AIX might expose a null return
address instead. */
#define STOP_FRAME(CURRENT, TOP_STACK) \
(((void *) (CURRENT) < (TOP_STACK)) \
|| (CURRENT)->return_address == NULL)
/* 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