diff options
| -rw-r--r-- | gcc/ada/ChangeLog | 32 | ||||
| -rw-r--r-- | gcc/ada/exp_aggr.adb | 40 | ||||
| -rw-r--r-- | gcc/ada/exp_attr.adb | 9 | ||||
| -rw-r--r-- | gcc/ada/g-pehage.adb | 28 | ||||
| -rw-r--r-- | gcc/ada/s-tasinf-vxworks.ads | 7 | ||||
| -rw-r--r-- | gcc/ada/sem_ch8.adb | 72 | ||||
| -rw-r--r-- | gcc/ada/tracebak.c | 9 |
7 files changed, 151 insertions, 46 deletions
diff --git a/gcc/ada/ChangeLog b/gcc/ada/ChangeLog index ebd1b03..ecb09e0 100644 --- a/gcc/ada/ChangeLog +++ b/gcc/ada/ChangeLog @@ -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, diff --git a/gcc/ada/exp_aggr.adb b/gcc/ada/exp_aggr.adb index c083805..b797648 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 8990e0b..a2c2bcc 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 0d5e52a..b08f530 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 18b2ad4..db6bc56 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 67a53e3..fddb704 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 23fc5c7..2e29285 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 |