+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,
Lov : Uint;
Hiv : Uint;
+ Others_Present : Boolean := False;
+
begin
if Nkind (Original_Node (N)) = N_String_Literal then
return True;
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;
-- --
-- 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- --
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;
-- --
-- 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- --
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);
-- 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;
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 --
----------------------------
-- 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;
-- --
-- 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- --
------------------
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;
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 --
----------------------
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.
#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
projects / platform / upstream / gcc.git / commitdiff