From 3f5a8feea3381fb0311e4d1a264c0661f37432dd Mon Sep 17 00:00:00 2001 From: Arnaud Charlet Date: Wed, 3 Aug 2011 10:32:57 +0200 Subject: [PATCH] [multiple changes] 2011-08-03 Olivier Hainque * tracebak.c (STOP_FRAME ppc AIX): Stop at null return address as well. 2011-08-03 Ed Schonberg * 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 * g-pehage.adb (Finalize): Avoid possible double-free. 2011-08-03 Steve Baird * exp_attr.adb (Expand_N_Attribute_Reference): Don't expand Elab_Spec/Body attrs in CodePeer_Mode. 2011-08-03 Javier Miranda * 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 * s-tasinf-vxworks.ads: Update comment to reflect 0 indexing of CPUs on VxWorks SMP. Remove unusable constant ANY_CPU. From-SVN: r177242 --- gcc/ada/ChangeLog | 32 ++++++++++++++++ gcc/ada/exp_aggr.adb | 40 +++++++++++++++++++- gcc/ada/exp_attr.adb | 9 ++++- gcc/ada/g-pehage.adb | 28 +++++++------- gcc/ada/s-tasinf-vxworks.ads | 7 +--- gcc/ada/sem_ch8.adb | 72 ++++++++++++++++++++++++------------ gcc/ada/tracebak.c | 9 ++++- 7 files changed, 151 insertions(+), 46 deletions(-) diff --git a/gcc/ada/ChangeLog b/gcc/ada/ChangeLog index ebd1b037ab9..ecb09e0d43e 100644 --- a/gcc/ada/ChangeLog +++ b/gcc/ada/ChangeLog @@ -1,3 +1,35 @@ +2011-08-03 Olivier Hainque + + * tracebak.c (STOP_FRAME ppc AIX): Stop at null return address as well. + +2011-08-03 Ed Schonberg + + * 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 + + * g-pehage.adb (Finalize): Avoid possible double-free. + +2011-08-03 Steve Baird + + * exp_attr.adb (Expand_N_Attribute_Reference): Don't expand + Elab_Spec/Body attrs in CodePeer_Mode. + +2011-08-03 Javier Miranda + + * 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 + + * 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 * gnatcmd.adb, make.adb, prj-part.adb, prj-part.ads, prj-makr.adb, diff --git a/gcc/ada/exp_aggr.adb b/gcc/ada/exp_aggr.adb index c083805761c..b797648e7d5 100644 --- a/gcc/ada/exp_aggr.adb +++ b/gcc/ada/exp_aggr.adb @@ -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; diff --git a/gcc/ada/exp_attr.adb b/gcc/ada/exp_attr.adb index 8990e0b293b..a2c2bcc8d4c 100644 --- a/gcc/ada/exp_attr.adb +++ b/gcc/ada/exp_attr.adb @@ -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; diff --git a/gcc/ada/g-pehage.adb b/gcc/ada/g-pehage.adb index 0d5e52ab522..b08f530b434 100644 --- a/gcc/ada/g-pehage.adb +++ b/gcc/ada/g-pehage.adb @@ -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; diff --git a/gcc/ada/s-tasinf-vxworks.ads b/gcc/ada/s-tasinf-vxworks.ads index 18b2ad42703..db6bc56af60 100644 --- a/gcc/ada/s-tasinf-vxworks.ads +++ b/gcc/ada/s-tasinf-vxworks.ads @@ -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; diff --git a/gcc/ada/sem_ch8.adb b/gcc/ada/sem_ch8.adb index 67a53e36399..fddb704c96f 100644 --- a/gcc/ada/sem_ch8.adb +++ b/gcc/ada/sem_ch8.adb @@ -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. diff --git a/gcc/ada/tracebak.c b/gcc/ada/tracebak.c index 23fc5c79858..2e292857e61 100644 --- a/gcc/ada/tracebak.c +++ b/gcc/ada/tracebak.c @@ -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 -- 2.30.2