[DOC PATCH]: Sync stack_protect_{set,test} documentation with reality

2011-08-02 Thread Uros Bizjak
Hello!

2011-08-02  Uros Bizjak  

PR target/47766
* doc/md.texi (stack_protect_set): The pattern moves ptr_mode value.
(stack_protect_test): The pattern compares ptr_mode value.

Tested on x86_64-pc-linux-gnu, committed to mainline (and soon release
branches).

Uros.

Index: doc/md.texi
===
--- doc/md.texi (revision 177084)
+++ doc/md.texi (working copy)
@@ -5557,7 +5557,7 @@
 @cindex @code{stack_protect_set} instruction pattern
 @item @samp{stack_protect_set}

-This pattern, if defined, moves a @code{Pmode} value from the memory
+This pattern, if defined, moves a @code{ptr_mode} value from the memory
 in operand 1 to the memory in operand 0 without leaving the value in
 a register afterward.  This is to avoid leaking the value some place
 that an attacker might use to rewrite the stack guard slot after
@@ -5568,7 +5568,7 @@
 @cindex @code{stack_protect_test} instruction pattern
 @item @samp{stack_protect_test}

-This pattern, if defined, compares a @code{Pmode} value from the
+This pattern, if defined, compares a @code{ptr_mode} value from the
 memory in operand 1 with the memory in operand 0 without leaving the
 value in a register afterward and branches to operand 2 if the values
 weren't equal.


[Ada] Virtually extending library project inherits library kind

2011-08-02 Thread Arnaud Charlet
Virtual projects that were extensions of shared library projects were
deemed as static library projects.

Tested on x86_64-pc-linux-gnu, committed on trunk

2011-08-02  Vincent Celier  

* prj-nmsc.adb (Check_Library_Attributes): For virtual library project,
inherit library kind.

Index: prj-nmsc.adb
===
--- prj-nmsc.adb(revision 176998)
+++ prj-nmsc.adb(working copy)
@@ -3724,10 +3724,11 @@
 
   else
  --  For a virtual project extending a library project,
- --  inherit library directory.
+ --  inherit library directory and library kind.
 
  Project.Library_Dir := Project.Extends.Library_Dir;
  Library_Directory_Present := True;
+ Project.Library_Kind := Project.Extends.Library_Kind;
   end if;
end if;
 end if;


[Ada] Updates to make Interfaces.C.Strings match RM

2011-08-02 Thread Arnaud Charlet
This patch updates Interafaces.C.Strings to match the RM as follows:
In accordance with AI95-00161
 pragma Preelaborable_Initialization is added for chars_ptr
In accordance with AI95-00276
 aliased keyword is added to declaration of chars_ptr_array

The following should compile quietly:

with interfaces.C.Strings;
with Interfaces.C.Pointers;
package Char_Ptr_Ptr is new Interfaces.C.Pointers
 (Index  => Interfaces.C.size_t,
  Element=> Interfaces.C.Strings.chars_ptr,
  Element_Array  => Interfaces.C.Strings.chars_ptr_array,
  Default_Terminator => Interfaces.C.Strings.Null_Ptr);

Tested on x86_64-pc-linux-gnu, committed on trunk

2011-08-02  Robert Dewar  

* i-cstrin.ads: Updates to make Interfaces.C.Strings match RM

Index: i-cstrin.ads
===
--- i-cstrin.ads(revision 177038)
+++ i-cstrin.ads(working copy)
@@ -45,8 +45,9 @@
--  strict aliasing assumptions for this type.
 
type chars_ptr is private;
+   pragma Preelaborable_Initialization (chars_ptr);
 
-   type chars_ptr_array is array (size_t range <>) of chars_ptr;
+   type chars_ptr_array is array (size_t range <>) of aliased chars_ptr;
 
Null_Ptr : constant chars_ptr;
 


[Ada] Preliminary work for Default_[Component_]Value (AI 228)

2011-08-02 Thread Arnaud Charlet
This is preliminary work for implementing these new aspects
and pragmas. Not yet ready for prime time.

Tested on x86_64-pc-linux-gnu, committed on trunk

2011-08-02  Robert Dewar  

* aspects.adb: New aspects Default_Value and Default_Component_Value
New format of Aspect_Names table checks for omitted entries
* aspects.ads: Remove mention of Aspect_Cancel and add documentation on
handling of boolean aspects for derived types.
New aspects Default_Value and Default_Component_Value
New format of Aspect_Names table checks for omitted entries
* einfo.ads, einfo.adb (Has_Default_Component_Value): New flag
(Has_Default_Value): New flag
(Has_Default_Component_Value): New flag
(Has_Default_Value): New flag
* par-ch13.adb (P_Aspect_Specifications): New format of Aspect_Names
table.
* par-prag.adb: New pragmas Default_Value and Default_Component_Value
* sem_ch13.adb (Analyze_Aspect_Specifications): New aspects
Default_Value and Default_Component_Value
* sem_prag.adb: New pragmas Default_Value and Default_Component_Value
New aspects Default_Value and Default_Component_Value
* snames.ads-tmpl: New pragmas Default_Value and Default_Component_Value
* sprint.adb: Print N_Aspect_Specification node when called from gdb

Index: par-ch13.adb
===
--- par-ch13.adb(revision 177095)
+++ par-ch13.adb(working copy)
@@ -427,9 +427,9 @@
 
 --  Check bad spelling
 
-for J in Aspect_Names'Range loop
-   if Is_Bad_Spelling_Of (Token_Name, Aspect_Names (J).Nam) then
-  Error_Msg_Name_1 := Aspect_Names (J).Nam;
+for J in Aspect_Id loop
+   if Is_Bad_Spelling_Of (Token_Name, Aspect_Names (J)) then
+  Error_Msg_Name_1 := Aspect_Names (J);
   Error_Msg_SC -- CODEFIX
 ("\possible misspelling of%");
   exit;
Index: einfo.adb
===
--- einfo.adb   (revision 177092)
+++ einfo.adb   (working copy)
@@ -283,6 +283,7 @@
--Referenced_As_LHS   Flag36
--Is_Known_Non_Null   Flag37
--Can_Never_Be_Null   Flag38
+   --Has_Default_Value   Flag39
--Body_Needed_For_SAL Flag40
 
--Treat_As_Volatile   Flag41
@@ -406,6 +407,7 @@
--Is_Compilation_Unit Flag149
--Has_Pragma_Elaborate_Body   Flag150
 
+   --Has_Default_Component_Value Flag151
--Entry_Accepted  Flag152
--Is_Obsolescent  Flag153
--Has_Per_Object_Constraint   Flag154
@@ -514,8 +516,6 @@
--Has_Inheritable_Invariants  Flag248
--Has_Predicates  Flag250
 
-   --(unused)Flag39
-   --(unused)Flag151
--(unused)Flag249
--(unused)Flag251
--(unused)Flag252
@@ -1226,6 +1226,18 @@
   return Flag119 (Id);
end Has_Convention_Pragma;
 
+   function Has_Default_Component_Value (Id : E) return B is
+   begin
+  pragma Assert (Is_Array_Type (Id));
+  return Flag151 (Base_Type (Id));
+   end Has_Default_Component_Value;
+
+   function Has_Default_Value (Id : E) return B is
+   begin
+  pragma Assert (Is_Scalar_Type (Id));
+  return Flag39 (Base_Type (Id));
+   end Has_Default_Value;
+
function Has_Delayed_Aspects (Id : E) return B is
begin
   pragma Assert (Nkind (Id) in N_Entity);
@@ -3663,6 +3675,18 @@
   Set_Flag119 (Id, V);
end Set_Has_Convention_Pragma;
 
+   procedure Set_Has_Default_Component_Value (Id : E; V : B := True) is
+   begin
+  pragma Assert (Is_Array_Type (Id) and then Is_Base_Type (Id));
+  Set_Flag151 (Id, V);
+   end Set_Has_Default_Component_Value;
+
+   procedure Set_Has_Default_Value (Id : E; V : B := True) is
+   begin
+  pragma Assert (Is_Scalar_Type (Id) and then Is_Base_Type (Id));
+  Set_Flag39 (Id, V);
+   end Set_Has_Default_Value;
+
procedure Set_Has_Delayed_Aspects (Id : E; V : B := True) is
begin
   pragma Assert (Nkind (Id) in N_Entity);
@@ -7326,6 +7350,8 @@
   W ("Has_Controlled_Component",Flag43  (Id));
   W ("Has_Controlling_Result",  Flag98  (Id));
   W ("Has_Convention_Pragma",   Flag119 (Id));
+  W ("Has_Default_Component_Value", Flag151 (Id));
+  W ("Has_Default_Value",   Flag39  (Id));
   W ("Has_Delayed_Aspects", Flag200 (Id));
   W ("Has_Delayed_Freeze",  Flag18  (Id));
   W ("Has_Discriminants",   Flag5   (Id));
Index: einfo.ads
===

[Ada] Fix handling of "*" in the presence of empty switch sections

2011-08-02 Thread Arnaud Charlet
With the following code and a command line "count -n -sargs -zargs", counting
the number of arguments in the "-sargs" section was returning 1, ie
including the start of the following section. This now properly returns 0

with GNAT.Command_Line;  use GNAT.Command_Line;
procedure Count is
   Count : Natural := 0;
begin
   Initialize_Option_Scan (Section_Delimiters => "sargs zargs vargs");
   Goto_Section ("sargs");
   loop
  case Getopt ("*") is
 when '*'=> Count := Count + 1;
 when others => return Count;
  end case;
   end loop;
   pragma Assert (Count = 0);
end Count;

Tested on x86_64-pc-linux-gnu, committed on trunk

2011-08-02  Emmanuel Briot  

* g-comlin.adb (Goto_Section, Getopt): fix handling of "*" when there
are empty sections.

Index: g-comlin.adb
===
--- g-comlin.adb(revision 176998)
+++ g-comlin.adb(working copy)
@@ -673,15 +673,24 @@
--  especially important when Concatenate is False, since
--  otherwise the current argument first character is lost.
 
-   Set_Parameter
- (Parser.The_Switch,
-  Arg_Num => Parser.Current_Argument,
-  First   => Parser.Current_Index,
-  Last=> Arg'Last,
-  Extra   => Parser.Switch_Character);
-   Parser.Is_Switch (Parser.Current_Argument) := True;
-   Dummy := Goto_Next_Argument_In_Section (Parser);
-   return '*';
+   if Parser.Section (Parser.Current_Argument) = 0 then
+
+  --  A section transition should not be returned to the user
+
+  Dummy := Goto_Next_Argument_In_Section (Parser);
+  goto Restart;
+
+   else
+  Set_Parameter
+(Parser.The_Switch,
+ Arg_Num => Parser.Current_Argument,
+ First   => Parser.Current_Index,
+ Last=> Arg'Last,
+ Extra   => Parser.Switch_Character);
+  Parser.Is_Switch (Parser.Current_Argument) := True;
+  Dummy := Goto_Next_Argument_In_Section (Parser);
+  return '*';
+   end if;
 end if;
 
 Set_Parameter
@@ -891,7 +900,14 @@
Parser.Current_Section :=
  Parser.Section (Parser.Current_Argument);
 end if;
-return;
+
+--  Until we have the start of another section
+
+if Index = Parser.Section'Last
+   or else Parser.Section (Index + 1) /= 0
+then
+   return;
+end if;
  end if;
 
  Index := Index + 1;
@@ -1004,6 +1020,9 @@
Delimiter_Found := True;
 
 elsif Parser.Section (Index) = 0 then
+
+   --  A previous section delimiter
+
Delimiter_Found := False;
 
 elsif Delimiter_Found then
@@ -3186,14 +3205,14 @@
procedure Getopt
  (Config   : Command_Line_Configuration;
   Callback : Switch_Handler := null;
-  Parser   : Opt_Parser := Command_Line_Parser)
+  Parser   : Opt_Parser := Command_Line_Parser)
is
   Getopt_Switches : String_Access;
-  C   : Character := ASCII.NUL;
+  C   : Character := ASCII.NUL;
 
-  Empty_Name : aliased constant String := "";
+  Empty_Name  : aliased constant String := "";
   Current_Section : Integer := -1;
-  Section_Name : not null access constant String := Empty_Name'Access;
+  Section_Name: not null access constant String := Empty_Name'Access;
 
   procedure Simple_Callback
 (Simple_Switch : String;
@@ -3231,6 +3250,7 @@
 Config.Switches (Index).Integer_Output.all :=
   Integer'Value (Parameter);
  end if;
+
   exception
  when Constraint_Error =>
 raise Invalid_Parameter


Re: [PATCH 2/2] Fix PR47594: Build signed niter expressions

2011-08-02 Thread Richard Guenther
On Tue, 2 Aug 2011, Sebastian Pop wrote:

> --- a/gcc/graphite-scop-detection.c
> +++ b/gcc/graphite-scop-detection.c
> @@ -196,6 +196,12 @@ graphite_can_represent_scev (tree scev)
>if (chrec_contains_undetermined (scev))
>  return false;
>  
> +  /* FIXME: As long as Graphite cannot handle wrap around effects of
> + induction variables, we discard them.  */
> +  if (TYPE_UNSIGNED (TREE_TYPE (scev))
> +  && !POINTER_TYPE_P (TREE_TYPE (scev)))
> +return false;

What does it take to fix that?


[Ada] Improve removal of side effects in in-mode parameters

2011-08-02 Thread Arnaud Charlet
This patch improves the removal of side effects in in-mode parameters
whose type is an access type. Required because the compiler was
considering side-effect free an in-mode parameter whose type is an
access type. This improvement is visible compiling the following
test with switch -gnatD:

procedure cutdown is
   type root is tagged record Msg : String (1 .. 123); end record;
   type ext is new root with record Len : natural; end record;

   type root_ref is access all Root'Class;

   function F (X : Root_Ref) return String is
 Result : String := X.Msg (1 .. Ext (X.all).Len);  --  [Test]
   begin
  return Result;
   end F;
begin
   null;
end;

The previous expansion of line [Test] included:

[constraint_error when
 cutdown__ext!(x.all).len >= 1 and then (integer(cutdown__ext!(x.all).
   len) > 123)
 "range check failed"]
[subtype cutdown__f__T184b is integer range 1 .. cutdown__ext!(x.all).len]

... and the nex expansion is as follows:

R184b : constant natural := cutdown__ext!(x.all).len;
[constraint_error when
 R184b >= 1 and then (integer(R184b) > 123)
 "range check failed"]
[subtype cutdown__f__T185b is integer range 1 .. R184b]

Tested on x86_64-pc-linux-gnu, committed on trunk

2011-08-02  Javier Miranda  

* exp_util.adb (Safe_Prefixed_Reference): Do not consider safe an
in-mode parameter whose type is an access type since it can be used to
modify its designated object. Enforce code that handles as safe an
access type that is not access-to-constant but it is the result of a
previous removal of side-effects.
(Remove_Side_Effects): Minor code reorganization of cases which require
no action. Done to incorporate documentation on new cases uncovered
working in this ticket: no action needed if this routine was invoked
too early and the nodes are not yet decorated.
* sem_res.adb (Resolve_Slice): Minor code cleanup replacling two calls
to routine Remove_Side_Effects by calls to Force_Evaluation since they
were issued with actuals that are implicitly provided by
Force_Evaluation.

Index: exp_util.adb
===
--- exp_util.adb(revision 177089)
+++ exp_util.adb(working copy)
@@ -4616,22 +4616,20 @@
 
  --  If the prefix is of an access type that is not access-to-constant,
  --  then this construct is a variable reference, which means it is to
- --  be considered to have side effects if Variable_Ref is set True
- --  Exception is an access to an entity that is a constant or an
- --  in-parameter which does not come from source, and is the result
- --  of a previous removal of side-effects.
+ --  be considered to have side effects if Variable_Ref is set True.
 
  elsif Is_Access_Type (Etype (Prefix (N)))
and then not Is_Access_Constant (Etype (Prefix (N)))
and then Variable_Ref
  then
-if not Is_Entity_Name (Prefix (N)) then
-   return False;
-else
-   return Ekind (Entity (Prefix (N))) = E_Constant
- or else Ekind (Entity (Prefix (N))) = E_In_Parameter;
-end if;
+--  Exception is a prefix that is the result of a previous removal
+--  of side-effects.
 
+return Is_Entity_Name (Prefix (N))
+  and then not Comes_From_Source (Prefix (N))
+  and then Ekind (Entity (Prefix (N))) = E_Constant
+  and then Is_Internal_Name (Chars (Entity (Prefix (N;
+
  --  If the prefix is an explicit dereference then this construct is a
  --  variable reference, which means it is to be considered to have
  --  side effects if Variable_Ref is True.
@@ -4945,11 +4943,25 @@
--  Start of processing for Remove_Side_Effects
 
begin
-  --  If we are side effect free already or expansion is disabled,
-  --  there is nothing to do.
+  --  Handle cases in which there is nothing to do
 
-  if Side_Effect_Free (Exp) or else not Expander_Active then
+  if not Expander_Active then
  return;
+
+  --  Cannot generate temporaries if the invocation to remove side effects
+  --  was issued too early and the type of the expression is not resolved
+  --  (this happens because routines Duplicate_Subexpr_XX implicitly invoke
+  --  Remove_Side_Effects).
+
+  elsif No (Exp_Type)
+or else Ekind (Exp_Type) = E_Access_Attribute_Type
+  then
+ return;
+
+  --  No action needed for side-effect free expressions
+
+  elsif Side_Effect_Free (Exp) then
+ return;
   end if;
 
   --  All this must not have any checks
Index: sem_res.adb
===
--- sem_res.adb (revision 177119)
+++ sem_res.adb (working copy)
@@ -8631,8 +8631,8 @@
 
 --  Ensure that s

[Ada] Types derived from types with foreign conventions

2011-08-02 Thread Arnaud Charlet
A private type may have its convention established by a pragma in the private
part of its enclosing package. A subtype of this type has its convention fixed
at the freeze point. A type derived from this subtype must get its convention
from the base type, because it may be needed in the initialization call for an
object of the derived type.

The following must compile quietly:
 gcc -c -gnatws m_main.adb


with SYSTEM;
procedure M_MAIN is
   package q_mw_string is
  type Sequence is private;
  subtype Bounded_String is Sequence;

   private
  type Sequence is record
 r_array  : string(1 .. 5) := (others => ascii.nul);
  end record;
  pragma Convention(C, Sequence);
   end q_mw_string;

   type T_OPERATOR_LEVEL is new Q_MW_STRING.Bounded_String;
   --  pragma Convention (C, T_Operator_Level);   --  workaround

   V_BUFFER : STRING (1 .. 1000);
   CVN_V_LEVEL_ADDRESS : constant SYSTEM.ADDRESS := V_BUFFER'ADDRESS;
   VN_V_LEVEL : T_OPERATOR_LEVEL;

   --  VN_V_LEVEL : Q_MW_STRING.Bounded_String;  -- workaround

   for VN_V_LEVEL'ADDRESS use CVN_V_LEVEL_ADDRESS;

begin
   null;
end M_MAIN;

Tested on x86_64-pc-linux-gnu, committed on trunk

2011-08-02  Ed Schonberg  

* sem_ch3.adb (Build_Derived_Type): Inherit the convention from the
base type, because the parent may be a subtype of a private type whose
convention is established in a private part.

Index: sem_ch3.adb
===
--- sem_ch3.adb (revision 177119)
+++ sem_ch3.adb (working copy)
@@ -7836,10 +7836,15 @@
 
   Set_Size_Info  (Derived_Type, Parent_Type);
   Set_RM_Size(Derived_Type, RM_Size(Parent_Type));
-  Set_Convention (Derived_Type, Convention (Parent_Type));
   Set_Is_Controlled  (Derived_Type, Is_Controlled  (Parent_Type));
   Set_Is_Tagged_Type (Derived_Type, Is_Tagged_Type (Parent_Type));
 
+  --  If the parent type is a private subtype, the convention on the base
+  --  type may be set in the private part, and not propagated to the
+  --  subtype until later, so we obtain the convention from the base type.
+
+  Set_Convention (Derived_Type, Convention (Parent_Base));
+
   --  Propagate invariant information. The new type has invariants if
   --  they are inherited from the parent type, and these invariants can
   --  be further inherited, so both flags are set.
@@ -9918,9 +9923,10 @@
   Set_Homonym (Full, Save_Homonym);
   Set_Associated_Node_For_Itype (Full, Related_Nod);
 
-  --  Set common attributes for all subtypes
+  --  Set common attributes for all subtypes: kind, convention, etc.
 
   Set_Ekind (Full, Subtype_Kind (Ekind (Full_Base)));
+  Set_Convention (Full, Convention (Full_Base));
 
   --  The Etype of the full view is inconsistent. Gigi needs to see the
   --  structural full view,  which is what the current scheme gives:


Re: [PATCH][2/2][RFC] Fix PR49806, promote/demote binary operations in VRP

2011-08-02 Thread Ira Rosen

> +   /* Now we have matched the statement pattern
> +
> +rhs1 = (T1)x;
> +rhs2 = (T1)y;
> +op_result = rhs1 OP rhs2;
> +lhs = (T2)op_result;

Just a note that the patch I proposed for the vectorizer (
http://gcc.gnu.org/ml/gcc-patches/2011-07/msg01472.html) also handles
constants, multiple statements (i.e., op_result doesn't have to be promoted
itself, but the sequence needs to end up with a promotion), and also it may
use an intermediate type for OP. The tests in my patch don't match the
pattern this patch detects.

Thanks,
Ira



[Ada] Reduce compilation time at -O0 (2/n)

2011-08-02 Thread Arnaud Charlet
This patch slightly reduces compilation time at -O0 in typical conditions by
tuning the implementation of Base_Type to make it more easily optimizable.

No functional changes.

Tested on x86_64-pc-linux-gnu, committed on trunk

2011-08-02  Eric Botcazou  

* einfo.adb (Base_Type): Tune implementation for speed.

Index: einfo.adb
===
--- einfo.adb   (revision 177110)
+++ einfo.adb   (working copy)
@@ -5608,7 +5608,13 @@
---
 
function Base_Type (Id : E) return E is
+  Is_Base_Type : Boolean;
begin
+  --  Implementation note: this function shows up high in the profile.
+  --  We use a fully static case construct so as to make it easier for
+  --  the compiler to build a static table out of it, instead of using
+  --  a less efficient jump table.
+
   case Ekind (Id) is
  when E_Enumeration_Subtype  |
   E_Incomplete_Type  |
@@ -5628,11 +5634,17 @@
   E_Task_Subtype |
   E_String_Literal_Subtype   |
   E_Class_Wide_Subtype   =>
-return Etype (Id);
+Is_Base_Type := False;
 
  when others =>
-return Id;
+Is_Base_Type := True;
   end case;
+
+  if Is_Base_Type then
+ return Id;
+  end if;
+
+  return Etype (Id);
end Base_Type;
 
-


[Ada] Reduce compilation time

2011-08-02 Thread Arnaud Charlet
This patch improves on the previous patch to reduce compilation time,
by providing better implementations for Base_Type and Is_Base_Type and
inlining Base_Type.

No functional changes.

Tested on x86_64-pc-linux-gnu, committed on trunk

2011-08-02  Robert Dewar  

* einfo.adb (Is_Base_Type): Improve efficiency by using a flag table
(Base_Type): Now uses improved Is_Base_Type function
* einfo.ads (Base_Type): Inline this function

Index: einfo.adb
===
--- einfo.adb   (revision 177122)
+++ einfo.adb   (working copy)
@@ -5608,43 +5608,13 @@
---
 
function Base_Type (Id : E) return E is
-  Is_Base_Type : Boolean;
begin
-  --  Implementation note: this function shows up high in the profile.
-  --  We use a fully static case construct so as to make it easier for
-  --  the compiler to build a static table out of it, instead of using
-  --  a less efficient jump table.
-
-  case Ekind (Id) is
- when E_Enumeration_Subtype  |
-  E_Incomplete_Type  |
-  E_Signed_Integer_Subtype   |
-  E_Modular_Integer_Subtype  |
-  E_Floating_Point_Subtype   |
-  E_Ordinary_Fixed_Point_Subtype |
-  E_Decimal_Fixed_Point_Subtype  |
-  E_Array_Subtype|
-  E_String_Subtype   |
-  E_Record_Subtype   |
-  E_Private_Subtype  |
-  E_Record_Subtype_With_Private  |
-  E_Limited_Private_Subtype  |
-  E_Access_Subtype   |
-  E_Protected_Subtype|
-  E_Task_Subtype |
-  E_String_Literal_Subtype   |
-  E_Class_Wide_Subtype   =>
-Is_Base_Type := False;
-
- when others =>
-Is_Base_Type := True;
-  end case;
-
-  if Is_Base_Type then
+  if Is_Base_Type (Id) then
  return Id;
+  else
+ pragma Assert (Is_Type (Id));
+ return Etype (Id);
   end if;
-
-  return Etype (Id);
end Base_Type;
 
-
@@ -6206,9 +6176,32 @@
-- Is_Base_Type --
--
 
+   --  Global flag table allowing rapid computation of this function
+
+   Entity_Is_Base_Type : constant array (Entity_Kind) of Boolean :=
+   (E_Enumeration_Subtype  |
+E_Incomplete_Type  |
+E_Signed_Integer_Subtype   |
+E_Modular_Integer_Subtype  |
+E_Floating_Point_Subtype   |
+E_Ordinary_Fixed_Point_Subtype |
+E_Decimal_Fixed_Point_Subtype  |
+E_Array_Subtype|
+E_String_Subtype   |
+E_Record_Subtype   |
+E_Private_Subtype  |
+E_Record_Subtype_With_Private  |
+E_Limited_Private_Subtype  |
+E_Access_Subtype   |
+E_Protected_Subtype|
+E_Task_Subtype |
+E_String_Literal_Subtype   |
+E_Class_Wide_Subtype   => False,
+others => True);
+
function Is_Base_Type (Id : E) return Boolean is
begin
-  return Id = Base_Type (Id);
+  return Entity_Is_Base_Type (Ekind (Id));
end Is_Base_Type;
 
-
Index: einfo.ads
===
--- einfo.ads   (revision 177110)
+++ einfo.ads   (working copy)
@@ -8010,6 +8010,7 @@
--  things here which are small, but not of the canonical attribute
--  access/set format that can be handled by xeinfo.
 
+   pragma Inline (Base_Type);
pragma Inline (Is_Base_Type);
pragma Inline (Is_Package_Or_Generic_Package);
pragma Inline (Is_Volatile);


[Ada] Library_Dir incorrectly reported as not declared

2011-08-02 Thread Arnaud Charlet
For qualified library project, when attribute Library_Name was not
declared, but attribute Library_Dir was, both attributes were reported
as not declared.
The test for this is to have a qualified library project with Library_Dir
declared and Library_Name not declared. There should be no error message
for Library_Dir not declared.

Tested on x86_64-pc-linux-gnu, committed on trunk

2011-08-02  Vincent Celier  

* prj-nmsc.adb (Check_Library_Attributes): Do not report Library_Dir
not declared for qualified library project when Library_Name is not
declared, but Library_Dir is.

Index: prj-nmsc.adb
===
--- prj-nmsc.adb(revision 177107)
+++ prj-nmsc.adb(working copy)
@@ -3915,17 +3915,23 @@
 
 when Library =>
if not Project.Library then
-  if Project.Library_Dir = No_Path_Information then
+  if Project.Library_Name = No_Name then
  Error_Msg
(Data.Flags,
-"\attribute Library_Dir not declared",
+"attribute Library_Name not declared",
 Project.Location, Project);
-  end if;
 
-  if Project.Library_Name = No_Name then
+ if not Library_Directory_Present then
+Error_Msg
+  (Data.Flags,
+   "\attribute Library_Dir not declared",
+   Project.Location, Project);
+ end if;
+
+  elsif Project.Library_Dir = No_Path_Information then
  Error_Msg
(Data.Flags,
-"\attribute Library_Name not declared",
+"attribute Library_Dir not declared",
 Project.Location, Project);
   end if;
end if;


[Ada] Further preliminary work for [Component_]Default_Value

2011-08-02 Thread Arnaud Charlet
These aspects are still not fully implemented, so no test yet

Tested on x86_64-pc-linux-gnu, committed on trunk

2011-08-02  Robert Dewar  

* sem_ch13.adb (Analyze_Aspect_Specification): Fix slocs on generated
pragmas (affects aspects [Component_]Default_Value
(Check_Aspect_At_Freeze_Point): For Component_Default_Value, use
component type for the resolution

Index: sem_ch13.adb
===
--- sem_ch13.adb(revision 177110)
+++ sem_ch13.adb(working copy)
@@ -993,7 +993,7 @@
   Aitem :=
 Make_Pragma (Loc,
   Pragma_Argument_Associations => New_List (
-New_Occurrence_Of (E, Eloc),
+New_Occurrence_Of (E, Loc),
 Relocate_Node (Expr)),
   Pragma_Identifier=>
 Make_Identifier (Sloc (Id), Chars (Id)));
@@ -1016,7 +1016,7 @@
   Aitem :=
 Make_Pragma (Loc,
   Pragma_Argument_Associations => New_List (
-New_Occurrence_Of (E, Eloc),
+New_Occurrence_Of (E, Loc),
 Relocate_Node (Expr)),
   Pragma_Identifier=>
 Make_Identifier (Sloc (Id), Chars (Id)));
@@ -1038,7 +1038,7 @@
 Make_Pragma (Loc,
   Pragma_Argument_Associations => New_List (
 Relocate_Node (Expr),
-New_Occurrence_Of (E, Eloc)),
+New_Occurrence_Of (E, Loc)),
   Pragma_Identifier=>
 Make_Identifier (Sloc (Id), Chars (Id)),
   Class_Present=> Class_Present (Aspect));
@@ -5239,13 +5239,16 @@
  when Boolean_Aspects =>
 raise Program_Error;
 
- --  Default_Value and Default_Component_Value are resolved with
- --  the entity, which is the type in question.
+ --  Default_Value is resolved with the type entity in question
 
- when Aspect_Default_Component_Value |
-  Aspect_Default_Value   =>
+ when Aspect_Default_Value =>
 T := Entity (ASN);
 
+ --  Default_Component_Value is resolved with the component type
+
+ when Aspect_Default_Component_Value =>
+T := Component_Type (Entity (ASN));
+
  --  Aspects corresponding to attribute definition clauses
 
  when Aspect_Address =>


[Ada] Fix latent bug in the analysis of iteration bounds

2011-08-02 Thread Arnaud Charlet
When the evaluation of the expressions that provide the bounds of a
for-loop statement uses the secondary stack the frontend must generate
code to release it. Although such code was already in the frontend,
its generation was disabled because of a latent bug.

This can be verified using the following test:

procedure Do_Test is
   function F (N: Natural) return String is
  S : String (1 .. N);
   begin
  return S;
   end;

begin
   for J in 1 .. F(300)'Last loop
  null;
   end loop;
end;

After this patch the expanded code is as follows:

with system.system__secondary_stack;
procedure do_test is

   function do_test__f (n : natural) return string is
  subtype do_test__f__TsS is string (1 .. n);
  null;
  s : string (1 .. n);
   begin
  return s;
   end do_test__f;

   L_1 : label
begin
   S2b : integer;
   L_1__B3b : declare
  M4b : system__secondary_stack__mark_id :=
$system__secondary_stack__ss_mark;

  procedure do_test__L_1__B3b___clean is
  begin
 $system__secondary_stack__ss_release (M4b);
 return;
  end do_test__L_1__B3b___clean;
   begin
  S2b := do_test__f (300)'last;
   at end
  do_test__L_1__B3b___clean;
   end L_1__B3b;
   L_1 : for j in 1 .. S2b loop
  null;
   end loop L_1;
   return;
end do_test;

Tested on x86_64-pc-linux-gnu, committed on trunk

2011-08-02  Javier Miranda  

* sem_ch5.adb (Analyze_Iteration_Scheme.Uses_Secondary_Stack): New
function. Used to be more precise when we generate a variable plus one
assignment to remove side effects in the evaluation of the Bound
expressions.
(Analyze_Iteration_Scheme): Clean attribute analyzed in all the nodes
of the bound expression to force its re-analysis and thus expand the
associated transient scope (if required). Code cleanup replacing the
previous code that declared the constant entity by an invocation to
routine Force_Evaluation which centralizes this work in the frontend.

Index: sem_ch5.adb
===
--- sem_ch5.adb (revision 177102)
+++ sem_ch5.adb (working copy)
@@ -95,9 +95,9 @@
   procedure Set_Assignment_Type
 (Opnd  : Node_Id;
  Opnd_Type : in out Entity_Id);
-  --  Opnd is either the Lhs or Rhs of the assignment, and Opnd_Type
-  --  is the nominal subtype. This procedure is used to deal with cases
-  --  where the nominal subtype must be replaced by the actual subtype.
+  --  Opnd is either the Lhs or Rhs of the assignment, and Opnd_Type is the
+  --  nominal subtype. This procedure is used to deal with cases where the
+  --  nominal subtype must be replaced by the actual subtype.
 
   ---
   -- Diagnose_Non_Variable_Lhs --
@@ -105,8 +105,8 @@
 
   procedure Diagnose_Non_Variable_Lhs (N : Node_Id) is
   begin
- --  Not worth posting another error if left hand side already
- --  flagged as being illegal in some respect.
+ --  Not worth posting another error if left hand side already flagged
+ --  as being illegal in some respect.
 
  if Error_Posted (N) then
 return;
@@ -130,8 +130,8 @@
elsif (Is_Prival (Ent)
 and then
   (Ekind (Current_Scope) = E_Function
- or else Ekind (Enclosing_Dynamic_Scope (
-   Current_Scope)) = E_Function))
+ or else Ekind (Enclosing_Dynamic_Scope
+ (Current_Scope)) = E_Function))
or else
  (Ekind (Ent) = E_Component
 and then Is_Protected_Type (Scope (Ent)))
@@ -202,10 +202,10 @@
  Require_Entity (Opnd);
 
  --  If the assignment operand is an in-out or out parameter, then we
- --  get the actual subtype (needed for the unconstrained case).
- --  If the operand is the actual in an entry declaration, then within
- --  the accept statement it is replaced with a local renaming, which
- --  may also have an actual subtype.
+ --  get the actual subtype (needed for the unconstrained case). If the
+ --  operand is the actual in an entry declaration, then within the
+ --  accept statement it is replaced with a local renaming, which may
+ --  also have an actual subtype.
 
  if Is_Entity_Name (Opnd)
and then (Ekind (Entity (Opnd)) = E_Out_Parameter
@@ -344,8 +344,8 @@
  end if;
   end if;
 
-  --  The resulting assignment type is T1, so now we will resolve the
-  --  left hand side of the assignment using this determined type.
+  --  The resulting assignment type is T1, so now we will resolve the left
+  --  hand side of the assignment using this determined type.
 
   Resol

[patch tree-optimization]: Avoid !=/== 0/1 comparisons for boolean-typed argument

2011-08-02 Thread Kai Tietz
Hello,

this patch removes in forward-propagation useless comparisons X != 0
and X != ~0 for boolean-typed X.  For one-bit precision typed X we
simplifiy X == 0 (and X != ~0) to ~X, and for X != 0 (and X == ~0) to
X.
For none one-bit precisione typed X, we simplify here X == 0 -> X ^ 1,
and for X != 0 -> X.  We can do this as even for Ada - which has only
boolean-type with none-one-bit precision - the truth-value is one.

Additionally this patch changes for function
forward_propagate_comparison the meaning of true-result.  As this
result wasn't used and it is benefitial to use this propagation also
in second loop in function ssa_forward_propagate_and_combine, it
returns true iff statement was altered.  Additionally this function
handles now the boolean-typed simplifications.

For the hunk in gimple.c for function canonicalize_cond_expr_cond:
This change seems to show no real effect, but IMHO it makes sense to
add here the check for cast from boolean-type to be consitant.

ChangeLog

2011-08-02  Kai Tietz  

* gimple.c (canonicalize_cond_expr_cond): Handle cast from boolean-type.
* tree-ssa-forwprop.c (forward_propagate_comparison): Return
true iff statement was modified.
Handle boolean-typed simplification for EQ_EXPR/NE_EXPR.
(ssa_forward_propagate_and_combine): Call
forward_propagate_comparison for comparisons.

2011-08-02  Kai Tietz  

* gcc.dg/tree-ssa/forwprop-9.c: New testcase.


Bootstrapped and regression tested for all languages (including Ada
and Obj-C++) on host x86_64-pc-linux-gnu.  Ok for apply?

Regards,
Kai

Index: gcc/gcc/gimple.c
===
--- gcc.orig/gcc/gimple.c
+++ gcc/gcc/gimple.c
@@ -3160,7 +3160,9 @@ canonicalize_cond_expr_cond (tree t)
 {
   /* Strip conversions around boolean operations.  */
   if (CONVERT_EXPR_P (t)
-  && truth_value_p (TREE_CODE (TREE_OPERAND (t, 0
+  && (truth_value_p (TREE_CODE (TREE_OPERAND (t, 0)))
+  || TREE_CODE (TREE_TYPE (TREE_OPERAND (t, 0)))
+== BOOLEAN_TYPE))
 t = TREE_OPERAND (t, 0);

   /* For !x use x == 0.  */
Index: gcc/gcc/tree-ssa-forwprop.c
===
--- gcc.orig/gcc/tree-ssa-forwprop.c
+++ gcc/gcc/tree-ssa-forwprop.c
@@ -1114,7 +1114,18 @@ forward_propagate_addr_expr (tree name,
  a_1 = (T')cond_1
  a_1 = !cond_1
  a_1 = cond_1 != 0
-   Returns true if stmt is now unused.  */
+ For boolean typed comparisons with type-precision of one
+ X == 0 -> ~X
+ X != ~0 -> ~X
+ X != 0 -> X
+ X == ~0 -> X
+ For boolean typed comparison with none one-bit type-precision
+ we can assume that truth-value is one, and false-value is zero.
+ X == 1 -> X
+ X != 1 -> X ^ 1
+ X == 0 -> X ^ 1
+ X != 0 -> X
+   Returns true if stmt is changed.  */

 static bool
 forward_propagate_comparison (gimple stmt)
@@ -1123,9 +1134,48 @@ forward_propagate_comparison (gimple stm
   gimple use_stmt;
   tree tmp = NULL_TREE;
   gimple_stmt_iterator gsi;
-  enum tree_code code;
+  enum tree_code code = gimple_assign_rhs_code (stmt);
   tree lhs;

+  /* Simplify X != 0 -> X and X == 0 -> ~X, if X is boolean-typed
+ and X has a compatible type to the comparison-expression.  */
+  if ((code == EQ_EXPR || code == NE_EXPR)
+  && TREE_CODE (TREE_TYPE (gimple_assign_rhs1 (stmt))) == BOOLEAN_TYPE
+  && TREE_CODE (gimple_assign_rhs2 (stmt)) == INTEGER_CST
+  /* A comparison is always boolean-typed, but there might be
+differences in mode-size.  */
+  && useless_type_conversion_p (TREE_TYPE (name),
+   TREE_TYPE (gimple_assign_rhs1 (stmt
+{
+  tree tmp2;
+
+  /* Normalize to reduce cases.  */
+  if (!integer_zerop (gimple_assign_rhs2 (stmt)))
+code = (code == EQ_EXPR ? NE_EXPR : EQ_EXPR);
+  tmp = gimple_assign_rhs1 (stmt);
+  tmp2 = NULL_TREE;
+
+  /* Convert X == 0 -> ~X for 1-bit precision boolean-type.
+Otherwise convert X == 0 -> X ^ 1.  */
+  if (code == EQ_EXPR)
+   {
+ if (TYPE_PRECISION (TREE_TYPE (tmp)) == 1)
+   code = BIT_NOT_EXPR;
+ else
+   {
+ code = BIT_XOR_EXPR;
+ tmp2 = build_one_cst (TREE_TYPE (tmp));
+   }
+   }
+  else
+   code = TREE_CODE (tmp);
+  gsi = gsi_for_stmt (stmt);
+  gimple_assign_set_rhs_with_ops (&gsi, code,
+ tmp, tmp2);
+  update_stmt (stmt);
+  return true;
+}
+
   /* Don't propagate ssa names that occur in abnormal phis.  */
   if ((TREE_CODE (gimple_assign_rhs1 (stmt)) == SSA_NAME
&& SSA_NAME_OCCURS_IN_ABNORMAL_PHI (gimple_assign_rhs1 (stmt)))
@@ -1179,7 +1229,8 @@ forward_propagate_comparison (gimple stm
 }

   /* Remove defining statements.  */
-  return remove_prop_source_from_use (name);
+  remove_prop_source_from_use (name);
+  return true;
 }


@@ 

PR ada/49940 [4.5/4.6/4.7 regression] Bootstrapping on x86_64-pc-kfreebsd-gnu fails with "s-taprop.adb:717:32: "lwp_self" is undefined"

2011-08-02 Thread Ludovic Brenta
I think the following fixes this PR; it consists only in duplicating a
few lines from s-osinte-freebsd.ads to s-osinte-kfreebsd-gnu.ads:

Index: b/src/gcc/ada/s-osinte-kfreebsd-gnu.ads
===
--- a/src/gcc/ada/s-osinte-kfreebsd-gnu.ads
+++ b/src/gcc/ada/s-osinte-kfreebsd-gnu.ads
@@ -238,6 +238,16 @@
function getpid return pid_t;
pragma Import (C, getpid, "getpid");
 
+   -
+   -- LWP --
+   -
+
+   function lwp_self return System.Address;
+   --  lwp_self does not exist on this thread library, revert to pthread_self
+   --  which is the closest approximation (with getpid). This function is
+   --  needed to share 7staprop.adb across POSIX-like targets.
+   pragma Import (C, lwp_self, "pthread_self");
+
-
-- Threads --
-
Index: b/src/gcc/ada/ChangeLog
===
--- a/src/gcc/ada/ChangeLog
+++ b/src/gcc/ada/ChangeLog
@@ -0,0 +1,6 @@
+2011-08-02  Ludovic Brenta  
+
+   PR ada/49940
+   * s-osinte-kfreebsd-gnu.ads (lwp_self): import pthread_self, as on
+   FreeBSD.
+




-- 
Ludovic Brenta.


[Patch,AVR]: Cleanup libgcc.S

2011-08-02 Thread Georg-Johann Lay
This patch fixes RCALL/RJMP instructions to other modules by replacing them
with XCALL resp. XJMP.

Moreover, now each function (except _cleanup) is enclosed in DEFUN/ENDF pairs
so that size information is available for each function.

Ok?

Johann

* config/avr/libgcc.S: Gather related function in the
same input section.
(__mulqihi3, __mulqihi3, __divmodqi4, __divmodhi4, __udivmodsi4,
__divmodsi4): Use XCALL/XJMP instead of rcall/rjmp for external
references.
(__udivmodqi4, __divmodqi4, __udivmodhi4, __divmodhi4,
__udivmodsi4, __divmodsi4, __prologue_saves__,
__epilogue_restores__, _exit, __tablejump2__, __tablejump__,
__do_copy_data, __do_clear_bss, __do_global_ctors,
__do_global_dtors, __tablejump_elpm__): Enclose in DEFUN/ENDF.
Index: config/avr/libgcc.S
===
--- config/avr/libgcc.S	(revision 177070)
+++ config/avr/libgcc.S	(working copy)
@@ -34,7 +34,15 @@ see the files COPYING3 and COPYING.RUNTI
This can make better code because GCC knows exactly which
of the call-used registers (not all of them) are clobbered.  */
 
-	.section .text.libgcc, "ax", @progbits
+/* FIXME:  At present, there is no SORT directive in the linker
+   script so that we must not assume that different modules
+   in the same input section like .libgcc.text.mul will be
+   located close together.  Therefore, we cannot use
+   RCALL/RJMP to call a function like __udivmodhi4 from
+   __divmodhi4 and have to use lengthy XCALL/XJMP even
+   though they are in the same input section and all same
+   input sections together are small enough to reach every
+   location with a RCALL/RJMP instruction.  */
 
 	.macro	mov_l  r_dest, r_src
 #if defined (__AVR_HAVE_MOVW__)
@@ -72,6 +80,8 @@ see the files COPYING3 and COPYING.RUNTI
 .endm
 
 
+.section .text.libgcc.mul, "ax", @progbits
+
 ;;
 /* Note: mulqi3, mulhi3 are open-coded on the enhanced core.  */
 #if !defined (__AVR_HAVE_MUL__)
@@ -112,7 +122,7 @@ DEFUN __mulqihi3
 	clr	r23
 	sbrc	r22, 7
 	dec	r22
-	rjmp	__mulhi3
+	XJMP	__mulhi3
 ENDF __mulqihi3:
 #endif /* defined (L_mulqihi3) */
 
@@ -120,7 +130,7 @@ ENDF __mulqihi3:
 DEFUN __umulqihi3
 	clr	r25
 	clr	r23
-	rjmp	__mulhi3
+	XJMP	__mulhi3
 ENDF __umulqihi3
 #endif /* defined (L_umulqihi3) */
 
@@ -447,6 +457,8 @@ ENDF __mulsi3
 ;;
 	
 
+.section .text.libgcc.div, "ax", @progbits
+
 /***
Division 8 / 8 => (result + remainder)
 ***/
@@ -456,9 +468,7 @@ ENDF __mulsi3
 #define	r_cnt	r23	/* loop count */
 
 #if defined (L_udivmodqi4)
-	.global	__udivmodqi4
-	.func	__udivmodqi4
-__udivmodqi4:
+DEFUN __udivmodqi4
 	sub	r_rem,r_rem	; clear remainder and carry
 	ldi	r_cnt,9		; init loop counter
 	rjmp	__udivmodqi4_ep	; jump to entry point
@@ -474,13 +484,11 @@ __udivmodqi4_ep:
 	com	r_arg1		; complement result 
 ; because C flag was complemented in loop
 	ret
-	.endfunc
+ENDF __udivmodqi4
 #endif /* defined (L_udivmodqi4) */
 
 #if defined (L_divmodqi4)
-	.global	__divmodqi4
-	.func	__divmodqi4
-__divmodqi4:
+DEFUN __divmodqi4
 bst r_arg1,7	; store sign of dividend
 mov __tmp_reg__,r_arg1
 eor __tmp_reg__,r_arg2; r0.7 is sign of result
@@ -488,7 +496,7 @@ __divmodqi4:
 	neg r_arg1		; dividend negative : negate
 sbrc	r_arg2,7
 	neg r_arg2		; divisor negative : negate
-	rcall	__udivmodqi4	; do the unsigned div/mod
+	XCALL	__udivmodqi4	; do the unsigned div/mod
 	brtc	__divmodqi4_1
 	neg	r_rem		; correct remainder sign
 __divmodqi4_1:
@@ -496,7 +504,7 @@ __divmodqi4_1:
 	neg	r_arg1		; correct result sign
 __divmodqi4_exit:
 	ret
-	.endfunc
+ENDF __divmodqi4
 #endif /* defined (L_divmodqi4) */
 
 #undef r_rem
@@ -522,9 +530,7 @@ __divmodqi4_exit:
 #define	r_cnt	r21	/* loop count */
 
 #if defined (L_udivmodhi4)
-	.global	__udivmodhi4
-	.func	__udivmodhi4
-__udivmodhi4:
+DEFUN __udivmodhi4
 	sub	r_remL,r_remL
 	sub	r_remH,r_remH	; clear remainder and carry
 	ldi	r_cnt,17	; init loop counter
@@ -550,13 +556,11 @@ __udivmodhi4_ep:
 	mov_l	r_arg1L, r_remL		; remainder
 	mov_h	r_arg1H, r_remH
 	ret
-	.endfunc
+ENDF __udivmodhi4
 #endif /* defined (L_udivmodhi4) */
 
 #if defined (L_divmodhi4)
-	.global	__divmodhi4
-	.func	__divmodhi4
-__divmodhi4:
+DEFUN __divmodhi4
 	.global	_div
 _div:
 bst r_arg1H,7	; store sign of dividend
@@ -565,7 +569,7 @@ _div:
 	rcall	__divmodhi4_neg1 ; dividend negative : negate
 	sbrc	r_arg2H,7
 	rcall	__divmodhi4_neg2 ; divisor negative : negate
-	rcall	__udivmodhi4	; do the unsigned div/mod
+	XCALL	__udivmodhi4	; do the unsigned div/mod
 	rcall	__divmodhi4_neg1 ; correct remainder sign
 	tst	__tmp_reg__
 	brpl	__divmodhi4_exit
@@ 

Re: [GCC-MELT-137] Re: [MELT] split_string_* functions now take a value

2011-08-02 Thread Romain Geissler
Here is the fix git patch.


2011/8/2 Basile Starynkevitch :
> On Tue, 2 Aug 2011 10:46:38 +0200
> Romain Geissler  wrote:
>
>> 2011/8/2 Basile Starynkevitch :
>> > Please use capitals for macrovariables in
>> > macrostrings
>>
>> Ok.
>>
>> Can i have more details about that: is it just a Melt convention or is
>> it an implementation requirement (in other word, does melt awaits
>> macrovariables to be upper case ?)
>
>
> Just a coding (social) convention. Macrovariables are very important, and my 
> editor
> (emacs) and mode (lisp-mode) don't highlight them.
>
> Since macrovariables are really MELT symbols, their case don't matter (the 
> MELT reader
> force them to upper cases). But they are more human-readable in upper cases.
>
> Cheers.
>
> --
> Basile STARYNKEVITCH         http://starynkevitch.net/Basile/
> email: basilestarynkevitchnet mobile: +33 6 8501 2359
> 8, rue de la Faiencerie, 92340 Bourg La Reine, France
> *** opinions {are only mine, sont seulement les miennes} ***
>
From 3e9b3fbbc25634a1f2e0b2b2e1a13c0e3927be31 Mon Sep 17 00:00:00 2001
From: Romain Geissler 
Date: Thu, 28 Jul 2011 12:43:59 +0200
Subject: [PATCH] split_string_* functions now require a value string instead
 of a :cstring.

---
 gcc/melt/warmelt-base.melt   |   24 
 gcc/melt/warmelt-outobj.melt |4 ++--
 2 files changed, 14 insertions(+), 14 deletions(-)

diff --git a/gcc/melt/warmelt-base.melt b/gcc/melt/warmelt-base.melt
index 8a6ff9d..3b068db 100644
--- a/gcc/melt/warmelt-base.melt
+++ b/gcc/melt/warmelt-base.melt
@@ -570,25 +570,25 @@ an integer $I if $I is lower than $N.}#
   #{(meltgc_string_hex_md5sum_file_sequence ((melt_ptr_t) $PATHSEQ))}#)
 
 
-(defprimitive split_string_space (dis :cstring cs) :value
-  :doc #{Split a cstring $CS into a list of space separated strings of
+(defprimitive split_string_space (dis s) :value
+  :doc #{Split a string value $S into a list of space separated strings of
 discriminant $DIS.}#
-#{meltgc_new_split_string($cs, ' ', (melt_ptr_t) $dis)}#)
+#{meltgc_new_split_string (melt_string_str ($S), ' ', (melt_ptr_t) $DIS)}#)
 
-(defprimitive split_string_comma (dis :cstring cs) :value
-  :doc #{Split a cstring $CS into a list of comma separated strings of
+(defprimitive split_string_comma (dis s) :value
+  :doc #{Split a string value $S into a list of comma separated strings of
 discriminant $DIS.}#
-#{meltgc_new_split_string($cs, ',', (melt_ptr_t) $dis)}#)
+#{meltgc_new_split_string (melt_string_str ($S), ',', (melt_ptr_t) $DIS)}#)
 
-(defprimitive split_string_colon (dis :cstring cs) :value
-  :doc #{Split a cstring $CS into a list of colon separated strings of
+(defprimitive split_string_colon (dis s) :value
+  :doc #{Split a string value $S into a list of colon separated strings of
 discriminant $DIS.}#
-#{meltgc_new_split_string($cs, ':', (melt_ptr_t)$dis)}#)
+#{meltgc_new_split_string (melt_string_str ($S), ':', (melt_ptr_t) $DIS)}#)
 
-(defprimitive split_string_equal (dis :cstring cs) :value
-  :doc #{Split a cstring $CS into a list of equal separated strings of
+(defprimitive split_string_equal (dis s) :value
+  :doc #{Split a string value $S into a list of equal separated strings of
 discriminant $DIS.}#
-#{meltgc_new_split_string($cs, '=', (melt_ptr_t)$dis)}#)
+#{meltgc_new_split_string (melt_string_str ($S), '=', (melt_ptr_t) $DIS)}#)
 
 ;;; convert a strbuf into a string
 (defprimitive strbuf2string (dis sbuf) :value
diff --git a/gcc/melt/warmelt-outobj.melt b/gcc/melt/warmelt-outobj.melt
index dd1cdde..df4cf06 100644
--- a/gcc/melt/warmelt-outobj.melt
+++ b/gcc/melt/warmelt-outobj.melt
@@ -4671,7 +4671,7 @@ has basic debug support thru debug_msg, assert_msg..."
 	 (inarg (cond ( progarg 
 			(make_stringconst discr_string progarg))
 		  ( progarglist
-			 (split_string_comma discr_string progarglist)
+			 (split_string_comma discr_string (make_stringconst discr_string progarglist))
 			)
 		  (:else
 		   (errormsg_plain "invalid arg or arglist to translateinit mode")
@@ -5800,7 +5800,7 @@ has basic debug support thru debug_msg, assert_msg..."
   (let ( 
 	(parmodenv (parent_module_environment))
 	(curenv (if moduldata moduldata initial_environment))
-	(arglist (split_string_comma discr_string (melt_argument "arglist")))
+	(arglist (split_string_comma discr_string (make_stringconst discr_string (melt_argument "arglist"
 	(outarg (make_stringconst discr_string (melt_argument "output")))
 	(rlist (make_list discr_list))
 	(mdinfo 
-- 
1.7.6



[Ada] Reduce compilation time at -O0 (3/n)

2011-08-02 Thread Arnaud Charlet
This patch significantly reduces compilation time at -O0 in typical conditions
by short-circuiting calls to the somewhat costly Is_RTE function when they are
not necessary.

No functional changes.

Tested on x86_64-pc-linux-gnu, committed on trunk

2011-08-02  Eric Botcazou  

* exp_ch6.adb (Expand_Call): Guard restriction checks with a call
to Restriction_Check_Required.
* sem_ch3.adb (Analyze_Object_Declaration): Likewise.
* sem_res.adb (Resolve_Call): Likewise.
* sem_attr.adb (Check_Stream_Attribute): Likewise.

Index: sem_ch3.adb
===
--- sem_ch3.adb (revision 177124)
+++ sem_ch3.adb (working copy)
@@ -3671,8 +3671,9 @@
 
   --  Check for violation of No_Local_Timing_Events
 
-  if Is_RTE (Etype (Id), RE_Timing_Event)
+  if Restriction_Check_Required (No_Local_Timing_Events)
 and then not Is_Library_Level_Entity (Id)
+and then Is_RTE (Etype (Id), RE_Timing_Event)
   then
  Check_Restriction (No_Local_Timing_Events, N);
   end if;
Index: sem_res.adb
===
--- sem_res.adb (revision 177127)
+++ sem_res.adb (working copy)
@@ -5702,9 +5702,10 @@
   --  Check for violation of restriction No_Specific_Termination_Handlers
   --  and warn on a potentially blocking call to Abort_Task.
 
-  if Is_RTE (Nam, RE_Set_Specific_Handler)
-   or else
- Is_RTE (Nam, RE_Specific_Handler)
+  if Restriction_Check_Required (No_Specific_Termination_Handlers)
+and then (Is_RTE (Nam, RE_Set_Specific_Handler)
+or else
+  Is_RTE (Nam, RE_Specific_Handler))
   then
  Check_Restriction (No_Specific_Termination_Handlers, N);
 
@@ -5717,7 +5718,8 @@
   --  need to check the second argument to determine whether it is an
   --  absolute or relative timing event.
 
-  if Is_RTE (Nam, RE_Set_Handler)
+  if Restriction_Check_Required (No_Relative_Delay)
+and then Is_RTE (Nam, RE_Set_Handler)
 and then Is_RTE (Etype (Next_Actual (First_Actual (N))), RE_Time_Span)
   then
  Check_Restriction (No_Relative_Delay, N);
Index: sem_attr.adb
===
--- sem_attr.adb(revision 177118)
+++ sem_attr.adb(working copy)
@@ -1646,9 +1646,10 @@
  --  Check special case of Exception_Id and Exception_Occurrence which
  --  are not allowed for restriction No_Exception_Registration.
 
- if Is_RTE (P_Type, RE_Exception_Id)
-  or else
-Is_RTE (P_Type, RE_Exception_Occurrence)
+ if Restriction_Check_Required (No_Exception_Registration)
+   and then (Is_RTE (P_Type, RE_Exception_Id)
+   or else
+ Is_RTE (P_Type, RE_Exception_Occurrence))
  then
 Check_Restriction (No_Exception_Registration, P);
  end if;
Index: exp_ch6.adb
===
--- exp_ch6.adb (revision 177121)
+++ exp_ch6.adb (working copy)
@@ -2936,12 +2936,15 @@
 
   --  Check for violation of No_Abort_Statements
 
-  if Is_RTE (Subp, RE_Abort_Task) then
+  if Restriction_Check_Required (No_Abort_Statements)
+and then Is_RTE (Subp, RE_Abort_Task)
+  then
  Check_Restriction (No_Abort_Statements, Call_Node);
 
   --  Check for violation of No_Dynamic_Attachment
 
-  elsif RTU_Loaded (Ada_Interrupts)
+  elsif Restriction_Check_Required (No_Dynamic_Attachment)
+and then RTU_Loaded (Ada_Interrupts)
 and then (Is_RTE (Subp, RE_Is_Reserved)  or else
   Is_RTE (Subp, RE_Is_Attached)  or else
   Is_RTE (Subp, RE_Current_Handler)  or else


[Ada] Help the backend to identify safe-to-reevaluate variables

2011-08-02 Thread Arnaud Charlet
This patch does not affect the behavior of the compiler. It
adds a new attribute that is used to help the backend to
identify temporary variables internally generated by
the frontend which can be safely reevaluated.

No test required.

Tested on x86_64-pc-linux-gnu, committed on trunk

2011-08-02  Javier Miranda  

* einfo.ads, einfo.adb (Is_Safe_To_Reevaluate): new function.
(Set_Is_Safe_To_Reevaluate): new procedure.
* sem_ch5.adb (Analyze_Assignment): Add one assertion to ensure that no
assignment is allowed on safe-to-reevaluate variables.
(Analyze_Iteration_Schine.Process_Bounds.One_Bound): Decorate the
temporary created to remove side effects in expressions that use
the secondary stack as safe-to-reevaluate.
* exp_util.adb (Side_Effect_Free): Add missing code to handle well
variables that are not true constants.

Index: sem_ch5.adb
===
--- sem_ch5.adb (revision 177127)
+++ sem_ch5.adb (working copy)
@@ -257,6 +257,13 @@
   Analyze (Rhs);
   Analyze (Lhs);
 
+  --  Ensure that we never do an assignment on a variable marked as
+  --  as Safe_To_Reevaluate.
+
+  pragma Assert (not Is_Entity_Name (Lhs)
+or else Ekind (Entity (Lhs)) /= E_Variable
+or else not Is_Safe_To_Reevaluate (Entity (Lhs)));
+
   --  Start type analysis for assignment
 
   T1 := Etype (Lhs);
@@ -1603,7 +1610,7 @@
 Id := Make_Temporary (Loc, 'R', Original_Bound);
 
 --  Here we make a declaration with a separate assignment
---   statement, and insert before loop header.
+--  statement, and insert before loop header.
 
 Decl :=
   Make_Object_Declaration (Loc,
@@ -1625,6 +1632,15 @@
 
 Insert_Actions (Parent (N), New_List (Decl, Assign));
 
+--  Now that this temporary variable is initialized we decorate it
+--  as safe-to-reevaluate to inform to the backend that no further
+--  asignment will be issued and hence it can be handled as side
+--  effect free. Note that this decoration must be done when the
+--  assignment has been analyzed because otherwise it will be
+--  rejected (see Analyze_Assignment).
+
+Set_Is_Safe_To_Reevaluate (Id);
+
 Rewrite (Original_Bound, New_Occurrence_Of (Id, Loc));
 
 if Nkind (Assign) = N_Assignment_Statement then
Index: exp_util.adb
===
--- exp_util.adb(revision 177120)
+++ exp_util.adb(working copy)
@@ -69,20 +69,20 @@
   Id_Ref : Node_Id;
   A_Type : Entity_Id;
   Dyn: Boolean := False) return Node_Id;
-   --  Build function to generate the image string for a task that is an
-   --  array component, concatenating the images of each index. To avoid
-   --  storage leaks, the string is built with successive slice assignments.
-   --  The flag Dyn indicates whether this is called for the initialization
-   --  procedure of an array of tasks, or for the name of a dynamically
-   --  created task that is assigned to an indexed component.
+   --  Build function to generate the image string for a task that is an array
+   --  component, concatenating the images of each index. To avoid storage
+   --  leaks, the string is built with successive slice assignments. The flag
+   --  Dyn indicates whether this is called for the initialization procedure of
+   --  an array of tasks, or for the name of a dynamically created task that is
+   --  assigned to an indexed component.
 
function Build_Task_Image_Function
  (Loc   : Source_Ptr;
   Decls : List_Id;
   Stats : List_Id;
   Res   : Entity_Id) return Node_Id;
-   --  Common processing for Task_Array_Image and Task_Record_Image.
-   --  Build function body that computes image.
+   --  Common processing for Task_Array_Image and Task_Record_Image. Build
+   --  function body that computes image.
 
procedure Build_Task_Image_Prefix
   (Loc: Source_Ptr;
@@ -93,34 +93,34 @@
Sum: Node_Id;
Decls  : List_Id;
Stats  : List_Id);
-   --  Common processing for Task_Array_Image and Task_Record_Image.
-   --  Create local variables and assign prefix of name to result string.
+   --  Common processing for Task_Array_Image and Task_Record_Image. Create
+   --  local variables and assign prefix of name to result string.
 
function Build_Task_Record_Image
  (Loc: Source_Ptr;
   Id_Ref : Node_Id;
   Dyn: Boolean := False) return Node_Id;
-   --  Build function to generate the image string for a task that is a
-   --  record component. Concatenate name of variable with that of selector.
-   --  The flag Dyn indicates whether this is called for the initialization
-   --  procedure of record with task components, or for a dynamically
-   --  

Re: [PATCH][2/2][RFC] Fix PR49806, promote/demote binary operations in VRP

2011-08-02 Thread Richard Guenther
On Tue, 2 Aug 2011, Ira Rosen wrote:

> 
> > +   /* Now we have matched the statement pattern
> > +
> > +rhs1 = (T1)x;
> > +rhs2 = (T1)y;
> > +op_result = rhs1 OP rhs2;
> > +lhs = (T2)op_result;
> 
> Just a note that the patch I proposed for the vectorizer (
> http://gcc.gnu.org/ml/gcc-patches/2011-07/msg01472.html) also handles
> constants, multiple statements (i.e., op_result doesn't have to be promoted
> itself, but the sequence needs to end up with a promotion), and also it may
> use an intermediate type for OP. The tests in my patch don't match the
> pattern this patch detects.

Ok, I only looked at the description of your patch, not the patch itself.

The patch already handles constant 2nd operands.

It shouldn't be difficult to handle multiple statements here, either by
instead of the above match only

op_result = rhs1 OP rhs2;
lhs = (T2)op_result;

and thus allow iteration on the promoted/demoted operation operands
or by collecting all defs first.

Do you handle arbitrary def trees or only a linear chain as suggested
by

+ S2  x_T = (TYPE) x_t;
+ S3  res0_T = op (x_T, C0);
+ S4  res1_T = op (res0_T, C1);
+ S5  ... = () res1_T;  - type demotion

?  Thus, do you handle res1_T = op (res0_T, res2_T) with a possibly
different TYPE in its def?  The case of

op_result = rhs1 OP CST;
lhs = (T2)op_result;

is probably always profitable to demote to

rhs1' = (T2)rhs1;
lhs = rhs1' OP (T2)CST;

and "iterating" that should be simple (handling two variable
operands will probably get a bit convoluted).

Thanks,
Richard.


[Ada] Add_To_Result routine (internal cleanup)

2011-08-02 Thread Arnaud Charlet
This is an internal clean up to factor some repeated coce,
no external effect.

Tested on x86_64-pc-linux-gnu, committed on trunk

2011-08-02  Robert Dewar  

* freeze.adb (Add_To_Result): New procedure.

Index: freeze.adb
===
--- freeze.adb  (revision 177122)
+++ freeze.adb  (working copy)
@@ -1502,14 +1502,19 @@
   Test_E : Entity_Id := E;
   Comp   : Entity_Id;
   F_Node : Node_Id;
-  Result : List_Id;
   Indx   : Node_Id;
   Formal : Entity_Id;
   Atype  : Entity_Id;
 
+  Result : List_Id := No_List;
+  --  List of freezing actions, left at No_List if none
+
   Has_Default_Initialization : Boolean := False;
   --  This flag gets set to true for a variable with default initialization
 
+  procedure Add_To_Result (N : Node_Id);
+  --  N is a freezing action to be appended to the Result
+
   procedure Check_Current_Instance (Comp_Decl : Node_Id);
   --  Check that an Access or Unchecked_Access attribute with a prefix
   --  which is the current instance type can only be applied when the type
@@ -1528,6 +1533,19 @@
   --  Freeze each component, handle some representation clauses, and freeze
   --  primitive operations if this is a tagged type.
 
+  ---
+  -- Add_To_Result --
+  ---
+
+  procedure Add_To_Result (N : Node_Id) is
+  begin
+ if No (Result) then
+Result := New_List (N);
+ else
+Append (N, Result);
+ end if;
+  end Add_To_Result;
+
   
   -- After_Last_Declaration --
   
@@ -1769,12 +1787,7 @@
then
   IR := Make_Itype_Reference (Sloc (Comp));
   Set_Itype (IR, Desig);
-
-  if No (Result) then
- Result := New_List (IR);
-  else
- Append (IR, Result);
-  end if;
+  Add_To_Result (IR);
end if;
 
 elsif Ekind (Typ) = E_Anonymous_Access_Subprogram_Type
@@ -2421,7 +2434,6 @@
 
   --  Here to freeze the entity
 
-  Result := No_List;
   Set_Is_Frozen (E);
 
   --  Case of entity being frozen is other than a type
@@ -3602,11 +3614,7 @@
 
begin
   Set_Itype (Ref, E);
-  if No (Result) then
- Result := New_List (Ref);
-  else
- Append (Ref, Result);
-  end if;
+  Add_To_Result (Ref);
end;
 end if;
 
@@ -4052,13 +4060,8 @@
  end if;
 
  Set_Entity (F_Node, E);
+ Add_To_Result (F_Node);
 
- if Result = No_List then
-Result := New_List (F_Node);
- else
-Append (F_Node, Result);
- end if;
-
  --  A final pass over record types with discriminants. If the type
  --  has an incomplete declaration, there may be constrained access
  --  subtypes declared elsewhere, which do not depend on the discrimi-
@@ -4135,6 +4138,8 @@
  --  subprogram in main unit, generate descriptor if we are in
  --  Propagate_Exceptions mode.
 
+ --  This is very odd code, it makes a null result, why ???
+
  elsif Propagate_Exceptions
and then Is_Imported (E)
and then not Is_Intrinsic_Subprogram (E)


[Ada] gnatmake fails with incorrect default config project file

2011-08-02 Thread Arnaud Charlet
When a default config project file (for example default.cgpr in
.../share/gpr) exists, gnatmake was parsing it, and would fail if, for
example, Default_Language was not declared.
This patch ensures that an existing config project file is never taken
into account by gnatmake.
The test is to invoke gnatmake with an empty config project file
default.cgpr in the project directory: gnatmake should not fail because
of the presence of this empty config project file.

Tested on x86_64-pc-linux-gnu, committed on trunk

2011-08-02  Vincent Celier  

* prj-conf.adb (Get_Or_Create_Configuration_File): If On_Load_Config is
not null, call it to create the in memory config project file without
parsing an existing default config project file.

Index: prj-conf.adb
===
--- prj-conf.adb(revision 177054)
+++ prj-conf.adb(working copy)
@@ -1107,7 +1107,12 @@
  Write_Line (Config_File_Path.all);
   end if;
 
-  if Config_File_Path /= null then
+  if On_Load_Config /= null then
+ On_Load_Config
+   (Config_File   => Config_Project_Node,
+Project_Node_Tree => Project_Node_Tree);
+
+  elsif Config_File_Path /= null then
  Prj.Part.Parse
(In_Tree=> Project_Node_Tree,
 Project=> Config_Project_Node,
@@ -1119,16 +1124,9 @@
 Flags  => Flags,
 Target_Name=> Target_Name);
   else
- --  Maybe the user will want to create his own configuration file
  Config_Project_Node := Empty_Node;
   end if;
 
-  if On_Load_Config /= null then
- On_Load_Config
-   (Config_File   => Config_Project_Node,
-Project_Node_Tree => Project_Node_Tree);
-  end if;
-
   if Config_Project_Node /= Empty_Node then
  Prj.Proc.Process_Project_Tree_Phase_1
(In_Tree=> Project_Tree,


[Ada] Do not use specific stream routines for strings when not available

2011-08-02 Thread Arnaud Charlet
When using a configurable run time, it is very likely that stream routines
for string types are not present (they require file system support). In this
case, the specific stream routines for strings are not used, relying on the
regular stream mechanism instead.

This patch changes only the behaviour of configurable run times, not the
standard ones, so no test needed.

Tested on x86_64-pc-linux-gnu, committed on trunk

2011-08-02  Jose Ruiz  

* exp_attr.adb (Find_Stream_Subprogram): When using a configurable run
time, if the specific run-time routines for handling streams of strings
are not available, use the default mechanism.

Index: exp_attr.adb
===
--- exp_attr.adb(revision 177026)
+++ exp_attr.adb(working copy)
@@ -5517,6 +5517,21 @@
   Base_Typ : constant Entity_Id := Base_Type (Typ);
   Ent  : constant Entity_Id := TSS (Typ, Nam);
 
+  function Is_Available (Entity : RE_Id) return Boolean;
+  pragma Inline (Is_Available);
+  --  Function to check whether the specified run-time call is available
+  --  in the run time used. In the case of a configurable run time, it
+  --  is normal that some subprograms are not there.
+
+  function Is_Available (Entity : RE_Id) return Boolean is
+  begin
+ --  Assume that the unit will always be available when using a
+ --  "normal" (not configurable) run time.
+
+ return not Configurable_Run_Time_Mode
+   or else RTE_Available (Entity);
+  end Is_Available;
+
begin
   if Present (Ent) then
  return Ent;
@@ -5535,6 +5550,12 @@
   --  This is disabled for AAMP, to avoid creating dependences on files not
   --  supported in the AAMP library (such as s-fileio.adb).
 
+  --  In the case of using a configurable run time, it is very likely
+  --  that stream routines for string types are not present (they require
+  --  file system support). In this case, the specific stream routines for
+  --  strings are not used, relying on the regular stream mechanism
+  --  instead.
+
   if VM_Target /= JVM_Target
 and then not AAMP_On_Target
 and then
@@ -5544,31 +5565,61 @@
 
  if Base_Typ = Standard_String then
 if Restriction_Active (No_Stream_Optimizations) then
-   if Nam = TSS_Stream_Input then
+   if Nam = TSS_Stream_Input
+ and then Is_Available (RE_String_Input)
+   then
   return RTE (RE_String_Input);
 
-   elsif Nam = TSS_Stream_Output then
+   elsif Nam = TSS_Stream_Output
+ and then Is_Available (RE_String_Output)
+   then
   return RTE (RE_String_Output);
 
-   elsif Nam = TSS_Stream_Read then
+   elsif Nam = TSS_Stream_Read
+ and then Is_Available (RE_String_Read)
+   then
   return RTE (RE_String_Read);
 
-   else pragma Assert (Nam = TSS_Stream_Write);
+   elsif Nam = TSS_Stream_Write
+ and then Is_Available (RE_String_Write)
+   then
   return RTE (RE_String_Write);
+
+   elsif Nam /= TSS_Stream_Input and then
+ Nam /= TSS_Stream_Output and then
+ Nam /= TSS_Stream_Read and then
+ Nam /= TSS_Stream_Write
+   then
+  raise Program_Error;
end if;
 
 else
-   if Nam = TSS_Stream_Input then
+   if Nam = TSS_Stream_Input
+ and then Is_Available (RE_String_Input_Blk_IO)
+   then
   return RTE (RE_String_Input_Blk_IO);
 
-   elsif Nam = TSS_Stream_Output then
+   elsif Nam = TSS_Stream_Output
+ and then Is_Available (RE_String_Output_Blk_IO)
+   then
   return RTE (RE_String_Output_Blk_IO);
 
-   elsif Nam = TSS_Stream_Read then
+   elsif Nam = TSS_Stream_Read
+ and then Is_Available (RE_String_Read_Blk_IO)
+   then
   return RTE (RE_String_Read_Blk_IO);
 
-   else pragma Assert (Nam = TSS_Stream_Write);
+   elsif Nam = TSS_Stream_Write
+ and then Is_Available (RE_String_Write_Blk_IO)
+   then
   return RTE (RE_String_Write_Blk_IO);
+
+   elsif Nam /= TSS_Stream_Input and then
+ Nam /= TSS_Stream_Output and then
+ Nam /= TSS_Stream_Read and then
+ Nam /= TSS_Stream_Write
+   then
+  raise Program_Error;
end if;
 end if;
 
@@ -5576,31 +5627,61 @@
 
  elsif Base_Typ = Standard_Wide_String then
 if Restriction_

[Ada] Reduce compilation time at -O0 (4/n)

2011-08-02 Thread Arnaud Charlet
This patch significantly reduces compilation time at -O0 in typical conditions
by removing useless big local temporaries in Allocate_Initialize_Node.

No functional changes.

Tested on x86_64-pc-linux-gnu, committed on trunk

2011-08-02  Eric Botcazou  

* atree.adb (Allocate_Initialize_Node): Remove useless temporaries.

Index: atree.adb
===
--- atree.adb   (revision 177090)
+++ atree.adb   (working copy)
@@ -481,34 +481,25 @@
  (Src: Node_Id;
   With_Extension : Boolean) return Node_Id
is
-  New_Id : Node_Id := Src;
-  Nod: Node_Record := Default_Node;
-  Ext1   : Node_Record := Default_Node_Extension;
-  Ext2   : Node_Record := Default_Node_Extension;
-  Ext3   : Node_Record := Default_Node_Extension;
-  Ext4   : Node_Record := Default_Node_Extension;
+  New_Id : Node_Id;
 
begin
-  if Present (Src) then
- Nod := Nodes.Table (Src);
-
- if Has_Extension (Src) then
-Ext1 := Nodes.Table (Src + 1);
-Ext2 := Nodes.Table (Src + 2);
-Ext3 := Nodes.Table (Src + 3);
-Ext4 := Nodes.Table (Src + 4);
- end if;
-  end if;
-
-  if not (Present (Src)
-   and then not Has_Extension (Src)
-   and then With_Extension
-   and then Src = Nodes.Last)
+  if Present (Src)
+and then not Has_Extension (Src)
+and then With_Extension
+and then Src = Nodes.Last
   then
+ New_Id := Src;
+  else
  --  We are allocating a new node, or extending a node
  --  other than Nodes.Last.
 
- Nodes.Append (Nod);
+ if Present (Src) then
+Nodes.Append (Nodes.Table (Src));
+ else
+Nodes.Append (Default_Node);
+ end if;
+
  New_Id := Nodes.Last;
  Orig_Nodes.Append (New_Id);
  Node_Count := Node_Count + 1;
@@ -524,10 +515,15 @@
   --  Set extension nodes if required
 
   if With_Extension then
- Nodes.Append (Ext1);
- Nodes.Append (Ext2);
- Nodes.Append (Ext3);
- Nodes.Append (Ext4);
+ if Present (Src) and then Has_Extension (Src) then
+for J in 1 .. 4 loop
+   Nodes.Append (Nodes.Table (Src + Node_Id (J)));
+end loop;
+ else
+for J in 1 .. 4 loop
+   Nodes.Append (Default_Node_Extension);
+end loop;
+ end if;
   end if;
 
   Orig_Nodes.Set_Last (Nodes.Last);


[patch tree-optimization]: Add cleanup code for possible unused statements in binary optimization

2011-08-02 Thread Kai Tietz
Hello,

this patch adds some statement-cleanup to forward-propagation.

ChangeLog

2011-08-02  Kai Tietz  

* tree-ssa-forwprop.c (simplify_bitwise_binary):
Remove possible unused statement after optimization.

2011-08-02  Kai Tietz  

* gcc.dg/tree-ssa/forwprop-9.c: Add test for no int casts.

Bootstrapped and regression-tested for all languages (including Ada
and Obj-C++) on host x86_64-pc-linux-gnu.
Ok for apply?

Regards,
Kai

Index: gcc/gcc/tree-ssa-forwprop.c
===
--- gcc.orig/gcc/tree-ssa-forwprop.c
+++ gcc/gcc/tree-ssa-forwprop.c
@@ -1810,6 +1810,8 @@ simplify_bitwise_binary (gimple_stmt_ite
   gimple_assign_set_rhs_with_ops_1 (gsi, NOP_EXPR,
tem, NULL_TREE, NULL_TREE);
   update_stmt (gsi_stmt (*gsi));
+  if (TREE_CODE (arg1) == SSA_NAME)
+   remove_prop_source_from_use (arg1);
   return true;
 }

@@ -1840,6 +1842,10 @@ simplify_bitwise_binary (gimple_stmt_ite
   gimple_assign_set_rhs_with_ops_1 (gsi, NOP_EXPR,
tem, NULL_TREE, NULL_TREE);
   update_stmt (gsi_stmt (*gsi));
+  if (TREE_CODE (arg1) == SSA_NAME)
+   remove_prop_source_from_use (arg1);
+  if (TREE_CODE (arg2) == SSA_NAME)
+   remove_prop_source_from_use (arg2);
   return true;
 }

@@ -1887,6 +1893,8 @@ simplify_bitwise_binary (gimple_stmt_ite
   gimple_assign_set_rhs1 (stmt, def1_arg1);
   gimple_assign_set_rhs2 (stmt, cst);
   update_stmt (stmt);
+  if (TREE_CODE (arg1) == SSA_NAME)
+   remove_prop_source_from_use (arg1);
   return true;
 }

@@ -1907,6 +1915,10 @@ simplify_bitwise_binary (gimple_stmt_ite
 {
   gimple_assign_set_rhs_from_tree (gsi, res);
   update_stmt (gsi_stmt (*gsi));
+  if (TREE_CODE (arg1) == SSA_NAME)
+   remove_prop_source_from_use (arg1);
+  if (TREE_CODE (arg2) == SSA_NAME)
+   remove_prop_source_from_use (arg2);
   return true;
 }

Index: gcc/gcc/testsuite/gcc.dg/tree-ssa/forwprop-9.c
===
--- gcc.orig/gcc/testsuite/gcc.dg/tree-ssa/forwprop-9.c
+++ gcc/gcc/testsuite/gcc.dg/tree-ssa/forwprop-9.c
@@ -11,4 +11,5 @@ foo (_Bool a, _Bool b, _Bool c

 /* { dg-final { scan-tree-dump-times " == " 0 "forwprop1" } } */
 /* { dg-final { scan-tree-dump-times " != " 0 "forwprop1" } } */
+/* { dg-final { scan-tree-dump-times "\\\(int\\\)" 0 "forwprop1" } } */
 /* { dg-final { cleanup-tree-dump "forwprop1" } } */


[Ada] No style checking in instances

2011-08-02 Thread Arnaud Charlet
This patch turns off style checking in instances.
The following should compile quietly with -gnatyO:
gcc -c -gnatyO -gnatl p.ads
with Ada.Strings.Bounded;
package P is new
  Ada.Strings.Bounded.Generic_Bounded_Length (100);

Tested on x86_64-pc-linux-gnu, committed on trunk

2011-08-02  Bob Duff  

* sem_ch12.adb (Analyze_Package_Instantiation,
Analyze_Subprogram_Instantiation): Turn off style checking while
analyzing an instance. Whatever style checks that apply to the generic
unit should apply, so it makes no sense to apply them in an instance.
This was causing trouble when compiling an instance of a runtime
unit that violates the -gnatyO switch.
* stylesw.adb (Set_Style_Check_Options): "when 'O' =>" was missing from
one of the two case statements, causing spurious errors.

Index: sem_ch12.adb
===
--- sem_ch12.adb(revision 177110)
+++ sem_ch12.adb(working copy)
@@ -2975,6 +2975,8 @@
  return False;
   end Might_Inline_Subp;
 
+  Save_Style_Check : constant Boolean := Style_Check;
+
--  Start of processing for Analyze_Package_Instantiation
 
begin
@@ -2987,6 +2989,12 @@
 
   Instantiation_Node := N;
 
+  --  Turn off style checking in instances. If the check is enabled on the
+  --  generic unit, a warning in an instance would just be noise. If not
+  --  enabled on the generic, then a warning in an instance is just wrong.
+
+  Style_Check := False;
+
   --  Case of instantiation of a generic package
 
   if Nkind (N) = N_Package_Instantiation then
@@ -3571,6 +3579,8 @@
  Set_Defining_Identifier (N, Act_Decl_Id);
   end if;
 
+  Style_Check := Save_Style_Check;
+
<>
   if Has_Aspects (N) then
  Analyze_Aspect_Specifications (N, Act_Decl_Id);
@@ -3585,6 +3595,8 @@
  if Env_Installed then
 Restore_Env;
  end if;
+
+ Style_Check := Save_Style_Check;
end Analyze_Package_Instantiation;
 
--
@@ -4104,6 +4116,8 @@
  end if;
   end Analyze_Instance_And_Renamings;
 
+  Save_Style_Check : constant Boolean := Style_Check;
+
--  Start of processing for Analyze_Subprogram_Instantiation
 
begin
@@ -4117,6 +4131,13 @@
   --  Make node global for error reporting
 
   Instantiation_Node := N;
+
+  --  Turn off style checking in instances. If the check is enabled on the
+  --  generic unit, a warning in an instance would just be noise. If not
+  --  enabled on the generic, then a warning in an instance is just wrong.
+
+  Style_Check := False;
+
   Preanalyze_Actuals (N);
 
   Init_Env;
@@ -4352,6 +4373,8 @@
  Generic_Renamings_HTable.Reset;
   end if;
 
+  Style_Check := Save_Style_Check;
+
<>
   if Has_Aspects (N) then
  Analyze_Aspect_Specifications (N, Act_Decl_Id);
@@ -4366,6 +4389,8 @@
  if Env_Installed then
 Restore_Env;
  end if;
+
+ Style_Check := Save_Style_Check;
end Analyze_Subprogram_Instantiation;
 
-
Index: stylesw.adb
===
--- stylesw.adb (revision 176998)
+++ stylesw.adb (working copy)
@@ -530,6 +530,9 @@
 when 'o' =>
Style_Check_Order_Subprograms := False;
 
+when 'O' =>
+   Style_Check_Missing_Overriding:= False;
+
 when 'p' =>
Style_Check_Pragma_Casing := False;
 


[Ada] Code cleanup

2011-08-02 Thread Arnaud Charlet
This patch extends the functionality of routine Is_Variable to avoid
duplicating part of its code in routine Side_Effect_Free.

No functionality change.

Tested on x86_64-pc-linux-gnu, committed on trunk

2011-08-02  Javier Miranda  

* sem_util.ads, sem_util.adb (Is_Variable): Add a new formal to
determine if the analysis is performed using N or Original_Node (N).
* exp_util.adb (Side_Effect_Free): Code cleanup since the new
functionality of routine Is_Variable avoids code duplication.
* checks.adb (Determine_Range): Handle temporaries generated by
Remove_Side_Effects.

Index: exp_util.adb
===
--- exp_util.adb(revision 177129)
+++ exp_util.adb(working copy)
@@ -4692,32 +4692,12 @@
 
  if Is_Entity_Name (N) then
 
---  If the entity is a constant, it is definitely side effect free.
---  Note that the test of Is_Variable (N) below might be expected
---  to catch this case, but it does not, because this test goes to
---  the original tree, and we may have already rewritten a variable
---  node with a constant as a result of an earlier Force_Evaluation
---  call.
-
-if Ekind_In (Entity (N), E_Constant, E_In_Parameter) then
-   return True;
-
---  Functions are not side effect free
-
-elsif Ekind (Entity (N)) = E_Function then
-   return False;
-
 --  Variables are considered to be a side effect if Variable_Ref
 --  is set or if we have a volatile reference and Name_Req is off.
 --  If Name_Req is True then we can't help returning a name which
 --  effectively allows multiple references in any case.
 
---  Need comment for Is_True_Constant test below ???
-
-elsif Is_Variable (N)
-   or else (Ekind (Entity (N)) = E_Variable
-  and then not Is_True_Constant (Entity (N)))
-then
+if Is_Variable (N, Use_Original_Node => False) then
return not Variable_Ref
  and then (not Is_Volatile_Reference (N) or else Name_Req);
 
Index: checks.adb
===
--- checks.adb  (revision 177053)
+++ checks.adb  (working copy)
@@ -3087,6 +3087,20 @@
--  Start of processing for Determine_Range
 
begin
+  --  For temporary constants internally generated to remove side effects
+  --  we must use the corresponding expression to determine the range of
+  --  the expression.
+
+  if Is_Entity_Name (N)
+and then Nkind (Parent (Entity (N))) = N_Object_Declaration
+and then Ekind (Entity (N)) = E_Constant
+and then Is_Internal_Name (Chars (Entity (N)))
+  then
+ Determine_Range
+   (Expression (Parent (Entity (N))), OK, Lo, Hi, Assume_Valid);
+ return;
+  end if;
+
   --  Prevent junk warnings by initializing range variables
 
   Lo  := No_Uint;
Index: sem_util.adb
===
--- sem_util.adb(revision 177127)
+++ sem_util.adb(working copy)
@@ -7508,15 +7508,12 @@
-- Is_Variable --
-
 
-   function Is_Variable (N : Node_Id) return Boolean is
+   function Is_Variable
+ (N : Node_Id;
+  Use_Original_Node : Boolean := True) return Boolean
+   is
+  Orig_Node : Node_Id;
 
-  Orig_Node : constant Node_Id := Original_Node (N);
-  --  We do the test on the original node, since this is basically a test
-  --  of syntactic categories, so it must not be disturbed by whatever
-  --  rewriting might have occurred. For example, an aggregate, which is
-  --  certainly NOT a variable, could be turned into a variable by
-  --  expansion.
-
   function In_Protected_Function (E : Entity_Id) return Boolean;
   --  Within a protected function, the private components of the enclosing
   --  protected type are constants. A function nested within a (protected)
@@ -7580,6 +7577,18 @@
--  Start of processing for Is_Variable
 
begin
+  --  Check if we perform the test on the original node since this may be a
+  --  test of syntactic categories which must not be disturbed by whatever
+  --  rewriting might have occurred. For example, an aggregate, which is
+  --  certainly NOT a variable, could be turned into a variable by
+  --  expansion.
+
+  if Use_Original_Node then
+ Orig_Node := Original_Node (N);
+  else
+ Orig_Node := N;
+  end if;
+
   --  Definitely OK if Assignment_OK is set. Since this is something that
   --  only gets set for expanded nodes, the test is on N, not Orig_Node.
 
Index: sem_util.ads
===
--- s

[Ada] Missing expansion of equality operators in pre/post conditions

2011-08-02 Thread Arnaud Charlet
The frontend does not expand record equalities found in Ada 2012 pre/post
conditions. After this patch the execution of the following test fails
the postcondition (as expected).

procedure Old_Bug is

   type Val is new Integer;
   type Index is new Integer range 1 .. 10;
   type Point is record X, Y : Val; end record;
   type Points is array (Index) of Point;

   procedure Set_X_Of_Nth (P : in out Points; V : Val; N : Index) with
 Post => (for all M in Index => P(M) = P'Old(M)); --  Test

   procedure Set_X_Of_Nth (P : in out Points; V : Val; N : Index) is
   begin
  P (N).X := V;
   end;

   Here : Points := (others => (0,0));
begin
   Set_X_Of_Nth (Here, 5, 5);
end;

Command: gnatmake -q -gnata -gnat12 old_bug; ./old_bug
Output:  raised SYSTEM.ASSERTIONS.ASSERT_FAILURE : failed postcondition
 from old_bug.adb:9

Tested on x86_64-pc-linux-gnu, committed on trunk

2011-08-02  Javier Miranda  

* exp_ch4.adb (Expand_N_Quantified_Expression): Force reanalysis and
expansion of the condition. Required since the previous analysis was
done with expansion disabled (see Resolve_Quantified_Expression) and
hence checks were not inserted and record comparisons have not been
expanded.

Index: exp_ch4.adb
===
--- exp_ch4.adb (revision 177087)
+++ exp_ch4.adb (working copy)
@@ -7502,6 +7502,13 @@
 
   Cond := Relocate_Node (Condition (N));
 
+  --  Reset flag analyzed in the condition to force its analysis. Required
+  --  since the previous analysis was done with expansion disabled (see
+  --  Resolve_Quantified_Expression) and hence checks were not inserted
+  --  and record comparisons have not been expanded.
+
+  Reset_Analyzed_Flags (Cond);
+
   if Is_Universal then
  Cond := Make_Op_Not (Loc, Cond);
   end if;


Re: [patch tree-optimization]: Avoid !=/== 0/1 comparisons for boolean-typed argument

2011-08-02 Thread Richard Guenther
On Tue, Aug 2, 2011 at 12:17 PM, Kai Tietz  wrote:
> Hello,
>
> this patch removes in forward-propagation useless comparisons X != 0
> and X != ~0 for boolean-typed X.  For one-bit precision typed X we
> simplifiy X == 0 (and X != ~0) to ~X, and for X != 0 (and X == ~0) to
> X.
> For none one-bit precisione typed X, we simplify here X == 0 -> X ^ 1,
> and for X != 0 -> X.  We can do this as even for Ada - which has only
> boolean-type with none-one-bit precision - the truth-value is one.

This isn't a simplification but a canonicalization and thus should be
done by fold_stmt instead (we are not propagating anything after all).
In fact, fold_stmt should do parts of this already by means of its
canonicalizations via fold.

> Additionally this patch changes for function
> forward_propagate_comparison the meaning of true-result.  As this
> result wasn't used and it is benefitial to use this propagation also

which is a bug - for a true return value we need to set cfg_changed to true.

> in second loop in function ssa_forward_propagate_and_combine, it
> returns true iff statement was altered.  Additionally this function
> handles now the boolean-typed simplifications.

why call it twice?  How should that be "beneficial"?  I think that
forward_propagate_into_comparison should instead fold the changed
statement.

> For the hunk in gimple.c for function canonicalize_cond_expr_cond:
> This change seems to show no real effect, but IMHO it makes sense to
> add here the check for cast from boolean-type to be consitant.

Probably yes.

Thanks,
Richard.

> ChangeLog
>
> 2011-08-02  Kai Tietz  
>
>        * gimple.c (canonicalize_cond_expr_cond): Handle cast from 
> boolean-type.
>        * tree-ssa-forwprop.c (forward_propagate_comparison): Return
> true iff statement was modified.
>        Handle boolean-typed simplification for EQ_EXPR/NE_EXPR.
>        (ssa_forward_propagate_and_combine): Call
> forward_propagate_comparison for comparisons.
>
> 2011-08-02  Kai Tietz  
>
>        * gcc.dg/tree-ssa/forwprop-9.c: New testcase.
>
>
> Bootstrapped and regression tested for all languages (including Ada
> and Obj-C++) on host x86_64-pc-linux-gnu.  Ok for apply?
>
> Regards,
> Kai
>
> Index: gcc/gcc/gimple.c
> ===
> --- gcc.orig/gcc/gimple.c
> +++ gcc/gcc/gimple.c
> @@ -3160,7 +3160,9 @@ canonicalize_cond_expr_cond (tree t)
>  {
>   /* Strip conversions around boolean operations.  */
>   if (CONVERT_EXPR_P (t)
> -      && truth_value_p (TREE_CODE (TREE_OPERAND (t, 0
> +      && (truth_value_p (TREE_CODE (TREE_OPERAND (t, 0)))
> +          || TREE_CODE (TREE_TYPE (TREE_OPERAND (t, 0)))
> +            == BOOLEAN_TYPE))
>     t = TREE_OPERAND (t, 0);
>
>   /* For !x use x == 0.  */
> Index: gcc/gcc/tree-ssa-forwprop.c
> ===
> --- gcc.orig/gcc/tree-ssa-forwprop.c
> +++ gcc/gcc/tree-ssa-forwprop.c
> @@ -1114,7 +1114,18 @@ forward_propagate_addr_expr (tree name,
>      a_1 = (T')cond_1
>      a_1 = !cond_1
>      a_1 = cond_1 != 0
> -   Returns true if stmt is now unused.  */
> +     For boolean typed comparisons with type-precision of one
> +     X == 0 -> ~X
> +     X != ~0 -> ~X
> +     X != 0 -> X
> +     X == ~0 -> X
> +     For boolean typed comparison with none one-bit type-precision
> +     we can assume that truth-value is one, and false-value is zero.
> +     X == 1 -> X
> +     X != 1 -> X ^ 1
> +     X == 0 -> X ^ 1
> +     X != 0 -> X
> +   Returns true if stmt is changed.  */
>
>  static bool
>  forward_propagate_comparison (gimple stmt)
> @@ -1123,9 +1134,48 @@ forward_propagate_comparison (gimple stm
>   gimple use_stmt;
>   tree tmp = NULL_TREE;
>   gimple_stmt_iterator gsi;
> -  enum tree_code code;
> +  enum tree_code code = gimple_assign_rhs_code (stmt);
>   tree lhs;
>
> +  /* Simplify X != 0 -> X and X == 0 -> ~X, if X is boolean-typed
> +     and X has a compatible type to the comparison-expression.  */
> +  if ((code == EQ_EXPR || code == NE_EXPR)
> +      && TREE_CODE (TREE_TYPE (gimple_assign_rhs1 (stmt))) == BOOLEAN_TYPE
> +      && TREE_CODE (gimple_assign_rhs2 (stmt)) == INTEGER_CST
> +      /* A comparison is always boolean-typed, but there might be
> +        differences in mode-size.  */
> +      && useless_type_conversion_p (TREE_TYPE (name),
> +                                   TREE_TYPE (gimple_assign_rhs1 (stmt
> +    {
> +      tree tmp2;
> +
> +      /* Normalize to reduce cases.  */
> +      if (!integer_zerop (gimple_assign_rhs2 (stmt)))
> +        code = (code == EQ_EXPR ? NE_EXPR : EQ_EXPR);
> +      tmp = gimple_assign_rhs1 (stmt);
> +      tmp2 = NULL_TREE;
> +
> +      /* Convert X == 0 -> ~X for 1-bit precision boolean-type.
> +        Otherwise convert X == 0 -> X ^ 1.  */
> +      if (code == EQ_EXPR)
> +       {
> +         if (TYPE_PRECISION (TREE_TYPE (tmp)) == 1)
> +           code = BIT_NOT_EXPR;
> +         else
> +           {
> +            

Re: [patch tree-optimization]: Add cleanup code for possible unused statements in binary optimization

2011-08-02 Thread Richard Guenther
On Tue, Aug 2, 2011 at 12:39 PM, Kai Tietz  wrote:
> Hello,
>
> this patch adds some statement-cleanup to forward-propagation.
>
> ChangeLog
>
> 2011-08-02  Kai Tietz  
>
>        * tree-ssa-forwprop.c (simplify_bitwise_binary):
>        Remove possible unused statement after optimization.
>
> 2011-08-02  Kai Tietz  
>
>        * gcc.dg/tree-ssa/forwprop-9.c: Add test for no int casts.
>
> Bootstrapped and regression-tested for all languages (including Ada
> and Obj-C++) on host x86_64-pc-linux-gnu.
> Ok for apply?

You have to handle the stmts return value - if it removes a possibly
trapping instruction we have to run cfgcleanup.

I also think these are excessive - we want to apply the
transformations for single-use chains only (we are inserting new
stmts after all), in which case we can remove the old defs uncontitionally.

Richard.

> Regards,
> Kai
>
> Index: gcc/gcc/tree-ssa-forwprop.c
> ===
> --- gcc.orig/gcc/tree-ssa-forwprop.c
> +++ gcc/gcc/tree-ssa-forwprop.c
> @@ -1810,6 +1810,8 @@ simplify_bitwise_binary (gimple_stmt_ite
>       gimple_assign_set_rhs_with_ops_1 (gsi, NOP_EXPR,
>                                        tem, NULL_TREE, NULL_TREE);
>       update_stmt (gsi_stmt (*gsi));
> +      if (TREE_CODE (arg1) == SSA_NAME)
> +       remove_prop_source_from_use (arg1);
>       return true;
>     }
>
> @@ -1840,6 +1842,10 @@ simplify_bitwise_binary (gimple_stmt_ite
>       gimple_assign_set_rhs_with_ops_1 (gsi, NOP_EXPR,
>                                        tem, NULL_TREE, NULL_TREE);
>       update_stmt (gsi_stmt (*gsi));
> +      if (TREE_CODE (arg1) == SSA_NAME)
> +       remove_prop_source_from_use (arg1);
> +      if (TREE_CODE (arg2) == SSA_NAME)
> +       remove_prop_source_from_use (arg2);
>       return true;
>     }
>
> @@ -1887,6 +1893,8 @@ simplify_bitwise_binary (gimple_stmt_ite
>       gimple_assign_set_rhs1 (stmt, def1_arg1);
>       gimple_assign_set_rhs2 (stmt, cst);
>       update_stmt (stmt);
> +      if (TREE_CODE (arg1) == SSA_NAME)
> +       remove_prop_source_from_use (arg1);
>       return true;
>     }
>
> @@ -1907,6 +1915,10 @@ simplify_bitwise_binary (gimple_stmt_ite
>     {
>       gimple_assign_set_rhs_from_tree (gsi, res);
>       update_stmt (gsi_stmt (*gsi));
> +      if (TREE_CODE (arg1) == SSA_NAME)
> +       remove_prop_source_from_use (arg1);
> +      if (TREE_CODE (arg2) == SSA_NAME)
> +       remove_prop_source_from_use (arg2);
>       return true;
>     }
>
> Index: gcc/gcc/testsuite/gcc.dg/tree-ssa/forwprop-9.c
> ===
> --- gcc.orig/gcc/testsuite/gcc.dg/tree-ssa/forwprop-9.c
> +++ gcc/gcc/testsuite/gcc.dg/tree-ssa/forwprop-9.c
> @@ -11,4 +11,5 @@ foo (_Bool a, _Bool b, _Bool c
>
>  /* { dg-final { scan-tree-dump-times " == " 0 "forwprop1" } } */
>  /* { dg-final { scan-tree-dump-times " != " 0 "forwprop1" } } */
> +/* { dg-final { scan-tree-dump-times "\\\(int\\\)" 0 "forwprop1" } } */
>  /* { dg-final { cleanup-tree-dump "forwprop1" } } */
>


Re: [PATCH][2/2][RFC] Fix PR49806, promote/demote binary operations in VRP

2011-08-02 Thread Ira Rosen


Richard Guenther  wrote on 02/08/2011 01:33:49 PM:
>
> On Tue, 2 Aug 2011, Ira Rosen wrote:
>
> >
> > > +   /* Now we have matched the statement pattern
> > > +
> > > +rhs1 = (T1)x;
> > > +rhs2 = (T1)y;
> > > +op_result = rhs1 OP rhs2;
> > > +lhs = (T2)op_result;
> >
> > Just a note that the patch I proposed for the vectorizer (
> > http://gcc.gnu.org/ml/gcc-patches/2011-07/msg01472.html) also handles
> > constants, multiple statements (i.e., op_result doesn't have to be
promoted
> > itself, but the sequence needs to end up with a promotion), and also it
may
> > use an intermediate type for OP. The tests in my patch don't match the
> > pattern this patch detects.
>
> Ok, I only looked at the description of your patch, not the patch itself.
>
> The patch already handles constant 2nd operands.
>
> It shouldn't be difficult to handle multiple statements here, either by
> instead of the above match only
>
> op_result = rhs1 OP rhs2;
> lhs = (T2)op_result;
>
> and thus allow iteration on the promoted/demoted operation operands
> or by collecting all defs first.
>
> Do you handle arbitrary def trees or only a linear chain as suggested
> by
>
> + S2  x_T = (TYPE) x_t;
> + S3  res0_T = op (x_T, C0);
> + S4  res1_T = op (res0_T, C1);
> + S5  ... = () res1_T;  - type demotion
>
> ?  Thus, do you handle res1_T = op (res0_T, res2_T) with a possibly
> different TYPE in its def?

Only linear chains. But it doesn't seem too complicated to only check if
res2_T is a result of a type promotion.

Thanks,
Ira

> The case of
>
> op_result = rhs1 OP CST;
> lhs = (T2)op_result;
>
> is probably always profitable to demote to
>
> rhs1' = (T2)rhs1;
> lhs = rhs1' OP (T2)CST;
>
> and "iterating" that should be simple (handling two variable
> operands will probably get a bit convoluted).
>
> Thanks,
> Richard.



Re: [Patch,AVR]: Cleanup libgcc.S

2011-08-02 Thread Denis Chertykov
2011/8/2 Georg-Johann Lay :
> This patch fixes RCALL/RJMP instructions to other modules by replacing them
> with XCALL resp. XJMP.
>
> Moreover, now each function (except _cleanup) is enclosed in DEFUN/ENDF pairs
> so that size information is available for each function.
>
> Ok?

Approved.

Denis.


[Ada] Iteration of containers given by function calls

2011-08-02 Thread Arnaud Charlet
In Ada2012, the domain of iteration of a loop or quantified expression can be
a function call that yields a container. This patch implements the support for
default iterators over such expressions, that is to say iterators that use the
default indexing machinery present in all containers.
The following must compile quietly:

   gcc -c -gnata -gnat12 t.adb

---
with Ada.Containers.Doubly_Linked_Lists;
package T is
   package Lists is new Ada.Containers.Doubly_Linked_Lists (Integer);
   use Lists;

   function Id (L : List) return List;

   procedure Map_F (L : in out List) with
 Post => (for all Cu in Id (L) => Element (Cu) = 0);
end T;
---
with Text_IO; use Text_IO;
package body  T is

   function Id (L : List) return List is begin return L; end;

   procedure Map_F (L : in out List)  -- with
  Result : Lists.List;
   is
   begin
 for I of L Loop put_line (integer'image (I)); end loop;
 Result.Append (0);
 L := Result;
   end;
end T;

Tested on x86_64-pc-linux-gnu, committed on trunk

2011-08-02  Ed Schonberg  

* sem_ch5.adb (Pre_Analyze_Range): new procedure extracted from
Process_Bounds, to perform analysis with expansion of a range or an
expression that is the iteration scheme for a loop.
(Analyze_Iterator_Specification): If domain of iteration is given by a
function call with a controlled result, as is the case if call returns
a predefined container, ensure that finalization actions are properly
generated.
* par-ch3.adb: accept Ada2012 iterator form in P_Discrete_Range.

Index: par-ch3.adb
===
--- par-ch3.adb (revision 177123)
+++ par-ch3.adb (working copy)
@@ -2783,11 +2783,17 @@
  Set_High_Bound (Range_Node, Expr_Node);
  return Range_Node;
 
-  --  Otherwise we must have a subtype mark
+  --  Otherwise we must have a subtype mark, or an Ada 2012 iterator
 
   elsif Expr_Form = EF_Simple_Name then
  return Expr_Node;
 
+  --  The domain of iteration must be a name. Semantics will determine that
+  --  the expression has the proper form.
+
+  elsif Ada_Version >= Ada_2012 then
+ return Expr_Node;
+
   --  If incorrect, complain that we expect ..
 
   else
Index: sem_ch5.adb
===
--- sem_ch5.adb (revision 177132)
+++ sem_ch5.adb (working copy)
@@ -1537,6 +1537,90 @@
   --  calls that use the secondary stack, returning True if any such call
   --  is found, and False otherwise.
 
+  procedure Pre_Analyze_Range (R_Copy : Node_Id);
+  --  Determine expected type of range or domain of iteration of Ada 2012
+  --  loop by analyzing separate copy. Do the analysis and resolution of
+  --  the copy of the bound(s) with expansion disabled, to prevent the
+  --  generation of finalization actions. This prevents memory leaks when
+  --  the bounds contain calls to functions returning controlled arrays or
+  --  when the domain of iteration is a container.
+
+  ---
+  -- Pre_Analyze_Range --
+  ---
+
+  procedure Pre_Analyze_Range (R_Copy : Node_Id) is
+ Save_Analysis : Boolean;
+  begin
+ Save_Analysis := Full_Analysis;
+ Full_Analysis := False;
+ Expander_Mode_Save_And_Set (False);
+
+ Analyze (R_Copy);
+
+ if Nkind (R_Copy) in N_Subexpr
+   and then Is_Overloaded (R_Copy)
+ then
+
+--  Apply preference rules for range of predefined integer types,
+--  or diagnose true ambiguity.
+
+declare
+   I : Interp_Index;
+   It: Interp;
+   Found : Entity_Id := Empty;
+
+begin
+   Get_First_Interp (R_Copy, I, It);
+   while Present (It.Typ) loop
+  if Is_Discrete_Type (It.Typ) then
+ if No (Found) then
+Found := It.Typ;
+ else
+if Scope (Found) = Standard_Standard then
+   null;
+
+elsif Scope (It.Typ) = Standard_Standard then
+   Found := It.Typ;
+
+else
+   --  Both of them are user-defined
+
+   Error_Msg_N
+ ("ambiguous bounds in range of iteration",
+   R_Copy);
+   Error_Msg_N ("\possible interpretations:", R_Copy);
+   Error_Msg_NE ("\\} ", R_Copy, Found);
+   Error_Msg_NE ("\\} ", R_Copy, It.Typ);
+   exit;
+end if;
+ end if;
+  end if;
+
+  Get_Next_Interp (I, It);
+   end loop;
+

[Ada] Reduce compilation time at -O0 (5/n)

2011-08-02 Thread Arnaud Charlet
This patch slightly reduces compilation time at -O0 in typical conditions by
streamlining the implementation of the Sem_Type.Covers predicate.

No functional changes.

Tested on x86_64-pc-linux-gnu, committed on trunk

2011-08-02  Eric Botcazou  

* sem_type.adb (Covers): Move trivial case to the top and reuse the
computed value of Base_Type.

Index: sem_type.adb
===
--- sem_type.adb(revision 177087)
+++ sem_type.adb(working copy)
@@ -737,22 +737,12 @@
  else
 raise Program_Error;
  end if;
+  end if;
 
-  else
- BT1 := Base_Type (T1);
- BT2 := Base_Type (T2);
+  --  Trivial case: same types are always compatible
 
- --  Handle underlying view of records with unknown discriminants
- --  using the original entity that motivated the construction of
- --  this underlying record view (see Build_Derived_Private_Type).
-
- if Is_Underlying_Record_View (BT1) then
-BT1 := Underlying_Record_View (BT1);
- end if;
-
- if Is_Underlying_Record_View (BT2) then
-BT2 := Underlying_Record_View (BT2);
- end if;
+  if T1 = T2 then
+ return True;
   end if;
 
   --  First check for Standard_Void_Type, which is special. Subsequent
@@ -762,26 +752,38 @@
 
   if (T1 = Standard_Void_Type) /= (T2 = Standard_Void_Type) then
  return False;
+  end if;
 
-  --  Simplest case: same types are compatible, and types that have the
-  --  same base type and are not generic actuals are compatible. Generic
-  --  actuals  belong to their class but are not compatible with other
-  --  types of their class, and in particular with other generic actuals.
-  --  They are however compatible with their own subtypes, and itypes
-  --  with the same base are compatible as well. Similarly, constrained
-  --  subtypes obtained from expressions of an unconstrained nominal type
-  --  are compatible with the base type (may lead to spurious ambiguities
-  --  in obscure cases ???)
+  BT1 := Base_Type (T1);
+  BT2 := Base_Type (T2);
 
+  --  Handle underlying view of records with unknown discriminants
+  --  using the original entity that motivated the construction of
+  --  this underlying record view (see Build_Derived_Private_Type).
+
+  if Is_Underlying_Record_View (BT1) then
+ BT1 := Underlying_Record_View (BT1);
+  end if;
+
+  if Is_Underlying_Record_View (BT2) then
+ BT2 := Underlying_Record_View (BT2);
+  end if;
+
+  --  Simplest case: types that have the same base type and are not generic
+  --  actuals are compatible. Generic actuals belong to their class but are
+  --  not compatible with other types of their class, and in particular
+  --  with other generic actuals. They are however compatible with their
+  --  own subtypes, and itypes with the same base are compatible as well.
+  --  Similarly, constrained subtypes obtained from expressions of an
+  --  unconstrained nominal type are compatible with the base type (may
+  --  lead to spurious ambiguities in obscure cases ???)
+
   --  Generic actuals require special treatment to avoid spurious ambi-
   --  guities in an instance, when two formal types are instantiated with
   --  the same actual, so that different subprograms end up with the same
   --  signature in the instance.
 
-  elsif T1 = T2 then
- return True;
-
-  elsif BT1 = BT2
+  if BT1 = BT2
 or else BT1 = T2
 or else BT2 = T1
   then
@@ -830,7 +832,7 @@
 and then Is_Interface (Etype (T1))
 and then Is_Concurrent_Type (T2)
 and then Interface_Present_In_Ancestor
-   (Typ   => Base_Type (T2),
+   (Typ   => BT2,
 Iface => Etype (T1))
   then
  return True;
@@ -889,7 +891,7 @@
   elsif Is_Class_Wide_Type (T2)
 and then
   (Class_Wide_Type (T1) = T2
- or else Base_Type (Root_Type (T2)) = Base_Type (T1))
+ or else Base_Type (Root_Type (T2)) = BT1)
   then
  return True;
 
@@ -1037,7 +1039,7 @@
 
   --  The actual type may be the result of a previous error
 
-  elsif Base_Type (T2) = Any_Type then
+  elsif BT2 = Any_Type then
  return True;
 
   --  A packed array type covers its corresponding non-packed type. This is


RE: [Patch,AVR]: Cleanup libgcc.S

2011-08-02 Thread Weddington, Eric


> -Original Message-
> From: Georg-Johann Lay [mailto:a...@gjlay.de]
> Sent: Tuesday, August 02, 2011 4:24 AM
> To: gcc-patches@gcc.gnu.org
> Cc: Anatoly Sokolov; Denis Chertykov; Weddington, Eric
> Subject: [Patch,AVR]: Cleanup libgcc.S
> 
> This patch fixes RCALL/RJMP instructions to other modules by replacing
> them
> with XCALL resp. XJMP.
> 

Hi Johann,

Do we want to add a binutils bug report for the FIXME that you just added in 
this patch?

It should be fairly easy to add SORT to the default linker scripts.

Eric Weddington


[Ada] Lift inlining limitation with -gnatn (2)

2011-08-02 Thread Arnaud Charlet
This fixes an oversight in the previous change: the check for library-level
inlined functions must be adjusted to the result of Get_Code_Unit_Entity.

Tested on x86_64-pc-linux-gnu, committed on trunk

2011-08-02  Eric Botcazou  

* inline.adb (Add_Inlined_Body): Adjust check for library-level inlined
functions to previous change.  Reorganize code slightly.

Index: inline.adb
===
--- inline.adb  (revision 177136)
+++ inline.adb  (working copy)
@@ -236,7 +236,6 @@
--
 
procedure Add_Inlined_Body (E : Entity_Id) is
-  Pack : Entity_Id;
 
   function Must_Inline return Boolean;
   --  Inlining is only done if the call statement N is in the main unit,
@@ -318,35 +317,39 @@
   --  no enclosing package to retrieve. In this case, it is the body of
   --  the function that will have to be loaded.
 
-  if not Is_Abstract_Subprogram (E) and then not Is_Nested (E)
+  if not Is_Abstract_Subprogram (E)
+and then not Is_Nested (E)
 and then Convention (E) /= Convention_Protected
+and then Must_Inline
   then
- Pack := Get_Code_Unit_Entity (E);
+ declare
+Pack : constant Entity_Id := Get_Code_Unit_Entity (E);
 
- if Must_Inline
-   and then Ekind (Pack) = E_Package
- then
-Set_Is_Called (E);
+ begin
+if Pack = E then
 
-if Pack = Standard_Standard then
-
--  Library-level inlined function. Add function itself to
--  list of needed units.
 
+   Set_Is_Called (E);
Inlined_Bodies.Increment_Last;
Inlined_Bodies.Table (Inlined_Bodies.Last) := E;
 
-elsif Is_Generic_Instance (Pack) then
-   null;
+elsif Ekind (Pack) = E_Package then
+   Set_Is_Called (E);
 
-elsif not Is_Inlined (Pack)
-  and then not Has_Completion (E)
-then
-   Set_Is_Inlined (Pack);
-   Inlined_Bodies.Increment_Last;
-   Inlined_Bodies.Table (Inlined_Bodies.Last) := Pack;
+   if Is_Generic_Instance (Pack) then
+  null;
+
+   elsif not Is_Inlined (Pack)
+ and then not Has_Completion (E)
+   then
+  Set_Is_Inlined (Pack);
+  Inlined_Bodies.Increment_Last;
+  Inlined_Bodies.Table (Inlined_Bodies.Last) := Pack;
+   end if;
 end if;
- end if;
+ end;
   end if;
end Add_Inlined_Body;
 


[Ada] Register back end floating point types

2011-08-02 Thread Arnaud Charlet
This patch adds a new mechanism to have the Ada front end query what types are
supported by the back end. Types other than floating point types are currently
ignored. The information is needed because the list of floating point types
that may be present is open-ended, so it is impossible to add querying
functions for each type.

The main immediate use is for correct support of Interfaces.C.long_double,
when that type differs form Long_Long_Float. Types without definition in
the Ada Standard package must be explicitly defined using both precision
and range, and possibly representation attributes. Support for this will
be added in subsequent patches.

This patch also prepares for future addition of decimal floating point,
as well as potential native support of VMS floating point types.

Tested on x86_64-pc-linux-gnu, committed on trunk

2011-08-02  Geert Bosch  

* back_end.ads (Register_Type_Proc): New call back procedure type for
allowing the back end to provide information about available types.
(Register_Back_End_Types): New procedure to register back end types.
* back_end.adb (Register_Back_End_Types): Call the back end to enumerate
available types.
* cstand.adb (Back_End_Float_Types): New list for floating point types
supported by the back end.
(Build_Float_Type): Add extra parameter for Float_Rep_Kind.
(Copy_Float_Type): New procedure to make new copies of predefined types.
(Register_Float_Type): New call back procedure to populate the BEFT list
(Find_Back_End_Float_Type): New procedure to find a BEFT by name
(Create_Back_End_Float_Types): New procedure to populate the BEFT list.
(Create_Float_Types): New procedure to create entities for floating
point types predefined in Standard, and put these and any remaining
BEFTs on the Predefined_Float_Types list.
* stand.ads (Predefined_Float_Types): New list for predefined floating
point types that do not have declarations in package Standard.

Index: cstand.adb
===
--- cstand.adb  (revision 177028)
+++ cstand.adb  (working copy)
@@ -24,6 +24,7 @@
 --
 
 with Atree;use Atree;
+with Back_End; use Back_End;
 with Csets;use Csets;
 with Debug;use Debug;
 with Einfo;use Einfo;
@@ -51,14 +52,25 @@
Staloc : constant Source_Ptr := Standard_ASCII_Location;
--  Standard abbreviations used throughout this package
 
+   Back_End_Float_Types : List_Id := No_List;
+   --  List used for any floating point supported by the back end. This needs
+   --  to be at the library level, because the call back procedures retrieving
+   --  this information are at that level.
+
---
-- Local Subprograms --
---
 
-   procedure Build_Float_Type (E : Entity_Id; Siz : Int; Digs : Int);
+   procedure Build_Float_Type
+ (E: Entity_Id;
+  Siz  : Int;
+  Rep  : Float_Rep_Kind;
+  Digs : Int);
--  Procedure to build standard predefined float base type. The first
-   --  parameter is the entity for the type, and the second parameter
-   --  is the size in bits. The third parameter is the digits value.
+   --  parameter is the entity for the type, and the second parameter is the
+   --  size in bits. The third parameter indicates the kind of representation
+   --  to be used. The fourth parameter is the digits value. Each type
+   --  is added to the list of predefined floating point types.
 
procedure Build_Signed_Integer_Type (E : Entity_Id; Siz : Int);
--  Procedure to build standard predefined signed integer subtype. The
@@ -66,6 +78,11 @@
--  is the size in bits. The corresponding base type is not built by
--  this routine but instead must be built by the caller where needed.
 
+   procedure Copy_Float_Type (To : Entity_Id; From : Entity_Id);
+   --  Build a floating point type, copying representation details from From.
+   --  This is used to create predefined floating point types based on
+   --  available types in the back end.
+
procedure Create_Operators;
--  Make entries for each of the predefined operators in Standard
 
@@ -89,6 +106,12 @@
--  bounds, but do not statically match, since a subtype with constraints
--  never matches a subtype with no constraints.
 
+   function Find_Back_End_Float_Type (Name : String) return Entity_Id;
+   --  Return the first float type in Back_End_Float_Types with the given name.
+   --  Names of entities in back end types, are either type names of C
+   --  predefined types (all lower case), or mode names (upper case).
+   --  These are not generally valid identifier names.
+
function Identifier_For (S : Standard_Entity_Type) return Node_Id;
--  Returns an identifier node with the same name as the defining
--  identifier corresponding to t

[Ada] Various fpt related clean ups

2011-08-02 Thread Arnaud Charlet
[1] Add d.b debug option for showing available back end types

This debug option prints out information on all types that the
back end indicates it supports.

[2] Allow fpt types with more than Long_Long_Float'Digits digits

This patch takes advantage of the new infrastructure in Cstand to allow
deriving from predefined floating point types that are not in Standard and
may have more than Max_Digits digits. This will allow definition of
Interfaces.C.long_double on systems where this type is not supported by
hardware.

[3] Add support for importing predefined C floating point types

This is needed to reliably define types such as "long double"
which may have no corresponding predefined type in Ada.

The following should compile without error:

procedure it is
   type T;
   pragma Import (C, T, "long double");
begin
   null;
end it;

Tested on x86_64-pc-linux-gnu, committed on trunk

2011-08-02  Geert Bosch  

* cstand.adb (Register_Float_Type): Print information about type to
register, if the Debug_Flag_Dot_B is set.
* debug.adb (Debug_Flag_Dot_B): Document d.b debug option.
* rtsfind.ads (RE_Max_Base_Digits): New run time entity.
* sem_ch3.adb (Floating_Point_Type_Declaration): Allow declarations
with a requested precision of more than Max_Digits digits and no more
than Max_Base_Digits digits, if a range specification is present and the
Predefined_Float_Types list has a suitable type to derive from.
* sem_ch3.adb (Rep_Item_Too_Early): Avoid generating error in the
case of type completion with pragma Import
* sem_prag.adb
(Process_Import_Predefined_Type): Processing to complete a type
with pragma Import. Currently supports floating point types only.
(Set_Convention_From_Pragma): Do nothing without underlying type.
(Process_Convention): Guard against absence of underlying type,
which may happen when importing incomplete types.
(Process_Import_Or_Interface): Handle case of importing predefined
types. Tweak error message.

Index: cstand.adb
===
--- cstand.adb  (revision 177137)
+++ cstand.adb  (working copy)
@@ -467,7 +467,7 @@
 N   : Node_Id := First (Back_End_Float_Types);
 
  begin
-if Digits_Value (LLF) > Max_HW_Digs then
+if Present (LLF) and then Digits_Value (LLF) > Max_HW_Digs then
LLF := Empty;
 end if;
 
@@ -2008,16 +2008,78 @@
   Size  : Positive;
   Alignment : Natural)
is
-  Last : Natural := Name'First - 1;
+  T: String (1 .. Name'Length);
+  Last : Natural := 0;
 
+  procedure Dump;
+  --  Dump information given by the back end for the type to register
+
+  procedure Dump is
+  begin
+ Write_Str ("type " & T (1 .. Last) & " is ");
+
+ if Count > 0 then
+Write_Str ("array (1 .. ");
+Write_Int (Int (Count));
+
+if Complex then
+   Write_Str (", 1 .. 2");
+end if;
+
+Write_Str (") of ");
+
+ elsif Complex then
+Write_Str ("array (1 .. 2) of ");
+ end if;
+
+ if Digs > 0 then
+Write_Str ("digits ");
+Write_Int (Int (Digs));
+Write_Line (";");
+
+Write_Str ("pragma Float_Representation (");
+
+case Float_Rep is
+   when IEEE_Binary =>  Write_Str ("IEEE");
+   when VAX_Native =>
+  case Digs is
+ when  6 => Write_Str ("VAXF");
+ when  9 => Write_Str ("VAXD");
+ when 15 => Write_Str ("VAXG");
+ when others => Write_Str ("VAX_"); Write_Int (Int (Digs));
+  end case;
+   when AAMP => Write_Str ("AAMP");
+end case;
+Write_Line (", " & T & ");");
+
+ else
+Write_Str ("mod 2**");
+Write_Int (Int (Size / Positive'Max (1, Count)));
+Write_Line (";");
+ end if;
+
+ Write_Str ("for " & T & "'Size use ");
+ Write_Int (Int (Size));
+ Write_Line (";");
+
+ Write_Str ("for " & T & "'Alignment use ");
+ Write_Int (Int (Alignment / 8));
+ Write_Line (";");
+  end Dump;
+
begin
-  for J in Name'Range loop
- if Name (J) = ASCII.NUL then
+  for J in T'Range loop
+ T (J) := Name (Name'First + J - 1);
+ if T (J) = ASCII.NUL then
 Last := J - 1;
 exit;
  end if;
   end loop;
 
+  if Debug_Flag_Dot_B then
+ Dump;
+  end if;
+
   if Digs > 0 and then not Complex and then Count = 0 then
  declare
 Ent   : constant Entity_Id := New_Standard_Entity;
@@ -2026,7 +2088,7 @@
  begin
 Set_Defining_Identifier
   

[Ada] Addition of new attribute Original_Access_Type

2011-08-02 Thread Arnaud Charlet
This patch does not change the behavior of the compiler. It adds
a new attribute to facilitate some non gcc back-end work to locate
the protected subprogram type entity associated with an internally
generated access to subprogram type.

Tested on x86_64-pc-linux-gnu, committed on trunk

2011-08-02  Javier Miranda  

* exp_ch9.adb (Expand_Access_Protected_Subprogram_Type): Link the
internally generated access to subprogram with its associated protected
subprogram type.
* einfo.ads, einfo.adb (Original_Access_Type): New attribute.

Index: exp_ch9.adb
===
--- exp_ch9.adb (revision 176998)
+++ exp_ch9.adb (working copy)
@@ -5067,6 +5067,12 @@
   Insert_After (N, Decl1);
   Analyze (Decl1);
 
+  --  Associate the access to subprogram with its original access to
+  --  protected subprogram type. Needed by the backend to know that this
+  --  type corresponds with an access to protected subprogram type.
+
+  Set_Original_Access_Type (D_T2, T);
+
   --  Create Equivalent_Type, a record with two components for an access to
   --  object and an access to subprogram.
 
Index: einfo.adb
===
--- einfo.adb   (revision 177129)
+++ einfo.adb   (working copy)
@@ -181,6 +181,7 @@
--Default_Expr_Function   Node21
--Discriminant_Constraint Elist21
--Interface_Name  Node21
+   --Original_Access_TypeNode21
--Original_Array_Type Node21
--Small_Value Ureal21
 
@@ -2353,6 +2354,12 @@
   return Flag242 (Id);
end Optimize_Alignment_Time;
 
+   function Original_Access_Type (Id : E) return E is
+   begin
+  pragma Assert (Ekind (Id) = E_Access_Subprogram_Type);
+  return Node21 (Id);
+   end Original_Access_Type;
+
function Original_Array_Type (Id : E) return E is
begin
   pragma Assert (Is_Array_Type (Id) or else Is_Modular_Integer_Type (Id));
@@ -4852,6 +4859,12 @@
   Set_Flag242 (Id, V);
end Set_Optimize_Alignment_Time;
 
+   procedure Set_Original_Access_Type (Id : E; V : E) is
+   begin
+  pragma Assert (Ekind (Id) = E_Access_Subprogram_Type);
+  Set_Node21 (Id, V);
+   end Set_Original_Access_Type;
+
procedure Set_Original_Array_Type (Id : E; V : E) is
begin
   pragma Assert (Is_Array_Type (Id) or else Is_Modular_Integer_Type (Id));
@@ -8332,6 +8345,9 @@
  when Fixed_Point_Kind =>
 Write_Str ("Small_Value");
 
+ when E_Access_Subprogram_Type =>
+Write_Str ("Original_Access_Type");
+
  when E_In_Parameter   =>
 Write_Str ("Default_Expr_Function");
 
Index: einfo.ads
===
--- einfo.ads   (revision 177129)
+++ einfo.ads   (working copy)
@@ -3206,6 +3206,12 @@
 --   Optimize_Alignment (Off) mode applies to the type/object, then neither
 --   of the flags Optimize_Alignment_Space/Optimize_Alignment_Time is set.
 
+--Original_Access_Type (Node21)
+--   Present in E_Access_Subprogram_Type entities. Set only if the access
+--   type was generated by the expander as part of processing an access
+--   to protected subprogram type. Points to the access to protected
+--   subprogram type.
+
 --Original_Array_Type (Node21)
 --   Present in modular types and array types and subtypes. Set only
 --   if the Is_Packed_Array_Type flag is set, indicating that the type
@@ -4876,6 +4882,7 @@
--  E_Access_Subprogram_Type
--Equivalent_Type (Node18)   (remote types only)
--Directly_Designated_Type(Node20)
+   --Original_Access_Type(Node21)
--Needs_No_Actuals(Flag22)
--Can_Use_Internal_Rep(Flag229)
--(plus type attributes)
@@ -6223,6 +6230,7 @@
function OK_To_Reorder_Components(Id : E) return B;
function Optimize_Alignment_Space(Id : E) return B;
function Optimize_Alignment_Time (Id : E) return B;
+   function Original_Access_Type(Id : E) return E;
function Original_Array_Type (Id : E) return E;
function Original_Record_Component   (Id : E) return E;
function Overlays_Constant   (Id : E) return B;
@@ -6812,6 +6820,7 @@
procedure Set_OK_To_Reorder_Components(Id : E; V : B := True);
procedure Set_Optimize_Alignment_Space(Id : E; V : B := True);
procedure Set_Optimize_Alignment_Time (Id : E; V : B := True);
+   procedure Set_Original_Access_Type(Id : E; V : E);
procedure Set_Original_Array_Type (Id : E; V : E);
procedure Set_Original_Record_Component

[Ada] Missing accessibility check in anonymous access types

2011-08-02 Thread Arnaud Charlet
The compiler does not handle well the accessibility check of anonymous
access types that are formals of anonymous access to subprogram
components of record types. The execution of the program may
crash or have unexpected behavior since the check is performed
with an expected actual (the accessibility level) which is not
passed by the caller.

After this patch the following test executes without errors.

with Text_IO; use Text_IO;
procedure Cutdown is

type Self_Ref;
type Self_Ref is record
Ptr : access procedure (X: access Self_Ref);
end record;

Ptr : access Self_Ref;

procedure Foo (Xxx : access Self_Ref) is
begin
   --  Accessibility check required for this assignment

   Ptr := Xxx;
end Foo;

procedure Nested is
   Yyy : aliased Self_Ref := (Ptr => Foo'Access);

begin
   Yyy.Ptr.all (Yyy'Access); --  must raise PE
   Put_Line ("Test failed");
exception
   when Program_Error =>
  null;
end;

begin
   Nested;
end;

Command: gnatmake -gnat05 cutdown.adb; ./cutdown

Tested on x86_64-pc-linux-gnu, committed on trunk

2011-08-02  Javier Miranda  

* sem_ch3.adb (Check_Anonymous_Access_Components): Create extra formals
associated with anonymous access to subprograms.

Index: sem_ch3.adb
===
--- sem_ch3.adb (revision 177139)
+++ sem_ch3.adb (working copy)
@@ -18760,7 +18760,7 @@
 --  an access_to_object or an access_to_subprogram.
 
 if Present (Acc_Def) then
-   if Nkind  (Acc_Def) = N_Access_Function_Definition then
+   if Nkind (Acc_Def) = N_Access_Function_Definition then
   Type_Def :=
 Make_Access_Function_Definition (Loc,
   Parameter_Specifications =>
@@ -18799,10 +18799,15 @@
 Insert_Before (Typ_Decl, Decl);
 Analyze (Decl);
 
---  If an access to object, Preserve entity of designated type,
+--  If an access to subprogram, create the extra formals
+
+if Present (Acc_Def) then
+   Create_Extra_Formals (Designated_Type (Anon_Access));
+
+--  If an access to object, preserve entity of designated type,
 --  for ASIS use, before rewriting the component definition.
 
-if No (Acc_Def) then
+else
declare
   Desig : Entity_Id;
 


[Ada] Strip Switch.C of most of its dependencies

2011-08-02 Thread Arnaud Charlet
Switch.C had needless dependencies on most of the front end, causing
a circular dependency on Back_End for back ends written in Ada.
This patch cleans up the dependencies through introduction of
a new Warnsw package specifically for warning switches, and by
moving variables related to the preprocessor definitions given
on the command line to Opt. No change in behavior.

Tested on x86_64-pc-linux-gnu, committed on trunk

2011-08-02  Geert Bosch  

* opt.ads
(Preprocessing_Symbol_Defs): Move from Prepcomp.Symbol_Definitions.
(Preprocessing_Symbol_Last): Move from Prepcomp.Last_Definition.
* prepcomp.adb (Symbol_Definitions, Last_Definition): Move to opt.ads
(Add_Symbol_Definition): Move to switch-c.adb
(Process_Command_Line_Symbol_Definitions): Adjust references to above.
* prepcomp.ads: Remove dependency on Ada.Unchecked_Deallocation.
(Add_Symbol_Definition): Move to switch-c.adb.
* sem_ch13.adb, sem_prag.adb: Add dependency on Warnsw.
* sem_warn.adb
(Set_Dot_Warning_Switch, Set_GNAT_Mode_Warnings, Set_Warning_Switch):
Move to warnsw.adb.
* sem_warn.ads (Warn_On_Record_Holes, Warn_On_Overridden_Size,
Set_Dot_Warning_Switch, Set_GNAT_Mode_Warnings, Set_Warning_Switch):
Move to warnsw.adb.
* switch-c.adb: Replace dependency on Prepcomp and Sem_Warn by Warnsw.
(Add_Symbol_Definition): Moved from Prepcomp.
* switch-c.ads: Update copyright notice. Use String_List instead of
Argument_List, removing dependency on System.OS_Lib.

Index: switch-c.adb
===
--- switch-c.adb(revision 176998)
+++ switch-c.adb(working copy)
@@ -23,16 +23,18 @@
 --  --
 --
 
+--  This package is for switch processing and should not depend on higher level
+--  packages such as those for the scanner, parser, etc. Doing so may cause
+--  circularities, especially for back ends using Adabkend.
+
 with Debug;use Debug;
 with Lib;  use Lib;
 with Osint;use Osint;
 with Opt;  use Opt;
-with Prepcomp; use Prepcomp;
 with Validsw;  use Validsw;
-with Sem_Warn; use Sem_Warn;
 with Stylesw;  use Stylesw;
+with Warnsw;   use Warnsw;
 
-with System.Strings;
 with System.WCh_Con; use System.WCh_Con;
 
 package body Switch.C is
@@ -40,9 +42,12 @@
RTS_Specified : String_Access := null;
--  Used to detect multiple use of --RTS= flag
 
+   procedure Add_Symbol_Definition (Def : String);
+   --  Add a symbol definition from the command line
+
function Switch_Subsequently_Cancelled
  (C: String;
-  Args : Argument_List;
+  Args : String_List;
   Arg_Rank : Positive) return Boolean;
--  This function is called from Scan_Front_End_Switches. It determines if
--  the switch currently being scanned is followed by a switch of the form
@@ -50,13 +55,39 @@
--  and Scan_Front_End_Switches will cancel the effect of the switch. If
--  no such switch is found, False is returned.
 
+   ---
+   -- Add_Symbol_Definition --
+   ---
+
+   procedure Add_Symbol_Definition (Def : String) is
+   begin
+  --  If Preprocessor_Symbol_Defs is not large enough, double its size
+
+  if Preprocessing_Symbol_Last = Preprocessing_Symbol_Defs'Last then
+ declare
+New_Symbol_Definitions : constant String_List_Access :=
+  new String_List (1 .. 2 * Preprocessing_Symbol_Last);
+
+ begin
+New_Symbol_Definitions (Preprocessing_Symbol_Defs'Range) :=
+  Preprocessing_Symbol_Defs.all;
+Free (Preprocessing_Symbol_Defs);
+Preprocessing_Symbol_Defs := New_Symbol_Definitions;
+ end;
+  end if;
+
+  Preprocessing_Symbol_Last := Preprocessing_Symbol_Last + 1;
+  Preprocessing_Symbol_Defs (Preprocessing_Symbol_Last)
+ := new String'(Def);
+   end Add_Symbol_Definition;
+
-
-- Scan_Front_End_Switches --
-
 
procedure Scan_Front_End_Switches
  (Switch_Chars : String;
-  Args : Argument_List;
+  Args : String_List;
   Arg_Rank : Positive)
is
   First_Switch : Boolean := True;
@@ -1157,11 +1188,9 @@
 
function Switch_Subsequently_Cancelled
  (C: String;
-  Args : Argument_List;
+  Args : String_List;
   Arg_Rank : Positive) return Boolean
is
-  use type System.Strings.String_Access;
-
begin
   --  Loop through arguments following the current one
 
Index: switch-c.ads
===
--- switch-c.ads(revision 176998)
+++ switch-c.ads(working copy)
@@ -6,7 +6,7 @

[Ada] Ada2012 iterators over containers given by a function call

2011-08-02 Thread Arnaud Charlet
If the range of iteration in an Ada2012 iterator is a function call returning
a container, finalization actions will in general be created because the
predefined containers are controlled. The finalization actions must be taken
into account when rewriting the iteration as a while-loop.

Compiling and executing the following in Ada2012 mode must yield:

 12345

---
with Ada.Containers.Ordered_Sets;
with Text_IO; use Text_IO;
procedure T is
   function Hash (X : integer) return integer is begin return X / 2; end;
   package Integer_Sets is
  new Ada.Containers.Ordered_Sets (Element_Type => Integer);
   function P  return Integer_Sets.Set;

   function P  return Integer_Sets.Set is
  use Integer_Sets;
  result : Set := Empty_Set;
   begin
  Result.Insert (12345);
  return Result;
   end P;

begin
   for Element of P loop
  Put_Line (Integer'Image (Element));
   end loop;
end T;

Tested on x86_64-pc-linux-gnu, committed on trunk

2011-08-02  Ed Schonberg  

* sem_ch5.adb (Analyze_Iteration_Scheme): For an Ada2012 iterator with
"of", pre-analyze expression in case it is a function call with
finalization actions that must be placed ahead of the loop.
* exp_ch5.adb (Expand_Iterator_Loop): If condition_actions are present
on an Ada2012 iterator, insert them ahead of the rewritten loop.

Index: exp_ch5.adb
===
--- exp_ch5.adb (revision 177130)
+++ exp_ch5.adb (working copy)
@@ -2952,6 +2952,15 @@
 Make_Iteration_Scheme (Loc, Condition => Cond),
   Statements   => Stats,
   End_Label=> Empty);
+
+--  If the range of iteration is given by a function call that
+--  returns a container, the finalization actions have been saved
+--  in the Condition_Actions of the iterator. Insert them now at
+--  the head of the loop.
+
+if Present (Condition_Actions (Isc)) then
+   Insert_List_Before (N, Condition_Actions (Isc));
+end if;
  end;
   end if;
 
@@ -3158,6 +3167,7 @@
 
   elsif Present (Isc)
 and then Present (Condition_Actions (Isc))
+and then Present (Condition (Isc))
   then
  declare
 ES : Node_Id;
Index: sem_ch5.adb
===
--- sem_ch5.adb (revision 177145)
+++ sem_ch5.adb (working copy)
@@ -1919,7 +1919,11 @@
 Set_Current_Value_Condition (N);
 return;
 
+ --  For an iterator specification with "of", pre-analyze range to
+ --  capture function calls that may require finalization actions.
+
  elsif Present (Iterator_Specification (N)) then
+Pre_Analyze_Range (Name (Iterator_Specification (N)));
 Analyze_Iterator_Specification (Iterator_Specification (N));
 
  --  Else we have a FOR loop
@@ -1974,7 +1978,7 @@
then
   Process_Bounds (DS);
 
-   --  Expander not active or else domain of iteration is a subtype
+   --  expander not active or else range of iteration is a subtype
--  indication, an entity, or a function call that yields an
--  aggregate or a container.
 
@@ -1989,7 +1993,8 @@
 and then not Is_Type (Entity (D_Copy)))
   then
  --  This is an iterator specification. Rewrite as such
- --  and analyze.
+ --  and analyze, to capture function calls that may
+ --  require finalization actions.
 
  declare
 I_Spec : constant Node_Id :=
@@ -1997,8 +2002,7 @@
  Defining_Identifier =>
Relocate_Node (Id),
  Name=> D_Copy,
- Subtype_Indication  =>
-   Empty,
+ Subtype_Indication  => Empty,
  Reverse_Present =>
Reverse_Present (LP));
  begin


Re: [patch tree-optimization]: Avoid !=/== 0/1 comparisons for boolean-typed argument

2011-08-02 Thread Kai Tietz
2011/8/2 Richard Guenther :
> On Tue, Aug 2, 2011 at 12:17 PM, Kai Tietz  wrote:
>> Hello,
>>
>> this patch removes in forward-propagation useless comparisons X != 0
>> and X != ~0 for boolean-typed X.  For one-bit precision typed X we
>> simplifiy X == 0 (and X != ~0) to ~X, and for X != 0 (and X == ~0) to
>> X.
>> For none one-bit precisione typed X, we simplify here X == 0 -> X ^ 1,
>> and for X != 0 -> X.  We can do this as even for Ada - which has only
>> boolean-type with none-one-bit precision - the truth-value is one.
>
> This isn't a simplification but a canonicalization and thus should be
> done by fold_stmt instead (we are not propagating anything after all).
> In fact, fold_stmt should do parts of this already by means of its
> canonicalizations via fold.

Well, it simplifies and canonicalizes.  But to put this into
gimple-fold looks better.

>> Additionally this patch changes for function
>> forward_propagate_comparison the meaning of true-result.  As this
>> result wasn't used and it is benefitial to use this propagation also
>
> which is a bug - for a true return value we need to set cfg_changed to true.

I addressed this in my updated patch (see below)

>> in second loop in function ssa_forward_propagate_and_combine, it
>> returns true iff statement was altered.  Additionally this function
>> handles now the boolean-typed simplifications.
>
> why call it twice?  How should that be "beneficial"?  I think that
> forward_propagate_into_comparison should instead fold the changed
> statement.

Well, due missing fold_stmt call, there were still none-converted
comparisons. I've added here the call to fold_stmt_inplace, and it
solved the issue.

>> For the hunk in gimple.c for function canonicalize_cond_expr_cond:
>> This change seems to show no real effect, but IMHO it makes sense to
>> add here the check for cast from boolean-type to be consitant.
>
> Probably yes.
>
> Thanks,
> Richard.


2011-08-02  Kai Tietz  

   * gimple.c (canonicalize_cond_expr_cond): Handle cast from boolean-type.
   (ssa_forward_propagate_and_combine): Interprete result of
   forward_propagate_comparison.
   * gcc/gimple-fold.c (fold_gimple_assign): Add canonicalization for
   boolean-typed operands for comparisons.

2011-08-02  Kai Tietz  

* gcc.dg/tree-ssa/forwprop-15.c: New testcase.

Regression tested and bootstrapped for all languages (including Ada
and Obj-C++).  Ok for apply?

Regards,
Kai

Index: gcc/gcc/testsuite/gcc.dg/tree-ssa/forwprop-15.c
===
--- /dev/null
+++ gcc/gcc/testsuite/gcc.dg/tree-ssa/forwprop-15.c
@@ -0,0 +1,14 @@
+/* { dg-do compile } */
+/* { dg-options "-O2 -fdump-tree-forwprop1" }  */
+
+_Bool
+foo (_Bool a, _Bool b, _Bool c
+{
+  _Bool r1 = a == 0 & b != 0;
+  _Bool r2 = b != 0 & c == 0;
+  return (r1 == 0 & r2 == 0);
+}
+
+/* { dg-final { scan-tree-dump-times " == " 0 "forwprop1" } } */
+/* { dg-final { scan-tree-dump-times " != " 0 "forwprop1" } } */
+/* { dg-final { cleanup-tree-dump "forwprop1" } } */
Index: gcc/gcc/gimple-fold.c
===
--- gcc.orig/gcc/gimple-fold.c
+++ gcc/gcc/gimple-fold.c
@@ -814,6 +814,34 @@ fold_gimple_assign (gimple_stmt_iterator
 gimple_assign_rhs1 (stmt),
 gimple_assign_rhs2 (stmt));
}
+  else if (gimple_assign_rhs_code (stmt) == EQ_EXPR
+   || gimple_assign_rhs_code (stmt) == NE_EXPR)
+{
+ tree op1 = gimple_assign_rhs1 (stmt);
+ tree op2 = gimple_assign_rhs2 (stmt);
+ tree type = TREE_TYPE (op1);
+ if (useless_type_conversion_p (TREE_TYPE (gimple_assign_lhs (stmt)),
+type)
+ && TREE_CODE (op2) == INTEGER_CST)
+   {
+ gimple s;
+ bool inverted = (gimple_assign_rhs_code (stmt) == EQ_EXPR);
+ if (!integer_zerop (op2))
+   inverted = !inverted;
+
+ if (inverted == false)
+   result = op1;
+ else if (TREE_CODE (op1) == SSA_NAME
+  && (s = SSA_NAME_DEF_STMT (op1)) != NULL
+  && is_gimple_assign (s)
+  && gimple_assign_rhs_code (s) == BIT_NOT_EXPR)
+   result = gimple_assign_rhs1 (s);
+else
+   result = build1_loc (gimple_location (stmt), BIT_NOT_EXPR, 
type, op1);
+   
+   }
+   
+   }

   if (!result)
 result = fold_binary_loc (loc, subcode,
Index: gcc/gcc/tree-ssa-forwprop.c
===
--- gcc.orig/gcc/tree-ssa-forwprop.c
+++ gcc/gcc/tree-ssa-forwprop.c
@@ -469,6 +469,9 @@ forward_propagate_into_comparison (gimpl
 {
   gimple_assign_set_rhs_from_tree (gsi, tmp);
   update_stmt (stmt);
+  if (fold_stmt_inplace (stmt))
+up

[Ada] Final implementation of Default[_Component]_Value aspects

2011-08-02 Thread Arnaud Charlet
This patch completes the implementation of the Default_Value and
Default_Component_Value aspects as described in AI05-0228. Note
that there is no matching pragma or attribute definition clause
for these aspects (because it is difficult to get these working
because of freezing problems resulting from resolving the aspect
expression with the type to which the aspect applies).

The following test (compiled with -gnatj60) shows error cases:


Compiling: errval.ads

 1. pragma Ada_2012;
 2. package Errval is
 3.type R1 is new Integer with
 4.  Default_Value => 3; -- OK
 5.
 6.type R2 is new Integer with
 7.  Default_Value => 3,
 8.  Default_Value => 5; -- ERROR
 |
>>> aspect "Default_Value" for "R2" previously
given at line 7

 9.
10.type R3 is new R1 with
11.  Default_Value => 5; -- OK
12.
13.type Rec1 is null record;
14.type R3a is new Integer with
15.  Default_Value => Rec1'Size; -- ERROR
  |
>>> aspect "Default_Value" requires static
expression

16.
17.type AR1 is access Integer with
18.  Default_Value => null;  -- ERROR
 |
>>> aspect "Default_Value" can only be applied to
scalar type

19.
20.type R4b is new Integer with
21.  Default_Value => M1b;   -- OK
22.M1b : constant := 4;
23.
24.type R4a is new Integer with
25.  Default_Value => M1a;   -- ERROR
  |
>>> object "M1a" cannot be used before end of its
declaration

26.M1a : constant R4a := 4;
27.
28.type R4 is new Integer with
29.  Default_Value => M1;-- ERROR
  |
>>> object "M1" cannot be used before end of its
declaration

30.M1 : R4 := 4;
31.
32.subtype R1S is R1 with
33.  Default_Value => 4; -- ERROR
 |
>>> aspect "Default_Value" cannot apply to subtype

34.V : constant:= 3;
35.package Inner is
36.   type R5 is new Integer with
37. Default_Value => V;  -- ERROR
|
>>> visibility of aspect for "R5" changes after
freeze point

38.   R5V : R5;
  |
>>> info: "R5" is frozen here, aspects evaluated at
this point

39.   V : constant := 4;
40.end Inner;
41.
42.type S1 is
43.  new String (1 .. 3) with
44.Default_Component_Value => 'A';   -- OK
45.
46.type S2 is
47.  new String (1 .. 3) with
48.Default_Component_Value => 'A',
49.Default_Component_Value => 'B';   -- ERROR
   |
>>> aspect "Default_Component_Value" for "S2"
previously given at line 48

50.
51.K : Character := '3';
52.type S3 is
53.  new String (1 .. 3) with
54.Default_Component_Value => K; -- ERROR
  |
>>> aspect "Default_Component_Value" requires
static expression
>>> "K" is not static constant or named number (RM
4.9(5))

55.
56.S1V : S1;
57.
58.type S3a is array (1 .. 3) of S1 with
59.  Default_Component_Value => S1V; -- ERROR
 |
>>> aspect "Default_Component_Value" requires
scalar components

60.
61.subtype S4 is S1 with
62.  Default_Component_Value => 'X'; -- ERROR
 |
>>> aspect "Default_Component_Value" cannot apply
to subtype

63.
64.C : constant Character := 'X';
65.package Inner2 is
66.   type S4 is
67. new String (1 .. 4) with
68.   Default_Component_Value => C; -- ERROR
  |
>>> visibility of aspect for "S4" changes after
freeze point

69.   VS4 : S4 := "ABCD";
  |
>>> info: "S4" is frozen here, aspects evaluated at
this point

70.   C : constant Character := '3';
71.end Inner2;
72. end Errval;

This test shows the aspects in action, it compiles
and executes quietly when compiled with -gnata -gnatws.

 1. pragma Ada_2012;
 2. procedure DefTest is
 3.type R is new Integer with
 4.  Default_Value => 3;
 5.subtype RS is R range 4 .. 10;
 6.
 7.type A is array (1 .. 10) of Integer
 8.  with Default_Component_Value => 5;
 9.
10. begin
11.declare
12.   RV : R;
13.begin
14.   pragma Assert (RV = 3);
15.end;
16.
17.begin
18.   declare
19.  RVS : RS;
20.   begin
 

Re: [PATCH][2/2][RFC] Fix PR49806, promote/demote binary operations in VRP

2011-08-02 Thread Richard Guenther
On Tue, 2 Aug 2011, Ira Rosen wrote:

> 
> 
> Richard Guenther  wrote on 02/08/2011 01:33:49 PM:
> >
> > On Tue, 2 Aug 2011, Ira Rosen wrote:
> >
> > >
> > > > +   /* Now we have matched the statement pattern
> > > > +
> > > > +rhs1 = (T1)x;
> > > > +rhs2 = (T1)y;
> > > > +op_result = rhs1 OP rhs2;
> > > > +lhs = (T2)op_result;
> > >
> > > Just a note that the patch I proposed for the vectorizer (
> > > http://gcc.gnu.org/ml/gcc-patches/2011-07/msg01472.html) also handles
> > > constants, multiple statements (i.e., op_result doesn't have to be
> promoted
> > > itself, but the sequence needs to end up with a promotion), and also it
> may
> > > use an intermediate type for OP. The tests in my patch don't match the
> > > pattern this patch detects.
> >
> > Ok, I only looked at the description of your patch, not the patch itself.
> >
> > The patch already handles constant 2nd operands.
> >
> > It shouldn't be difficult to handle multiple statements here, either by
> > instead of the above match only
> >
> > op_result = rhs1 OP rhs2;
> > lhs = (T2)op_result;
> >
> > and thus allow iteration on the promoted/demoted operation operands
> > or by collecting all defs first.
> >
> > Do you handle arbitrary def trees or only a linear chain as suggested
> > by
> >
> > + S2  x_T = (TYPE) x_t;
> > + S3  res0_T = op (x_T, C0);
> > + S4  res1_T = op (res0_T, C1);
> > + S5  ... = () res1_T;  - type demotion
> >
> > ?  Thus, do you handle res1_T = op (res0_T, res2_T) with a possibly
> > different TYPE in its def?
> 
> Only linear chains. But it doesn't seem too complicated to only check if
> res2_T is a result of a type promotion.

Thinking about it it probably makes sense to keep a variant of this
in the vectorizer - after all it has quite specific requirements on
operand sizes while VRP would probably demote as far as possible
(maybe taking PROMOTE_MODE into account).

A quick look at your patch reveals

+  if (gimple_assign_rhs_code (use_stmt) == CONVERT_EXPR)

CONVERT_EXPR_CODE_P (gimple_assign_rhs_code (use_stmt))

+  tmp = create_tmp_var (use_type, NULL);

create_tmp_reg

+  if (!types_compatible_p (TREE_TYPE (oprnd0), type)
+  || !types_compatible_p (TREE_TYPE (oprnd1), type)
+  || (TREE_CODE (oprnd0) != INTEGER_CST
+  && TREE_CODE (oprnd1) != INTEGER_CST))

it's always the second operand that is constant, you can simplify
the code to not handle CST op SSA.

+  code = gimple_assign_rhs_code (stmt);
+  if (code != LSHIFT_EXPR && code != RSHIFT_EXPR
+  && code != BIT_IOR_EXPR && code != BIT_XOR_EXPR && code != 
BIT_AND_EXPR)
+return false;
+
+  oprnd0 = gimple_assign_rhs1 (stmt);
+  oprnd1 = gimple_assign_rhs2 (stmt);
+  type = gimple_expr_type (stmt);
+  if (!types_compatible_p (TREE_TYPE (oprnd0), type)
+  || !types_compatible_p (TREE_TYPE (oprnd1), type)

for shifts the type compatibility check of oprnd1 isn't guaranteed
(but do we care?  we only will handle constant shift amounts), for
the other operands of the codes you handle they always return true.

So I'd simplify the check to

  if (TREE_CODE (oprnd0) != SSA_NAME
  || TREE_CODE (oprnd1) != INTEGER_CST)
return false;

Otherwise the patch looks sensible.

Richard.


[Ada] Premature finalization when iterating over containers

2011-08-02 Thread Arnaud Charlet
This patch supresses the finalization of an intermediate copy produced when a
cursor iterates over a collection. The intermediate copy is still finalized
when the associated loop goes out of scope.


-- Source --


--  types.ads

with Ada.Containers.Doubly_Linked_Lists;
package Types is
   package Lists is new Ada.Containers.Doubly_Linked_Lists (Integer);
   use Lists;

   function  Get_List   (L : List) return List;
   procedure Print_List (L : List);
   procedure Zero_List  (L : in out List) with
 Post => (for all Index in Get_List (L) => Element (Index) = 0);
end Types;

--  types.adb

with Ada.Text_IO; use Ada.Text_IO;
package body Types is
   function Get_List (L : List) return List is
   begin
  return L;
   end Get_List;

   procedure Print_List (L : List) is
   begin
  for Element of Get_List (L) loop
 Put_Line (Integer'Image (Element));
  end loop;
   end Print_List;

   procedure Zero_List (L : in out List) is
  Result : Lists.List;
   begin
  for I of L loop
 Put_Line (Integer'Image (I));
  end loop;

  Result.Append (0);
  L := Result;
   end Zero_List;
end Types;

--  main.adb

with Types; use Types;
procedure Main is
   L : Lists.List;
begin
   L.Append (111);
   L.Append (1234);
   L.Append (-);

   Zero_List  (L);
   Print_List (L);
end Main;

-
-- Compilation --
-

gnatmake -q -gnat12 -gnata main.adb

-
-- Expected output --
-

 111
 1234
-
 0

Tested on x86_64-pc-linux-gnu, committed on trunk

2011-08-02  Hristian Kirtchev  

* exp_ch5.adb (Expand_Iterator_Loop): Code cleanup and reorganization.
Set the associated loop as the related expression of internally
generated cursors.
* exp_ch7.adb (Is_Container_Cursor): New routine.
(Wrap_Transient_Declaration): Supress the finalization of the list
controller when the declaration denotes a container cursor.

Index: exp_ch5.adb
===
--- exp_ch5.adb (revision 177147)
+++ exp_ch5.adb (working copy)
@@ -2859,13 +2859,10 @@
  --  with the obvious replacements if "reverse" is specified.
 
  declare
-Element_Type  : constant Entity_Id := Etype (Id);
-Pack  : constant Entity_Id := Scope (Base_Type (Typ));
-Name_Init : Name_Id;
-Name_Step : Name_Id;
-Cond  : Node_Id;
-Cursor_Decl   : Node_Id;
-Renaming_Decl : Node_Id;
+Element_Type : constant Entity_Id := Etype (Id);
+Pack : constant Entity_Id := Scope (Base_Type (Typ));
+Name_Init: Name_Id;
+Name_Step: Name_Id;
 
  begin
 Stats := Statements (N);
@@ -2876,52 +2873,24 @@
Cursor := Id;
 end if;
 
+--  Must verify that the container has a reverse iterator ???
+
 if Reverse_Present (I_Spec) then
-
-   --  Must verify that the container has a reverse iterator ???
-
Name_Init := Name_Last;
Name_Step := Name_Previous;
-
 else
Name_Init := Name_First;
Name_Step := Name_Next;
 end if;
 
---  C : Cursor_Type := Container.First;
+--  The code below only handles containers where Element is not a
+--  primitive operation of the container. This excludes for now the
+--  Hi-Lite formal containers. Generate:
+--
+--Id : Element_Type renames Container.Element (Cursor);
 
-Cursor_Decl :=
-  Make_Object_Declaration (Loc,
-Defining_Identifier => Cursor,
-Object_Definition   =>
-  Make_Selected_Component (Loc,
-Prefix=> New_Occurrence_Of (Pack, Loc),
-Selector_Name => Make_Identifier (Loc, Name_Cursor)),
-Expression =>
-  Make_Selected_Component (Loc,
-Prefix=> Relocate_Node (Container),
-Selector_Name => Make_Identifier (Loc, Name_Init)));
-
-Insert_Action (N, Cursor_Decl);
-
---  while C /= No_Element loop
-
-Cond := Make_Op_Ne (Loc,
-  Left_Opnd  => New_Occurrence_Of (Cursor, Loc),
-  Right_Opnd => Make_Selected_Component (Loc,
- Prefix=> New_Occurrence_Of (Pack, Loc),
- Selector_Name =>
-   Make_Identifier (Loc, Name_No_Element)));
-
 if Of_Present (I_Spec) then
-
-   --  Id : Element_Type renames Container.Element (Cursor);
-
-   --  The code below only handles containers where Element is not
-   --  a primitive operation of the cont

Re: [patch tree-optimization]: Avoid !=/== 0/1 comparisons for boolean-typed argument

2011-08-02 Thread Richard Guenther
On Tue, Aug 2, 2011 at 3:14 PM, Kai Tietz  wrote:
> 2011/8/2 Richard Guenther :
>> On Tue, Aug 2, 2011 at 12:17 PM, Kai Tietz  wrote:
>>> Hello,
>>>
>>> this patch removes in forward-propagation useless comparisons X != 0
>>> and X != ~0 for boolean-typed X.  For one-bit precision typed X we
>>> simplifiy X == 0 (and X != ~0) to ~X, and for X != 0 (and X == ~0) to
>>> X.
>>> For none one-bit precisione typed X, we simplify here X == 0 -> X ^ 1,
>>> and for X != 0 -> X.  We can do this as even for Ada - which has only
>>> boolean-type with none-one-bit precision - the truth-value is one.
>>
>> This isn't a simplification but a canonicalization and thus should be
>> done by fold_stmt instead (we are not propagating anything after all).
>> In fact, fold_stmt should do parts of this already by means of its
>> canonicalizations via fold.
>
> Well, it simplifies and canonicalizes.  But to put this into
> gimple-fold looks better.
>
>>> Additionally this patch changes for function
>>> forward_propagate_comparison the meaning of true-result.  As this
>>> result wasn't used and it is benefitial to use this propagation also
>>
>> which is a bug - for a true return value we need to set cfg_changed to true.
>
> I addressed this in my updated patch (see below)
>
>>> in second loop in function ssa_forward_propagate_and_combine, it
>>> returns true iff statement was altered.  Additionally this function
>>> handles now the boolean-typed simplifications.
>>
>> why call it twice?  How should that be "beneficial"?  I think that
>> forward_propagate_into_comparison should instead fold the changed
>> statement.
>
> Well, due missing fold_stmt call, there were still none-converted
> comparisons. I've added here the call to fold_stmt_inplace, and it
> solved the issue.
>
>>> For the hunk in gimple.c for function canonicalize_cond_expr_cond:
>>> This change seems to show no real effect, but IMHO it makes sense to
>>> add here the check for cast from boolean-type to be consitant.
>>
>> Probably yes.
>>
>> Thanks,
>> Richard.
>
>
> 2011-08-02  Kai Tietz  
>
>       * gimple.c (canonicalize_cond_expr_cond): Handle cast from boolean-type.
>       (ssa_forward_propagate_and_combine): Interprete result of
>       forward_propagate_comparison.
>       * gcc/gimple-fold.c (fold_gimple_assign): Add canonicalization for
>       boolean-typed operands for comparisons.
>
> 2011-08-02  Kai Tietz  
>
>        * gcc.dg/tree-ssa/forwprop-15.c: New testcase.
>
> Regression tested and bootstrapped for all languages (including Ada
> and Obj-C++).  Ok for apply?

Comments below

> Regards,
> Kai
>
> Index: gcc/gcc/testsuite/gcc.dg/tree-ssa/forwprop-15.c
> ===
> --- /dev/null
> +++ gcc/gcc/testsuite/gcc.dg/tree-ssa/forwprop-15.c
> @@ -0,0 +1,14 @@
> +/* { dg-do compile } */
> +/* { dg-options "-O2 -fdump-tree-forwprop1" }  */
> +
> +_Bool
> +foo (_Bool a, _Bool b, _Bool c
> +{
> +  _Bool r1 = a == 0 & b != 0;
> +  _Bool r2 = b != 0 & c == 0;
> +  return (r1 == 0 & r2 == 0);
> +}
> +
> +/* { dg-final { scan-tree-dump-times " == " 0 "forwprop1" } } */
> +/* { dg-final { scan-tree-dump-times " != " 0 "forwprop1" } } */
> +/* { dg-final { cleanup-tree-dump "forwprop1" } } */
> Index: gcc/gcc/gimple-fold.c
> ===
> --- gcc.orig/gcc/gimple-fold.c
> +++ gcc/gcc/gimple-fold.c
> @@ -814,6 +814,34 @@ fold_gimple_assign (gimple_stmt_iterator
>                                             gimple_assign_rhs1 (stmt),
>                                             gimple_assign_rhs2 (stmt));
>        }
> +      else if (gimple_assign_rhs_code (stmt) == EQ_EXPR
> +               || gimple_assign_rhs_code (stmt) == NE_EXPR)
> +        {
> +         tree op1 = gimple_assign_rhs1 (stmt);
> +         tree op2 = gimple_assign_rhs2 (stmt);
> +         tree type = TREE_TYPE (op1);
> +         if (useless_type_conversion_p (TREE_TYPE (gimple_assign_lhs (stmt)),
> +                                        type)
> +             && TREE_CODE (op2) == INTEGER_CST)

first check op2, it's cheaper.  put the lhs into a local var to avoid the
excessive long line.

And add a comment what you check here - cost me some 2nd thoguht.
Like

  /* Check whether the comparison operands are of the same boolean
 type as the result type is.  */

> +           {
> +             gimple s;
> +             bool inverted = (gimple_assign_rhs_code (stmt) == EQ_EXPR);
> +             if (!integer_zerop (op2))
> +               inverted = !inverted;

For non-1-precision bools I believe you can have non-1 and non-0 op2.
So you better explicitly check.  The code also isn't too easy to follow,
just enumerating the four cases wouldn't cause too much bloat, no?

> +             if (inverted == false)
> +               result = op1;
> +             else if (TREE_CODE (op1) == SSA_NAME
> +                      && (s = SSA_NAME_DEF_STMT (op1)) != NULL
> +                      && is_gi

[Ada] Premature finalization when iterating over containers

2011-08-02 Thread Arnaud Charlet
This patch adds code to ensure the timely finalization of a local element copy
when iterating over a container.


-- Source --


--  types.ads

with Ada.Containers.Doubly_Linked_Lists;
package Types is
   package Lists is new Ada.Containers.Doubly_Linked_Lists (Integer);
   use Lists;

   function  Get_List   (L : List) return List;
   procedure Print_List (L : List);
   procedure Zero_List  (L : in out List) with
 Post => (for all Index in Get_List (L) => Element (Index) = 0);
end Types;

--  types.adb

with Ada.Text_IO; use Ada.Text_IO;
package body Types is
   function Get_List (L : List) return List is
   begin
  return L;
   end Get_List;

   procedure Print_List (L : List) is
   begin
  for Element of Get_List (L) loop
 Put_Line (Integer'Image (Element));
  end loop;
   end Print_List;

   procedure Zero_List (L : in out List) is
  Result : Lists.List;
   begin
  for I of L loop
 Put_Line (Integer'Image (I));
  end loop;

  Result.Append (0);
  L := Result;
   end Zero_List;
end Types;

--  main.adb

with Types; use Types;
procedure Main is
   L : Lists.List;
begin
   L.Append (111);
   L.Append (1234);
   L.Append (-);

   Zero_List  (L);
   Print_List (L);
end Main;

-
-- Compilation --
-

gnatmake -q -gnat12 -gnata main.adb

-
-- Expected output --
-

 111
 1234
-
 0

Tested on x86_64-pc-linux-gnu, committed on trunk

2011-08-02  Hristian Kirtchev  

* exp_ch5.adb (Expand_Iterator_Loop): Reformatting. Wrap the original
loop statements and the element renaming declaration with a block when
the element type is controlled.

Index: exp_ch5.adb
===
--- exp_ch5.adb (revision 177152)
+++ exp_ch5.adb (working copy)
@@ -2770,14 +2770,13 @@
   I_Spec : constant Node_Id:= Iterator_Specification (Isc);
   Id : constant Entity_Id  := Defining_Identifier (I_Spec);
   Loc: constant Source_Ptr := Sloc (N);
-  Stats  : constant List_Id:= Statements (N);
 
   Container : constant Node_Id   := Name (I_Spec);
   Container_Typ : constant Entity_Id := Etype (Container);
+  Cursor: Entity_Id;
+  New_Loop  : Node_Id;
+  Stats : List_Id := Statements (N);
 
-  Cursor   : Entity_Id;
-  New_Loop : Node_Id;
-
begin
   --  Processing for arrays
 
@@ -2839,25 +2838,32 @@
   --  Processing for containers
 
   else
- --  In both cases these require a cursor of the proper type
+ --  The for loop is expanded into a while loop which uses a container
+ --  specific cursor to examine each element.
 
  --Cursor : Pack.Cursor := Container.First;
  --while Cursor /= Pack.No_Element loop
- --   Obj : Pack.Element_Type renames Element (Cursor);
- --   --  for the "of" form
+ --   declare
+ --   --  the block is added when Element_Type is controlled
 
- --   
+ --  Obj : Pack.Element_Type := Element (Cursor);
+ --  --  for the "of" loop form
+ --   begin
+ --  
+ --   end;
 
  --   Pack.Next (Cursor);
  --end loop;
 
- --  with the obvious replacements if "reverse" is specified. Pack is
- --  the name of the package which instantiates the container.
+ --  If "reverse" is present, then the initialization of the cursor
+ --  uses Last and the step becomes Prev. Pack is the name of the
+ --  package which instantiates the container.
 
  declare
 Element_Type : constant Entity_Id := Etype (Id);
 Pack : constant Entity_Id :=
  Scope (Base_Type (Container_Typ));
+Decl : Node_Id;
 Cntr : Node_Id;
 Name_Init: Name_Id;
 Name_Step: Name_Id;
@@ -2873,26 +2879,52 @@
 
 --  The code below only handles containers where Element is not a
 --  primitive operation of the container. This excludes for now the
---  Hi-Lite formal containers. Generate:
---
---Id : Element_Type renames Container.Element (Cursor);
+--  Hi-Lite formal containers.
 
 if Of_Present (I_Spec) then
-   Prepend_To (Stats,
+
+   --  Generate:
+   --Id : Element_Type := Pack.Element (Cursor);
+
+   Decl :=
  Make_Object_Renaming_Declaration (Loc,
Defining_Identifier => Id,
Subtype_Mark =>
- New_Occurrence_Of (Element_Type, Loc),
+ New_Reference_To (Element_Type, Loc),
Name =>
  Make_Indexed_Component (Lo

Re: [RFC] hard-reg-set.h refactoring

2011-08-02 Thread Mike Stump

On Aug 2, 2011, at 12:51 AM, Paolo Bonzini wrote:

> On 08/01/2011 09:10 PM, Dimitrios Apostolou wrote:
>> 
>> Keeping my patch exactly the same, just changing the
>> hook_void_hard_reg_set to receive a (HOST_WIDEST_FAST_INT *) arg and
>> doing the necessary typecasts, added an extra 3 M instructions.
>> 
>> But the ix86_live_on_entry is only called 1233x times from df-scan.c.
>> This isn't enough to explain all this overhead.
> 
> Indeed, 0.2% is hard to attribute to anything anyway.

Only if you lack the tools to collect data.  :-(



[Ada] Iterators over containers of indefinite types

2011-08-02 Thread Arnaud Charlet
If the elements of the container are indefinite, the iterator must build the
actual subtypes of each element in the iteration. As this is done during
expansion, the analysis of the loop body must be delayed until the loop is
expanded as an iterator loop.
The following must compile quietly in Ada2012 mode:

with Ada.Containers.Indefinite_Vectors;
with Ada.Text_IO;
procedure ContIt is
use Ada;
package Str_Vect is
  new Containers.Indefinite_Vectors (Natural, String);
V : Str_Vect.Vector;
C : Str_Vect.Cursor;
use Str_Vect;
begin
V.Append ("toto");
V.Append ("everything");
V.Append ("absolument tout");

for E of V loop
  Text_IO.Put_Line ("> " & E);
end loop;
end ContIt;

Tested on x86_64-pc-linux-gnu, committed on trunk

2011-08-02  Ed Schonberg  

* sem_ch5.adb (Analyze_Loop_Statement):  If the iteration scheme is an
Ada2012 iterator, the loop will be rewritten during expansion into a
while loop with a cursor and an element declaration. Do not analyze the
body in this case, because if the container is for indefinite types the
actual subtype of the elements will only be determined when the cursor
declaration is analyzed.

Index: sem_ch5.adb
===
--- sem_ch5.adb (revision 177152)
+++ sem_ch5.adb (working copy)
@@ -2387,7 +2387,33 @@
   Kill_Current_Values;
   Push_Scope (Ent);
   Analyze_Iteration_Scheme (Iter);
-  Analyze_Statements (Statements (Loop_Statement));
+
+  --  Analyze the statements of the body except in the case of an Ada 2012
+  --  iterator with the expander active. In this case the expander will do
+  --  a rewrite of the loop into a while loop. We will then analyze the
+  --  loop body when we analyze this while loop.
+
+  --  We need to do this delay because if the container is for indefinite
+  --  types the actual subtype of the components will only be determined
+  --  when the cursor declaration is analyzed.
+
+  --  If the expander is not active, then we want to analyze the loop body
+  --  now even in the Ada 2012 iterator case, since the rewriting will not
+  --  be done.
+
+  if No (Iter)
+or else No (Iterator_Specification (Iter))
+or else not Expander_Active
+  then
+ Analyze_Statements (Statements (Loop_Statement));
+  end if;
+
+  --  Finish up processing for the loop. We kill all current values, since
+  --  in general we don't know if the statements in the loop have been
+  --  executed. We could do a bit better than this with a loop that we
+  --  know will execute at least once, but it's not worth the trouble and
+  --  the front end is not in the business of flow tracing.
+
   Process_End_Label (Loop_Statement, 'e', Ent);
   End_Scope;
   Kill_Current_Values;


[Ada] Pre/Postconditions on generic subprograms

2011-08-02 Thread Arnaud Charlet
This patch is a partial implementation of pre/postconditions that apply to
generic subprograms and are inherited by the corresponding instantiations.
This implementation does not defer the analysis of the corresponding aspects
to a later point, and therefore is restricted to conditions that only depend
on the formals and the generic formals of the unit.

The following must compile and execute quietly:

gnatmake -gnat12 -gnata try_list
try_list

---
with T; use T;
procedure Try_List is
   Short_List : Lists.List;
   function Inc (X : integer) return integer is
   begin
  return  X + 1;
   end Inc;
   procedure Map_Inc is new Map_F (Inc);
begin
   Short_List.Append (15);
   Map_Inc (Short_List);
end;
---
with Ada.Containers.Doubly_Linked_Lists;
package T is
   package Lists is new Ada.Containers.Doubly_Linked_Lists (Integer);
   use Lists;

   generic
  with function F (E : Integer) return Integer;
   procedure Map_F (L : in out List) with
 Pre => (for all Cu in L => Element (Cu) /= F (Element (Cu)));
end T;
---
package body T is
   procedure Map_F (L : in out List) is
  Current : Cursor := First (L);
   begin
  while Current /= No_Element loop
 Replace_Element (L, Current, F (Element (Current)));
 Next (Current);
  end loop;
   end Map_F;
end T;

Tested on x86_64-pc-linux-gnu, committed on trunk

2011-08-02  Ed Schonberg  

* sem_ch12.adb (Analyze_Generic_Subprogram_Declaration): copy properly
the aspect declarations and attach them to the generic copy for
subsequent analysis.
(Analyze_Subprogram_Instantiation): copy explicitly the aspect
declarations of the generic tree to the new subprogram declarations.
* sem_attr.adb (Check_Precondition_Postcondition): recognize
conditions that apply to a subprogram instance.

Index: sem_prag.adb
===
--- sem_prag.adb(revision 177147)
+++ sem_prag.adb(working copy)
@@ -1738,8 +1738,19 @@
 --  Skip stuff not coming from source
 
 elsif not Comes_From_Source (PO) then
-   null;
 
+   --  The condition may apply to a subprogram instantiation.
+
+   if Nkind (PO) = N_Subprogram_Declaration
+ and then Present (Generic_Parent (Specification (PO)))
+   then
+  Chain_PPC (PO);
+  return;
+
+   else
+  null;
+   end if;
+
 --  Only remaining possibility is subprogram declaration
 
 else
@@ -7554,6 +7565,7 @@
   then
  Set_Elaborate_Present (Citem, True);
  Set_Unit_Name (Get_Pragma_Arg (Arg), Name (Citem));
+ Generate_Reference (Entity (Name (Citem)), Citem);
 
  --  With the pragma present, elaboration calls on
  --  subprograms from the named unit need no further
Index: sem_ch12.adb
===
--- sem_ch12.adb(revision 177144)
+++ sem_ch12.adb(working copy)
@@ -2794,6 +2794,20 @@
   Set_Parent_Spec (New_N, Save_Parent);
   Rewrite (N, New_N);
 
+  --  The aspect specifications are not attached to the tree, and must
+  --  be copied and attached to the generic copy explicitly.
+
+  if Present (Aspect_Specifications (New_N)) then
+ declare
+Aspects : constant List_Id := Aspect_Specifications (N);
+ begin
+Set_Has_Aspects (N, False);
+Move_Aspects (New_N, N);
+Set_Has_Aspects (Original_Node (N), False);
+Set_Aspect_Specifications (Original_Node (N), Aspects);
+ end;
+  end if;
+
   Spec := Specification (N);
   Id := Defining_Entity (Spec);
   Generate_Definition (Id);
@@ -2888,16 +2902,42 @@
 
   Save_Global_References (Original_Node (N));
 
+  --  To capture global references, analyze the expressions of aspects,
+  --  and propagate information to original tree. Note that in this case
+  --  analysis of attributes is not delayed until the freeze point.
+  --  It seems very hard to recreate the proper visibility of the generic
+  --  subprogram at a later point because the analysis of an aspect may
+  --  create pragmas after the generic copies have been made ???
+
+  if Has_Aspects (N) then
+ declare
+Aspect : Node_Id;
+
+ begin
+Aspect := First (Aspect_Specifications (N));
+while Present (Aspect) loop
+   if Get_Aspect_Id (Chars (Identifier (Aspect)))
+  /= Aspect_Warnings
+   then
+  Analyze (Expression (Aspect));
+   end if;
+   Next (Aspect);
+end loop;
+
+Aspect := First (Aspect_Specifications (Original_Node (N)));
+ 

[PLUGIN] Install c-tree.h header

2011-08-02 Thread Romain Geissler
Hi,

For now, plugins can't compare types. This patch allows
c-tree.h to be installed as a plugin header, allowing
plugins to see "comptypes" (among other things).

Romain Geissler


2011-08-02  Romain Geissler  

* Makefile.in (PLUGIN_HEADERS): Add C_TREE_H.


Index: gcc/Makefile.in
===
--- gcc/Makefile.in (revision 176741)
+++ gcc/Makefile.in (working copy)
@@ -4584,7 +4584,7 @@ PLUGIN_HEADERS = $(TREE_H) $(CONFIG_H) $
   $(GGC_H) $(TREE_DUMP_H) $(PRETTY_PRINT_H) $(OPTS_H) $(PARAMS_H) plugin.def \
   $(tm_file_list) $(tm_include_list) $(tm_p_file_list) $(tm_p_include_list) \
   $(host_xm_file_list) $(host_xm_include_list) $(xm_include_list) \
-  intl.h $(PLUGIN_VERSION_H) $(DIAGNOSTIC_H) \
+  intl.h $(PLUGIN_VERSION_H) $(DIAGNOSTIC_H) ${C_TREE_H} \
   $(C_COMMON_H) c-family/c-objc.h $(C_PRETTY_PRINT_H) \
   tree-iterator.h $(PLUGIN_H) $(TREE_FLOW_H) langhooks.h incpath.h debug.h \
   $(EXCEPT_H) tree-ssa-sccvn.h real.h output.h $(IPA_UTILS_H) \


[Ada] Implementation of Ada2012 rules on preconditions for null procedures

2011-08-02 Thread Arnaud Charlet
Ada Issue AI05-0230 specifies that null procedures can only have inheritable
'Class preconditions. For compatibility with the earlier GNAT pragmas for
preconditions, this rule only applies to Ada2012 aspect specifications.

Compilation of p.ads must yield:

p.ads:5:06: aspect "Pre" requires 'Class for null procedure
p.ads:17:05: aspect "Pre" requires 'Class for abstract subprogram

---
package P is
   type I is interface;
   procedure Proc (Obj : I) is null
   with
 Pre => False; --  ERROR

  procedure Proc2 (Obj : in out I) is null
  with
Pre'Class => False;--  OK

  procedure Proc3 (Obj : in out I) is abstract
  with
Pre'Class => False;--  OK

  procedure Proc4 (Obj : in out I) is abstract
  with
Pre => False;--  ERROR

 procedure Proc5 (Obj : out I) is null;
 pragma Precondition (False);--  OK. GNAT pragma
end P;

Tested on x86_64-pc-linux-gnu, committed on trunk

2011-08-02  Ed Schonberg  

* sem_prag.adb (Chain_PPC): Implement AI04-0230: null procedures can
only have inheritable classwide pre/postconditions.

Index: sem_prag.adb
===
--- sem_prag.adb(revision 177157)
+++ sem_prag.adb(working copy)
@@ -1595,6 +1595,19 @@
 ("aspect % requires ''Class for abstract subprogram");
end if;
 
+--  AI05-0230:  the same restriction applies to null procedures.
+--  For compatibility with earlier uses of the Ada pragma, apply
+--  this rule only to aspect specifications.
+
+elsif Nkind (PO) = N_Subprogram_Declaration
+  and then Nkind (Specification (PO)) = N_Procedure_Specification
+  and then Null_Present (Specification (PO))
+  and then From_Aspect_Specification (N)
+  and then not Class_Present (N)
+then
+   Error_Pragma
+ ("aspect % requires ''Class for null procedure");
+
 elsif not Nkind_In (PO, N_Subprogram_Declaration,
 N_Generic_Subprogram_Declaration,
 N_Entry_Declaration)


[Ada] Ada 2012 AI-0113 Detection of conflicting external tags

2011-08-02 Thread Arnaud Charlet
This patch adds a runtime check to the elaboration of tagged types to raise
Program_Error if a user-specified external tag is the same as the external
tag for some other declaration. The following test must raise Program_Error
if compiled with -gnat12

package Pkg1 is
   type Typ is tagged null record;
   for Typ'External_Tag use "ext_T1";  
end;

package Pkg2 is
   type Typ is tagged null record;
   for Typ'External_Tag use "ext_T1";  
end;

with Pkg1;
with Pkg2;
procedure Main is
   O1 : Pkg1.Typ;
   O2 : Pkg2.Typ;
begin
   null;
end;

Command: gnatmake -q -gnatws -gnat12 main.adb; ./main
Output: raised PROGRAM_ERROR : duplicated external tag

Tested on x86_64-pc-linux-gnu, committed on trunk

2011-08-02  Javier Miranda  

* a-tags.ads, a-tags.adb (Check_TSD): New subprogram.
* rtsfind.ads (RE_Check_TSD): New runtime entity.
* exp_disp.adb (Make_DT): Generate call to the new runtime routine that
checks if the external tag of a type is the same as the external tag
of some other declaration.

Index: a-tags.adb
===
--- a-tags.adb  (revision 176998)
+++ a-tags.adb  (working copy)
@@ -303,6 +303,24 @@
   return This - Offset_To_Top (This);
end Base_Address;
 
+   ---
+   -- Check_TSD --
+   ---
+
+   procedure Check_TSD (TSD : Type_Specific_Data_Ptr) is
+  T : Tag;
+
+   begin
+  --  Verify that the external tag of this TSD is not registered in the
+  --  runtime hash table.
+
+  T := External_Tag_HTable.Get (To_Address (TSD.External_Tag));
+
+  if T /= null then
+ raise Program_Error with "duplicated external tag";
+  end if;
+   end Check_TSD;
+

-- Descendant_Tag --

Index: a-tags.ads
===
--- a-tags.ads  (revision 176998)
+++ a-tags.ads  (working copy)
@@ -421,6 +421,10 @@
--  Ada 2005 (AI-251): Displace "This" to point to the base address of
--  the object (that is, the address of the primary tag of the object).
 
+   procedure Check_TSD (TSD : Type_Specific_Data_Ptr);
+   --  Ada 2012 (AI-113): Raise Program_Error if the external tag of this TSD
+   --  is the same as the external tag for some other tagged type declaration.
+
function Displace (This : System.Address; T : Tag) return System.Address;
--  Ada 2005 (AI-251): Displace "This" to point to the secondary dispatch
--  table of T.
Index: rtsfind.ads
===
--- rtsfind.ads (revision 177138)
+++ rtsfind.ads (working copy)
@@ -551,6 +551,7 @@
  RE_Address_Array,   -- Ada.Tags
  RE_Addr_Ptr,-- Ada.Tags
  RE_Base_Address,-- Ada.Tags
+ RE_Check_TSD,   -- Ada.Tags
  RE_Cstring_Ptr, -- Ada.Tags
  RE_Descendant_Tag,  -- Ada.Tags
  RE_Dispatch_Table,  -- Ada.Tags
@@ -1729,6 +1730,7 @@
  RE_Address_Array=> Ada_Tags,
  RE_Addr_Ptr => Ada_Tags,
  RE_Base_Address => Ada_Tags,
+ RE_Check_TSD=> Ada_Tags,
  RE_Cstring_Ptr  => Ada_Tags,
  RE_Descendant_Tag   => Ada_Tags,
  RE_Dispatch_Table   => Ada_Tags,


Re: [patch tree-optimization]: Avoid !=/== 0/1 comparisons for boolean-typed argument

2011-08-02 Thread Kai Tietz
2011/8/2 Richard Guenther :
> On Tue, Aug 2, 2011 at 3:14 PM, Kai Tietz  wrote:
>> 2011/8/2 Richard Guenther :
>>> On Tue, Aug 2, 2011 at 12:17 PM, Kai Tietz  wrote:
 Hello,

 this patch removes in forward-propagation useless comparisons X != 0
 and X != ~0 for boolean-typed X.  For one-bit precision typed X we
 simplifiy X == 0 (and X != ~0) to ~X, and for X != 0 (and X == ~0) to
 X.
 For none one-bit precisione typed X, we simplify here X == 0 -> X ^ 1,
 and for X != 0 -> X.  We can do this as even for Ada - which has only
 boolean-type with none-one-bit precision - the truth-value is one.
>>>
>>> This isn't a simplification but a canonicalization and thus should be
>>> done by fold_stmt instead (we are not propagating anything after all).
>>> In fact, fold_stmt should do parts of this already by means of its
>>> canonicalizations via fold.
>>
>> Well, it simplifies and canonicalizes.  But to put this into
>> gimple-fold looks better.
>>
 Additionally this patch changes for function
 forward_propagate_comparison the meaning of true-result.  As this
 result wasn't used and it is benefitial to use this propagation also
>>>
>>> which is a bug - for a true return value we need to set cfg_changed to true.
>>
>> I addressed this in my updated patch (see below)
>>
 in second loop in function ssa_forward_propagate_and_combine, it
 returns true iff statement was altered.  Additionally this function
 handles now the boolean-typed simplifications.
>>>
>>> why call it twice?  How should that be "beneficial"?  I think that
>>> forward_propagate_into_comparison should instead fold the changed
>>> statement.
>>
>> Well, due missing fold_stmt call, there were still none-converted
>> comparisons. I've added here the call to fold_stmt_inplace, and it
>> solved the issue.
>>
 For the hunk in gimple.c for function canonicalize_cond_expr_cond:
 This change seems to show no real effect, but IMHO it makes sense to
 add here the check for cast from boolean-type to be consitant.
>>>
>>> Probably yes.
>>>
>>> Thanks,
>>> Richard.
>>
>>
>> 2011-08-02  Kai Tietz  
>>
>>       * gimple.c (canonicalize_cond_expr_cond): Handle cast from 
>> boolean-type.
>>       (ssa_forward_propagate_and_combine): Interprete result of
>>       forward_propagate_comparison.
>>       * gcc/gimple-fold.c (fold_gimple_assign): Add canonicalization for
>>       boolean-typed operands for comparisons.
>>
>> 2011-08-02  Kai Tietz  
>>
>>        * gcc.dg/tree-ssa/forwprop-15.c: New testcase.
>>
>> Regression tested and bootstrapped for all languages (including Ada
>> and Obj-C++).  Ok for apply?
>
> Comments below
>
>> Regards,
>> Kai
>>
>> Index: gcc/gcc/testsuite/gcc.dg/tree-ssa/forwprop-15.c
>> ===
>> --- /dev/null
>> +++ gcc/gcc/testsuite/gcc.dg/tree-ssa/forwprop-15.c
>> @@ -0,0 +1,14 @@
>> +/* { dg-do compile } */
>> +/* { dg-options "-O2 -fdump-tree-forwprop1" }  */
>> +
>> +_Bool
>> +foo (_Bool a, _Bool b, _Bool c
>> +{
>> +  _Bool r1 = a == 0 & b != 0;
>> +  _Bool r2 = b != 0 & c == 0;
>> +  return (r1 == 0 & r2 == 0);
>> +}
>> +
>> +/* { dg-final { scan-tree-dump-times " == " 0 "forwprop1" } } */
>> +/* { dg-final { scan-tree-dump-times " != " 0 "forwprop1" } } */
>> +/* { dg-final { cleanup-tree-dump "forwprop1" } } */
>> Index: gcc/gcc/gimple-fold.c
>> ===
>> --- gcc.orig/gcc/gimple-fold.c
>> +++ gcc/gcc/gimple-fold.c
>> @@ -814,6 +814,34 @@ fold_gimple_assign (gimple_stmt_iterator
>>                                             gimple_assign_rhs1 (stmt),
>>                                             gimple_assign_rhs2 (stmt));
>>        }
>> +      else if (gimple_assign_rhs_code (stmt) == EQ_EXPR
>> +               || gimple_assign_rhs_code (stmt) == NE_EXPR)
>> +        {
>> +         tree op1 = gimple_assign_rhs1 (stmt);
>> +         tree op2 = gimple_assign_rhs2 (stmt);
>> +         tree type = TREE_TYPE (op1);
>> +         if (useless_type_conversion_p (TREE_TYPE (gimple_assign_lhs 
>> (stmt)),
>> +                                        type)
>> +             && TREE_CODE (op2) == INTEGER_CST)
>
> first check op2, it's cheaper.  put the lhs into a local var to avoid the
> excessive long line.

Ok

> And add a comment what you check here - cost me some 2nd thoguht.
> Like
>
>  /* Check whether the comparison operands are of the same boolean
>     type as the result type is.  */
>
>> +           {
>> +             gimple s;
>> +             bool inverted = (gimple_assign_rhs_code (stmt) == EQ_EXPR);
>> +             if (!integer_zerop (op2))
>> +               inverted = !inverted;
>
> For non-1-precision bools I believe you can have non-1 and non-0 op2.
> So you better explicitly check.  The code also isn't too easy to follow,
> just enumerating the four cases wouldn't cause too much bloat, no?

Well, in my tests I haven't saw this for Ada.  An

[Ada] Ada 2012 AI-0113 Detection of conflicting external tags

2011-08-02 Thread Arnaud Charlet
This patch enables detection of conflicting external tags when compiling
under Ada 2005 mode. Required since this AI is a binding interpretation.

Tested on x86_64-pc-linux-gnu, committed on trunk

2011-08-02  Javier Miranda  

* exp_disp.adb (Make_DT): Generate call to Check_TSD in Ada 2005 mode.

Index: exp_disp.adb
===
--- exp_disp.adb(revision 177161)
+++ exp_disp.adb(working copy)
@@ -5995,10 +5995,17 @@
 
   -- Check_TSD (TSD'Unrestricted_Access);
 
-  --  Seems wrong to restrict this BI to Ada 2012 ???
+  --  This check is a consequence of AI05-0113-1/06, so it officially
+  --  applies to Ada 2005 (and Ada 2012). It might be argued that it is
+  --  a desirable check to add in Ada 95 mode, but we hesitate to make
+  --  this change, as it would be incompatible, and could conceivably
+  --  cause a problem in existing Aa 95 code.
 
+  --  We check for No_Run_Time_Mode here, because we do not want to pick
+  --  up the RE_Check_TSD entity and call it in No_Run_Time mode.
+
   if not No_Run_Time_Mode
-and then Ada_Version >= Ada_2012
+and then Ada_Version >= Ada_2005
 and then RTE_Available (RE_Check_TSD)
   then
  Append_To (Elab_Code,


[Ada] Allow run-time to be compiled with Normalize_Scalars

2011-08-02 Thread Arnaud Charlet
This patch allows the run-time to be compiled with normalize scalars.
More specifically, it fixes a warning about initialiation overlays
when Ada.Strings.Unbounded.Aux is compiled with this pragma. Note
that the previous fix to pragma Suppress_Initialization is required.

The following test should compile without generating warnings:

 1. pragma Warnings (Off);
 2. with Ada.Strings.Unbounded.Aux;
 3. pragma Warnings (On);
 4. package RunTimeNS is
 5. end;

when compiled in the presence of a gnat.adc file containing

pragma Normalize_Scalars

with the command

gnatmake -q runtimens -a -f

Tested on x86_64-pc-linux-gnu, committed on trunk

2011-08-02  Robert Dewar  

* a-stunau.ads: Add pragma Suppress_Initialization for Big_String
* freeze.adb (Warn_Overlay): Don't warn if initialization suppressed
* s-stalib.ads: Add pragma Suppress_Initialization for Big_String

Index: freeze.adb
===
--- freeze.adb  (revision 177161)
+++ freeze.adb  (working copy)
@@ -5874,15 +5874,16 @@
   --  tested for because predefined String types are initialized by inline
   --  code rather than by an init_proc). Note that we do not give the
   --  warning for Initialize_Scalars, since we suppressed initialization
-  --  in this case.
+  --  in this case. Also, do not warn if Suppress_Initialization is set.
 
   if Present (Expr)
 and then not Is_Imported (Ent)
+and then not Initialization_Suppressed (Typ)
 and then (Has_Non_Null_Base_Init_Proc (Typ)
-or else Is_Access_Type (Typ)
-or else (Normalize_Scalars
-  and then (Is_Scalar_Type (Typ)
- or else Is_String_Type (Typ
+   or else Is_Access_Type (Typ)
+   or else (Normalize_Scalars
+ and then (Is_Scalar_Type (Typ)
+or else Is_String_Type (Typ
   then
  if Nkind (Expr) = N_Attribute_Reference
and then Is_Entity_Name (Prefix (Expr))
Index: a-stunau.ads
===
--- a-stunau.ads(revision 176998)
+++ a-stunau.ads(working copy)
@@ -6,7 +6,7 @@
 --  --
 -- S p e c  --
 --  --
---  Copyright (C) 1992-2009, Free Software Foundation, Inc. --
+--  Copyright (C) 1992-2010, 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- --
@@ -38,7 +38,18 @@
pragma Preelaborate;
 
subtype Big_String is String (1 .. Positive'Last);
+   pragma Suppress_Initialization (Big_String);
+   --  Type used to obtain string access to given address. Initialization is
+   --  suppressed, since we never want to have variables of this type, and
+   --  we never want to attempt initialiazation of virtual variables of this
+   --  type (e.g. when pragma Normalize_Scalars is used).
+
type Big_String_Access is access all Big_String;
+   for Big_String_Access'Storage_Size use 0;
+   --  We use this access type to pass a pointer to an area of storage to be
+   --  accessed as a string. Of course when this pointer is used, it is the
+   --  responsibility of the accessor to ensure proper bounds. The storage
+   --  size clause ensures we do not allocate variables of this type.
 
procedure Get_String
  (U : Unbounded_String;
Index: s-stalib.ads
===
--- s-stalib.ads(revision 176998)
+++ s-stalib.ads(working copy)
@@ -57,9 +57,19 @@
pragma Preelaborate_05;
pragma Warnings (On);
 
-   type Big_String_Ptr is access all String (Positive);
+   subtype Big_String is String (1 .. Positive'Last);
+   pragma Suppress_Initialization (Big_String);
+   --  Type used to obtain string access to given address. Initialization is
+   --  suppressed, since we never want to have variables of this type, and
+   --  we never want to attempt initialiazation of virtual variables of this
+   --  type (e.g. when pragma Normalize_Scalars is used).
+
+   type Big_String_Ptr is access all Big_String;
for Big_String_Ptr'Storage_Size use 0;
-   --  A non-fat pointer type for null terminated strings
+   --  We use this access type to pass a pointer to an area of storage to be
+   --  accessed as a string. Of course when this pointer is used, it is the
+   --  responsibility of the accessor to ensure proper bounds. The storage
+   --  si

[Ada] Fix missing debug info for concatenation

2011-08-02 Thread Arnaud Charlet
The new concatenation circuitry installed some time ago, results in
missing debug information when a constant string is initialized with
the result of a concatenation. This is because the resulting generated
renaming did not generate required debug information. This patch fixes
the problem with concatenation, and is actually a little more general
than that, so may fix some other problems with missing debug info.

The following is a test program

 1. procedure debugconcat is
 2.x : string := "hello";
 3.y : string := "goodbye";
 4.z : constant string := x & y;
 5. begin
 6.null;
 7. end;

Before the patch, the debugger could not print the string z. With the
following script:

gnatmake debugconcat -g
cp gdbinit2 .gdbinit
gdb --quiet debugconcat.exe >log 2>&1
rm .gdbinit
grep " = " log

where gdbinit2 contains:
break debugconcat.adb:6
run
print z
quit
y

the output of the grep command should be:

$1 = "hellogoodbye"

Tested on x86_64-pc-linux-gnu, committed on trunk

2011-08-02  Robert Dewar  

* einfo.ads (Materialize_Entity): Document this is only for renamings
* exp_ch3.adb (Expand_N_Object_Declaration): Make sure we generate
required debug information in the case where we transform the object
declaration into a renaming declaration.
* exp_ch4.adb (Expand_Concatenate): Generate debug info for result
object
* exp_dbug.ads (Debug_Renaming_Declaration): Document setting of
Materialize_Entity.

Index: einfo.ads
===
--- einfo.ads   (revision 177161)
+++ einfo.ads   (working copy)
@@ -2943,11 +2943,10 @@
 --   used to reference tasks implementing such interface.
 
 --Materialize_Entity (Flag168)
---   Present in all entities. Set only for constant or renamed entities
---   which should be materialized for debugging purposes. In the case of
---   a constant, a memory location should be allocated containing the
---   value. In the case of a renaming, a memory location containing the
---   renamed address should be allocated.
+--   Present in all entities. Set only for renamed obects which should be
+--   materialized for debugging purposes. This means that a memory location
+--   containing the renamed address should be allocated. This is needed so
+--   that the debugger can find the entity.
 
 --Mechanism (Uint8) (returned as Mechanism_Type)
 --   Present in functions and non-generic formal parameters. Indicates
Index: exp_dbug.ads
===
--- exp_dbug.ads(revision 176998)
+++ exp_dbug.ads(working copy)
@@ -1082,7 +1082,8 @@
function Debug_Renaming_Declaration (N : Node_Id) return Node_Id;
--  The argument N is a renaming declaration. The result is a variable
--  declaration as described in the above paragraphs. If N is not a special
-   --  debug declaration, then Empty is returned.
+   --  debug declaration, then Empty is returned. This function also takes care
+   --  of setting Materialize_Entity on the renamed entity where required.
 
---
-- Packed Array Encoding --
Index: exp_ch4.adb
===
--- exp_ch4.adb (revision 177156)
+++ exp_ch4.adb (working copy)
@@ -2875,10 +2875,12 @@
 
   --  Now we construct an array object with appropriate bounds. We mark
   --  the target as internal to prevent useless initialization when
-  --  Initialize_Scalars is enabled.
+  --  Initialize_Scalars is enabled. Also since this is the actual result
+  --  entity, we make sure we have debug information for the result.
 
   Ent := Make_Temporary (Loc, 'S');
   Set_Is_Internal (Ent);
+  Set_Needs_Debug_Info (Ent);
 
   --  If the bound is statically known to be out of range, we do not want
   --  to abort, we want a warning and a runtime constraint error. Note that
Index: exp_ch3.adb
===
--- exp_ch3.adb (revision 177161)
+++ exp_ch3.adb (working copy)
@@ -34,6 +34,7 @@
 with Exp_Ch7;  use Exp_Ch7;
 with Exp_Ch9;  use Exp_Ch9;
 with Exp_Ch11; use Exp_Ch11;
+with Exp_Dbug; use Exp_Dbug;
 with Exp_Disp; use Exp_Disp;
 with Exp_Dist; use Exp_Dist;
 with Exp_Smem; use Exp_Smem;
@@ -5215,6 +5216,26 @@
 
 Set_Renamed_Object (Defining_Identifier (N), Expr_Q);
 Set_Analyzed (N);
+
+--  We do need to deal with debug issues for this renaming
+
+--  First, if entity comes from source, then mark it as needing
+--  debug information, even though it is defined by a generated
+--  renaming that does not come from source.
+
+if Comes_From_Source (Defining_Identifier (N)) then
+   Set_Needs_Debug_Info (Defining_Identifier (N));
+end if;
+
+

Re: [patch tree-optimization]: Avoid !=/== 0/1 comparisons for boolean-typed argument

2011-08-02 Thread Richard Guenther
On Tue, Aug 2, 2011 at 4:34 PM, Kai Tietz  wrote:
> 2011/8/2 Richard Guenther :
>> On Tue, Aug 2, 2011 at 3:14 PM, Kai Tietz  wrote:
>>> 2011/8/2 Richard Guenther :
 On Tue, Aug 2, 2011 at 12:17 PM, Kai Tietz  wrote:
> Hello,
>
> this patch removes in forward-propagation useless comparisons X != 0
> and X != ~0 for boolean-typed X.  For one-bit precision typed X we
> simplifiy X == 0 (and X != ~0) to ~X, and for X != 0 (and X == ~0) to
> X.
> For none one-bit precisione typed X, we simplify here X == 0 -> X ^ 1,
> and for X != 0 -> X.  We can do this as even for Ada - which has only
> boolean-type with none-one-bit precision - the truth-value is one.

 This isn't a simplification but a canonicalization and thus should be
 done by fold_stmt instead (we are not propagating anything after all).
 In fact, fold_stmt should do parts of this already by means of its
 canonicalizations via fold.
>>>
>>> Well, it simplifies and canonicalizes.  But to put this into
>>> gimple-fold looks better.
>>>
> Additionally this patch changes for function
> forward_propagate_comparison the meaning of true-result.  As this
> result wasn't used and it is benefitial to use this propagation also

 which is a bug - for a true return value we need to set cfg_changed to 
 true.
>>>
>>> I addressed this in my updated patch (see below)
>>>
> in second loop in function ssa_forward_propagate_and_combine, it
> returns true iff statement was altered.  Additionally this function
> handles now the boolean-typed simplifications.

 why call it twice?  How should that be "beneficial"?  I think that
 forward_propagate_into_comparison should instead fold the changed
 statement.
>>>
>>> Well, due missing fold_stmt call, there were still none-converted
>>> comparisons. I've added here the call to fold_stmt_inplace, and it
>>> solved the issue.
>>>
> For the hunk in gimple.c for function canonicalize_cond_expr_cond:
> This change seems to show no real effect, but IMHO it makes sense to
> add here the check for cast from boolean-type to be consitant.

 Probably yes.

 Thanks,
 Richard.
>>>
>>>
>>> 2011-08-02  Kai Tietz  
>>>
>>>       * gimple.c (canonicalize_cond_expr_cond): Handle cast from 
>>> boolean-type.
>>>       (ssa_forward_propagate_and_combine): Interprete result of
>>>       forward_propagate_comparison.
>>>       * gcc/gimple-fold.c (fold_gimple_assign): Add canonicalization for
>>>       boolean-typed operands for comparisons.
>>>
>>> 2011-08-02  Kai Tietz  
>>>
>>>        * gcc.dg/tree-ssa/forwprop-15.c: New testcase.
>>>
>>> Regression tested and bootstrapped for all languages (including Ada
>>> and Obj-C++).  Ok for apply?
>>
>> Comments below
>>
>>> Regards,
>>> Kai
>>>
>>> Index: gcc/gcc/testsuite/gcc.dg/tree-ssa/forwprop-15.c
>>> ===
>>> --- /dev/null
>>> +++ gcc/gcc/testsuite/gcc.dg/tree-ssa/forwprop-15.c
>>> @@ -0,0 +1,14 @@
>>> +/* { dg-do compile } */
>>> +/* { dg-options "-O2 -fdump-tree-forwprop1" }  */
>>> +
>>> +_Bool
>>> +foo (_Bool a, _Bool b, _Bool c
>>> +{
>>> +  _Bool r1 = a == 0 & b != 0;
>>> +  _Bool r2 = b != 0 & c == 0;
>>> +  return (r1 == 0 & r2 == 0);
>>> +}
>>> +
>>> +/* { dg-final { scan-tree-dump-times " == " 0 "forwprop1" } } */
>>> +/* { dg-final { scan-tree-dump-times " != " 0 "forwprop1" } } */
>>> +/* { dg-final { cleanup-tree-dump "forwprop1" } } */
>>> Index: gcc/gcc/gimple-fold.c
>>> ===
>>> --- gcc.orig/gcc/gimple-fold.c
>>> +++ gcc/gcc/gimple-fold.c
>>> @@ -814,6 +814,34 @@ fold_gimple_assign (gimple_stmt_iterator
>>>                                             gimple_assign_rhs1 (stmt),
>>>                                             gimple_assign_rhs2 (stmt));
>>>        }
>>> +      else if (gimple_assign_rhs_code (stmt) == EQ_EXPR
>>> +               || gimple_assign_rhs_code (stmt) == NE_EXPR)
>>> +        {
>>> +         tree op1 = gimple_assign_rhs1 (stmt);
>>> +         tree op2 = gimple_assign_rhs2 (stmt);
>>> +         tree type = TREE_TYPE (op1);
>>> +         if (useless_type_conversion_p (TREE_TYPE (gimple_assign_lhs 
>>> (stmt)),
>>> +                                        type)
>>> +             && TREE_CODE (op2) == INTEGER_CST)
>>
>> first check op2, it's cheaper.  put the lhs into a local var to avoid the
>> excessive long line.
>
> Ok
>
>> And add a comment what you check here - cost me some 2nd thoguht.
>> Like
>>
>>  /* Check whether the comparison operands are of the same boolean
>>     type as the result type is.  */
>>
>>> +           {
>>> +             gimple s;
>>> +             bool inverted = (gimple_assign_rhs_code (stmt) == EQ_EXPR);
>>> +             if (!integer_zerop (op2))
>>> +               inverted = !inverted;
>>
>> For non-1-precision bools I believe you can have non-1 and non-0 op2.
>> So y

[Ada] Better error message for Excluded_Source_List_File

2011-08-02 Thread Arnaud Charlet
When an error is reported for an excluded source that is listed in a file
include the file name and the number of the line of the excluded source.

Tested on x86_64-pc-linux-gnu, committed on trunk

2011-08-02  Vincent Celier  

* prj-nmsc.adb (File_Found): New components Excl_File and Excl_Line
(No_Space_Img): New function
(Find_Excluded_Sources): When reading from a file, record the file name
and the line number for each excluded source.
(Mark_Excluded_Sources): When reporting an error, if the excluded
sources were read from a file, include file name and line number in
the error message.

Index: prj-nmsc.adb
===
--- prj-nmsc.adb(revision 177123)
+++ prj-nmsc.adb(working copy)
@@ -6,7 +6,7 @@
 --  --
 -- B o d y  --
 --  --
---  Copyright (C) 2000-2010, Free Software Foundation, Inc. --
+--  Copyright (C) 2000-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- --
@@ -106,12 +106,15 @@
--  exceptions specified in the project files.
 
type File_Found is record
-  File : File_Name_Type  := No_File;
-  Found: Boolean := False;
-  Location : Source_Ptr  := No_Location;
+  File  : File_Name_Type := No_File;
+  Excl_File : File_Name_Type := No_File;
+  Excl_Line : Natural:= 0;
+  Found : Boolean:= False;
+  Location  : Source_Ptr := No_Location;
end record;
 
-   No_File_Found : constant File_Found := (No_File, False, No_Location);
+   No_File_Found : constant File_Found :=
+ (No_File, No_File, 0, False, No_Location);
 
package Excluded_Sources_Htable is new GNAT.Dynamic_HTables.Simple_HTable
  (Header_Num => Header_Num,
@@ -522,6 +525,9 @@
   Project  : Project_Id);
--  Emits either an error or warning message (or nothing), depending on Kind
 
+   function No_Space_Img (N : Natural) return String;
+   --  Image of a Natural without the initial space
+
--
-- Error_Or_Warning --
--
@@ -5507,6 +5513,16 @@
   end if;
end Get_Sources_From_File;
 
+   --
+   -- No_Space_Img --
+   --
+
+   function No_Space_Img (N : Natural) return String is
+  Image : constant String := N'Img;
+   begin
+  return Image (2 .. Image'Last);
+   end No_Space_Img;
+
---
-- Compute_Unit_Name --
---
@@ -6045,7 +6061,8 @@
 end if;
 
 Excluded_Sources_Htable.Set
-  (Project.Excluded, Name, (Name, False, Location));
+  (Project.Excluded, Name,
+   (Name, No_File, 0, False, Location));
 Current := Element.Next;
  end loop;
 
@@ -6053,10 +6070,14 @@
  Location := Excluded_Source_List_File.Location;
 
  declare
+Source_File_Name : constant File_Name_Type :=
+ File_Name_Type
+(Excluded_Source_List_File.Value);
+Source_File_Line : Natural := 0;
+
 Source_File_Path_Name : constant String :=
   Path_Name_Of
-(File_Name_Type
-   (Excluded_Source_List_File.Value),
+(Source_File_Name,
  Project.Project.Directory.Name);
 
  begin
@@ -6082,6 +6103,7 @@
 
   while not Prj.Util.End_Of_File (File) loop
  Prj.Util.Get_Line (File, Line, Last);
+ Source_File_Line := Source_File_Line + 1;
 
  --  Non empty, non comment line should contain a file name
 
@@ -6110,7 +6132,10 @@
 end loop;
 
 Excluded_Sources_Htable.Set
-  (Project.Excluded, Name, (Name, False, Location));
+  (Project.Excluded,
+   Name,
+   (Name, Source_File_Name, Source_File_Line,
+False, Location));
  end if;
   end loop;
 
@@ -7579,14 +7604,36 @@
Err_Vars.Error_Msg_File_1 := Excluded.File;
 
if Src = No_Source then
-  Error_Msg
+  if Excluded.Excl_File = No_File then
+ Error_Msg
+   

[Ada] Primitive operations of formals when actual is class-wide

2011-08-02 Thread Arnaud Charlet
If the actual for a formal type with unknown discriminants is class-wide, then
a call to a primitive operation of the formal that dispatches on result raises
program_error in the instance if the context cannot provide a tag for the call.
This is the case for a declaration of an object of the formal type. This rule
was not previously enforced by GNAT.

The following commands:

gnatmake -q test_class
test_class

must yield:

   Tag of XX is P2.T1
   Raised on T1

---
with P1; use P1;
with P2; use P2;
with Text_IO; use Text_IO;
procedure Test_Class is
   Obj : T1;
begin
begin
   I.Test (Obj);
exception
   when Program_Error => Put_Line ("Raised on T1");
end;
end;
---
with P1; use P1;
generic
   type NT(<>) is new T with private;
-- T has operation "function Empty return T;"
package G is
   procedure Test(XX : in out NT);
end G;
---
with Ada.Tags; use Ada.Tags;
with Text_IO; use Text_IO;
package body G is
   procedure Test(XX : in out NT) is
   begin
  XX := Empty;  -- Dispatching based on X'Tag takes
-- place if actual is class-wide.
  Put_Line ("Tag of XX is " & External_Tag (NT'class (XX)'Tag));
  declare
  YY : NT := Empty;
   -- If actual is class-wide, this raises Program_Error
   -- as there is no tag provided by context.
  begin
  XX := YY;  -- We never get this far.
  end;
   end Test;
end G;
---
package P1 is
   type T is tagged null record;
   function Empty return T;
end P1;
---
package body P1 is
   --  type T is tagged null record;
   function Empty return T is
  result : T;
   begin
  return Result;
   end;
end P1;
---
with G;
with P1; use P1;
package P2 is
   type T1 is new T with null record;
   function Empty return T1;
   package I is new G (T1'Class);
end;
---
package body P2 is
   --  type T1 is new T with null record;
   function Empty return T1 is
  Result : T1;
   begin
  return Result;
   end;
end;

Tested on x86_64-pc-linux-gnu, committed on trunk

2011-08-02  Ed Schonberg  

* sem_res.adb (Resolve_Call): implement rule in RM 12.5.1 (23.3/2).

Index: sem_res.adb
===
--- sem_res.adb (revision 177153)
+++ sem_res.adb (working copy)
@@ -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- --
@@ -5751,6 +5751,44 @@
 -- Check_Formal_Restriction ("function not inherited", N);
 --  end if;
 
+  --  Implement rule in 12.5.1 (23.3/2) : in an instance, if the actual
+  --  is class-wide and the call dispatches on result in a context that
+  --  does not provide a tag, the call raises Program_Error.
+
+  if Nkind (N) = N_Function_Call
+and then In_Instance
+and then Is_Generic_Actual_Type (Typ)
+and then Is_Class_Wide_Type (Typ)
+and then Has_Controlling_Result (Nam)
+and then Nkind (Parent (N)) = N_Object_Declaration
+  then
+
+ --  verify that none of the formals are controlling.
+
+ declare
+Call_OK :  Boolean := False;
+F   : Entity_Id;
+
+ begin
+F := First_Formal (Nam);
+while Present (F) loop
+   if Is_Controlling_Formal (F) then
+  Call_OK := True;
+  exit;
+   end if;
+   Next_Formal (F);
+end loop;
+
+if not Call_OK then
+   Error_Msg_N ("!? cannot determine tag of result", N);
+   Error_Msg_N ("!? Program_Error will be raised", N);
+   Insert_Action (N,
+ Make_Raise_Program_Error (Sloc (N),
+Reason => PE_Explicit_Raise));
+end if;
+ end;
+  end if;
+
   --  All done, evaluate call and deal with elaboration issues
 
   Eval_Call (N);


[Ada] Optional section in ALI files for local cross-references

2011-08-02 Thread Arnaud Charlet
In ALFA mode, generate an additional section in ALI files for so-called 'local'
cross-references, which 1) group the cross-references in each subprogram or
package; 2) add references to object definitions ('D' or 'I' with
initialization). This new section should be used in specific back-ends which
need to compute the set of global variables read/written directly or not by a
subprogram.

Tested on x86_64-pc-linux-gnu, committed on trunk

2011-08-02  Yannick Moy  

* lib-writ.adb (Write_ALI): when ALFA mode is set, write local
cross-references section in ALI.
* lib-xref.adb, lib-xref.ads (Xref_Entry): add components Sub
(enclosing subprogram), Slc (location of Sub) and Sun (unit number of
Sub).
(Enclosing_Subprogram_Or_Package): new function to return the enclosing
subprogram or package entity of a node
(Is_Local_Reference_Type): new function returns True for references
selected in local cross-references.
(Lt): function extracted from Lt in Output_References
(Write_Entity_Name): function extracted from Output_References
(Generate_Definition): generate reference with type 'D' for definition
of objects (object declaration and parameter specification), with
appropriate locations and units, for use in local cross-references.
(Generate_Reference): update fields Sub, Slc and Sun. Keep newly created
references of type 'I' for initialization in object definition.
(Output_References): move part of function Lt and procedure
Write_Entity_Name outside of the body. Ignore references of types 'D'
and 'I' introduced for local cross-references.
(Output_Local_References): new procedure to output the local
cross-references sections.
(Lref_Entity_Status): new array defining whether an entity is a local
* sem_ch3.adb (Analyze_Object_Declaration): call Generate_Reference
with 'I' type when initialization expression is present.
* get_scos.adb, get_scos.ads: Correct comments and typos

Index: get_scos.adb
===
--- get_scos.adb(revision 176998)
+++ get_scos.adb(working copy)
@@ -2,11 +2,11 @@
 --  --
 -- GNAT COMPILER COMPONENTS --
 --  --
--- G E T _ S C O S   --
+-- G E T _ S C O S  --
 --  --
 -- B o d y  --
 --  --
--- Copyright (C) 2009, Free Software Foundation, Inc.   --
+--   Copyright (C) 2009-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- --
Index: get_scos.ads
===
--- get_scos.ads(revision 176998)
+++ get_scos.ads(working copy)
@@ -2,11 +2,11 @@
 --  --
 -- GNAT COMPILER COMPONENTS --
 --  --
--- G E T _ S C O S   --
+-- G E T _ S C O S  --
 --  --
 -- S p e c  --
 --  --
--- Copyright (C) 2009, Free Software Foundation, Inc.   --
+--   Copyright (C) 2009-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- --
@@ -32,7 +32,7 @@
 
with function Getc return Character is <>;
--  Get next character, positioning the ALI file ready to read the following
-   --  character (equivalent to calling Skipc, then Nextc). If the end of file
+   --  character (equivalent to calling Nextc, then Skipc). If the end of file
--  is encountered, the value Types.EOF is returned.
 
with function Nextc return Character is <>;
@@ -54,5 +54,5 @@
 --  first chara

[Ada] Implementation of AI05-0071: class-wide ops for formal subprograms

2011-08-02 Thread Arnaud Charlet
>From the text of AI05-0071:
   If a generic unit has a subprogram_default specified by a box, and
   the corresponding actual parameter is omitted, then it is equivalent
   to an explicit actual parameter that is a usage name identical to the
   defining name of the formal. {If a subtype_mark in the profile of the
   formal_subprogram_declaration denotes a formal private or formal derived
   type and the actual type for this formal type is a class-wide type
   T'Class, then for the purposes of resolving this default_name at the
   point of the instantiation, for each primitive subprogram of T that has
   a matching defining name, that is directly visible at the point of the
   instantiation, and that has at least one controlling formal parameter,
   a corresponding subprogram with the same defining name is directly
   visible, but with T systematically replaced by T'Class in the types
   of its profile. The body of such a subprogram is as defined in
   12.5.1 for primitive subprograms of a formal type when the actual
   type is class-wide.}

This patch implements this resolution rule by creating the class-wide operation
and its body within an instance that has such a defaulted formal subprogram.

The following commands:

   gnatmake -q class_wide_default
   class_wide_default

must yield:

   Mangle T
   Mangle T1

---
with P1, P2; use P1, P2;
procedure Class_Wide_Default is
   Thing : T;
   Thing1 : T1;
begin
   I.Test (Thing);
   I.Test (Thing1);
end;
---
package P1 is
   type T is tagged null record;
   function Empty return T;
   procedure Mangle (X : T);
end P1;
---
with P1; use P1;
generic
   type NT(<>) is new T with private;
with procedure Mangle (X : NT) is <>;
package Gen_Pack is
   procedure Test(XX : in out NT);
end Gen_Pack;
---
with Gen_Pack;
with P1; use P1;
package P2 is
   type T1 is new T with null record;
   function Empty return T1;
   procedure Mangle (X : T1);
   package I is new Gen_Pack (T'Class);
end;
---
with Ada.Tags; use Ada.Tags;
with Text_IO; use Text_IO;
package body Gen_Pack is
   procedure Test(XX : in out NT) is
   begin
  Mangle (XX);
   end Test;
end Gen_Pack;
---
with Text_IO; use Text_IO;
package body P1 is
   function Empty return T is
  result : T;
   begin
  return Result;
   end;

   procedure Mangle (X : T) is
   begin
  Put_Line ("Mangle T");
   end;
end P1;
---
with Text_IO; use Text_IO;
package body P2 is
   function Empty return T1 is
  Result : T1;
   begin
  return Result;
   end;

   procedure Mangle (X : T1) is
   begin
  Put_Line ("Mangle T1");
   end;
   procedure Huh (Y : T1'class) is
   begin
  Mangle (Y);
   end;
end;

Tested on x86_64-pc-linux-gnu, committed on trunk

2011-08-02  Ed Schonberg  

* sem_ch8.adb (Analyze_Subprogram_Renaming): new procedure
Check_Class_Wide_Actual, to implement AI05-0071, on defaulted
primitive operations of class-wide actuals.

Index: sem_ch8.adb
===
--- sem_ch8.adb (revision 177152)
+++ sem_ch8.adb (working copy)
@@ -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- --
@@ -1614,6 +1614,179 @@
   --  before the subprogram it completes is frozen, and renaming indirectly
   --  renames the subprogram itself.(Defect Report 8652/0027).
 
+  function Check_Class_Wide_Actual return Entity_Id;
+  --  AI05-0071: In an instance, if the actual for a formal type FT with
+  --  unknown discriminants is a class-wide type CT, and the generic has
+  --  a formal subprogram with a box for a primitive operation of FT,
+  --  then the corresponding actual subprogram denoted by the default is a
+  --  class-wide operation whose body is a dispatching call. We replace the
+  --  generated renaming declaration:
+  --
+  --  procedure P (X : CT) renames P;
+  --
+  --  by a different renaming and a class-wide operation:
+  --
+  --  procedure Pr (X : T) renames P;   --  renames primitive operation
+  --  procedure P (X : CT); --  class-wide operation
+  --  ...
+  --  procedure P (X : CT) is begin Pr (X); end;  -- dispatching call
+
+  --  This rule only applies if there is no explicit visible class-wide
+  --  operation at the point of the instantiation.
+
+  -
+  -- Check_Class_Wide_Actual --
+  -

[Ada] Code cleanup

2011-08-02 Thread Arnaud Charlet
This patch does not change the functionality of the compiler. It removes
one argument that can be evaluated by the called routine.

No test required.

Tested on x86_64-pc-linux-gnu, committed on trunk

2011-08-02  Javier Miranda  

* exp_atag.ads, exp_atag.adb
(Build_Common_Dispatching_Select_Statements): Remove argument Loc
since its value is implicitly passed in argument Typ.
* exp_disp.adb (Make_Disp_Conditional_Select_Body,
Make_Disp_Timed_Select_Body): Remove Loc in calls to routine
Build_Common_Dispatching_Select_Statements.

Index: exp_atag.adb
===
--- exp_atag.adb(revision 177168)
+++ exp_atag.adb(working copy)
@@ -71,10 +71,10 @@

 
procedure Build_Common_Dispatching_Select_Statements
- (Loc: Source_Ptr;
-  Typ: Entity_Id;
+ (Typ: Entity_Id;
   Stmts  : List_Id)
is
+  Loc  : constant Source_Ptr := Sloc (Typ);
   Tag_Node : Node_Id;
 
begin
Index: exp_atag.ads
===
--- exp_atag.ads(revision 177169)
+++ exp_atag.ads(working copy)
@@ -35,12 +35,11 @@
--  location used in constructing the corresponding nodes.
 
procedure Build_Common_Dispatching_Select_Statements
- (Loc   : Source_Ptr;
-  Typ   : Entity_Id;
+ (Typ   : Entity_Id;
   Stmts : List_Id);
-   --  Ada 2005 (AI-345): Generate statements that are common between timed,
-   --  asynchronous, and conditional select expansion.
-   --  Comments required saying what parameters mean ???
+   --  Ada 2005 (AI-345): Build statements that are common to the expansion of
+   --  timed, asynchronous, and conditional select and append them to Stmts.
+   --  Typ is the tagged type used for dispatching calls.
 
procedure Build_CW_Membership
  (Loc  : Source_Ptr;
Index: exp_disp.adb
===
--- exp_disp.adb(revision 177169)
+++ exp_disp.adb(working copy)
@@ -2623,7 +2623,7 @@
  --   return;
  --end if;
 
- Build_Common_Dispatching_Select_Statements (Loc, Typ, Stmts);
+ Build_Common_Dispatching_Select_Statements (Typ, Stmts);
 
  --  Generate:
  --Bnn : Communication_Block;
@@ -3470,7 +3470,7 @@
  --   return;
  --end if;
 
- Build_Common_Dispatching_Select_Statements (Loc, Typ, Stmts);
+ Build_Common_Dispatching_Select_Statements (Typ, Stmts);
 
  --  Generate:
  --I := Get_Entry_Index (tag! (VP), S);


[Ada] Wrong conformance checking for null exclusions of dispatching ops

2011-08-02 Thread Arnaud Charlet
The compiler improperly checks subtype conformance of null exclusions on
anonymous access parameters in Ada 2005 cases involving dispatching operations.
In Ada 2005, controlling access parameters are defined to implicitly exclude
null (more properly, their anonymous access type excludes null). The test for
null exclusion conformance improperly tested the null exclusion of the formals
themselves rather than their type, but the Can_Never_Be_Null attribute is only
set consistently for access formals in Ada 95 mode. The fix is to test null
exclusion of the anonymous access types rather than the formals. This addresses
two problems: 1) a dispatching operation with access parameters declared in
an Ada 2005 unit that overrides a subprogram inherited from an Ada 95 unit
no longer has to use "not null" on its controlling access parameters, and
2) applying 'Access to a dispatching operation with controlling access formals
properly requires the corresponding formal in the expected access-to-subprogram
type to have an explicit null exclusion.


The first test case must compile quietly:

$ gcc -c nnull_incomp_b.ads

pragma Ada_95;
package NNull_Incomp_A is
   type My_Type is abstract tagged null record;
   procedure P (T : access My_Type) is abstract;
end;

pragma Ada_2005; --  This compiles if I use Ada_95 instead
with NNull_Incomp_A; use NNull_Incomp_A;
package NNull_Incomp_B is
   type My_Derived_Type is abstract new
 NNull_Incomp_A.My_Type with null record;
   procedure P (T : access My_Derived_Type) is abstract;
end;

The second test case must give the following error output when compiled with:
$ gcc -c -gnat05 acc_to_subp_conformance_bug.adb

 1. procedure Acc_To_Subp_Conformance_Bug is
 2.
 3.package Pkg is
 4.
 5.   type TT is tagged null record;
 6.
 7.   type Acc_TT_Proc_with_null is access procedure (X : access TT);
 8.
 9.   type Acc_TT_Proc_not_null is access procedure (X : not null 
access TT);
10.
11.   procedure Proc (X : access TT);
12.
13.end Pkg;
14.
15.package body Pkg is
16.
17.   procedure Proc (X : access TT) is
18.   begin
19.  null;
20.   end Proc;
21.
22.end Pkg;
23.
24.use Pkg;
25.
26.A1 : Acc_TT_Proc_with_null := Proc'Access;  -- ERROR (but GNAT 
doesn't flag)
 |
>>> not subtype conformant with declaration at line 7
>>> type of "X" does not match

27.A2 : Acc_TT_Proc_not_null  := Proc'Access;  -- OK (but GNAT flags an 
error)
28.
29. begin
30.null;
31. end Acc_To_Subp_Conformance_Bug;

 31 lines: 2 errors


procedure Acc_To_Subp_Conformance_Bug is

   package Pkg is

  type TT is tagged null record;

  type Acc_TT_Proc_with_null is access procedure (X : access TT);

  type Acc_TT_Proc_not_null is access procedure (X : not null access TT);

  procedure Proc (X : access TT);

   end Pkg;

   package body Pkg is

  procedure Proc (X : access TT) is
  begin
 null;
  end Proc;

   end Pkg;

   use Pkg;

   A1 : Acc_TT_Proc_with_null := Proc'Access;  -- ERROR (but GNAT doesn't flag)
   A2 : Acc_TT_Proc_not_null  := Proc'Access;  -- OK (but GNAT flags an error)

begin
   null;
end Acc_To_Subp_Conformance_Bug;

Tested on x86_64-pc-linux-gnu, committed on trunk

2011-08-02  Gary Dismukes  

* sem_ch6.adb (Check_Conformance): Revise the check for nonconforming
null exclusions to test Can_Never_Be_Null on the anonymous access types
of the formals rather than testing the formals themselves. Exclude this
check in cases where the Old_Formal is marked as a controlling formal,
to avoid issuing spurious errors for bodies completing dispatching
operations (due to the flag not getting set on controlling access
formals in body specs).
(Find_Corresponding_Spec): When checking full and subtype conformance of
subprogram bodies in instances, pass Designated and E in that order, for
consistency with the expected order of the formals (New_Id followed by
Old_Id).

Index: sem_ch6.adb
===
--- sem_ch6.adb (revision 177156)
+++ sem_ch6.adb (working copy)
@@ -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 S

[MELT] Add a few tree primitives

2011-08-02 Thread Romain Geissler
Hi,

I added a few primitives about trees, plus a string_to_long
conversion primitive and a foreach_pair_between iterator
that allows to iterate between two pairs of the same list (and
thus iterate on sublist).

Note: again, it's a git patch for Pierre until Basil returns.

Romain


0001-Add-a-few-functions.Changelog
Description: Binary data
From a4d3037f8b0c032f2ba56b89a35f41fe7939d75a Mon Sep 17 00:00:00 2001
From: Romain Geissler 
Date: Tue, 2 Aug 2011 16:55:02 +0200
Subject: [PATCH] Add a few functions.

---
 gcc/melt/warmelt-first.melt |   28 +
 gcc/melt/xtramelt-ana-base.melt |   51 +++
 2 files changed, 79 insertions(+), 0 deletions(-)

diff --git a/gcc/melt/warmelt-first.melt b/gcc/melt/warmelt-first.melt
index ef8affd..33383dc 100644
--- a/gcc/melt/warmelt-first.melt
+++ b/gcc/melt/warmelt-first.melt
@@ -1162,6 +1162,12 @@ an integer $I if $I is greater than $N.}#
   :doc #{Test that value string $S1 is greater than $S2.}#
   #{melt_string_less((melt_ptr_t)($s2), (melt_ptr_t)($s1))}#)
 
+(defprimitive string_to_long (string) :long
+	:doc #{Read a string value and returns the corresponding
+	long stuff. 0 is returned if an error occurs while reading.}#
+	#{
+		atol(melt_string_str($string))
+	}#)
 
 
 
@@ -3225,6 +3231,26 @@ nil.}#
 
 
 
+;;; citerator on pairs
+(defciterator foreach_pair_between
+  (start_pair end_pair) ;start formals 
+  eachpair ;state
+  (curpair curcomp) ;local formals
+  :doc #{The $FOREACH_PAIR_BETWEEN iterator goes between two (linked) pairs,
+  given by the start formal $START_PAIR and $END_PAIR. Local formals are $CURPAIR,
+  bound to the current pair, and $CURCOMP, bound to the current component within
+  the pair.}#
+   #{/* start $eachpair */
+   for ($curpair = $start_pair;
+	melt_magic_discr($curpair) == MELTOBMAG_PAIR;
+$curpair = melt_pair_tail($curpair)) {
+	$curcomp = melt_pair_head($curpair); }#
+   #{
+  if ($curpair == $end_pair) {
+ break;
+  }
+   } /* end $eachpair */}#
+)
 
 ;;; citerator on lists
 (defciterator foreach_in_list 
@@ -4085,6 +4111,7 @@ also $CLASS_ANY_BINDING and $CLASS_ENVIRONMENT.}#
  shortbacktrace_dbg
  string<
  string>
+ string_to_long
  stringconst2val
  the_meltcallcount
  the_callcount
@@ -4207,6 +4234,7 @@ also $CLASS_ANY_BINDING and $CLASS_ENVIRONMENT.}#
 
 ;; export the citerators & cmatchers defined above
 (export_values
+ foreach_pair_between
  foreach_in_list
  foreach_in_mapobject
  foreach_in_mapstring
diff --git a/gcc/melt/xtramelt-ana-base.melt b/gcc/melt/xtramelt-ana-base.melt
index 34afcf2..af29fde 100644
--- a/gcc/melt/xtramelt-ana-base.melt
+++ b/gcc/melt/xtramelt-ana-base.melt
@@ -1494,6 +1494,51 @@
 (defprimitive tree_uid (:tree tr) :long
   #{(($tr) ? (long) DECL_UID($tr) : NULL)}#)
 
+(defprimitive tree_chain_prepend (:tree purpose value chain) :tree
+	:doc #{Create a new TREE_LIST node with $PURPOSE and $VALUE trees
+	and chain it at the begining of $CHAIN. Returns the newly created
+	chain.}#
+	#{
+		tree_cons ($PURPOSE, $VALUE, $CHAIN)
+	}#)
+
+(defprimitive tree_chain_append (:tree purpose value chain) :tree
+	:doc #{Create a new TREE_LIST node with $PURPOSE and $VALUE trees
+	and chain it at the end of $CHAIN. Returns the newly created
+	chain (different from $CHAIN if $CHAIN is NULL_TREE).}#
+	#{
+		chainon ($CHAIN, tree_cons ($PURPOSE, $VALUE, NULL_TREE))
+	}#)
+
+(defprimitive tree_chain_join (:tree chain1 chain2) :tree
+	:doc #{Append $CHAIN2 to $CHAIN1 and returns the newly created
+	chain (different from $CHAIN1 if $CHAIN1 is NULL_TREE).}#
+	#{
+		chainon ($CHAIN1, $CHAIN2)
+	}#)
+
+(defprimitive build_identifier_tree (name) :tree
+	:doc #{Create and returns a new IDENTIFIER_NODE tree whose
+	name is $NAME.}#
+	#{
+		get_identifier (melt_string_str ($NAME))
+	}#)
+
+(defprimitive build_string_tree (string_value) :tree
+	:doc #{Create and returns a new STRING_CST tree whose
+	value is $STRING_VALUE.}#
+	#{
+		build_string (strlen (melt_string_str ($STRING_VALUE)), melt_string_str ($STRING_VALUE))
+	}#)
+
+(defprimitive build_int_tree (int_value) :tree
+	:doc #{Create and returns a new INTEGER_CST tree whose
+	value is $INT_VALUE and type is the default language
+	integer type.}#
+	#{
+		build_int_cst (integer_type_node, (int)melt_get_int ($INT_VALUE))
+	}#)
+
 
 
 
@@ -3409,6 +3454,9 @@ and discriminant $DIS, usually $DISCR_MIXED_LOCATION.}#
  basicblock_nb_succ
  basicblock_phinodes
  basicblock_single_succ 
+ build_identifier_tree
+ build_int_tree
+ build_string_tree
  cfun_decl
  cfun_gimple_body
  cfun_has_cfg
@@ -3656,6 +3704,9 @@ and discriminant $DIS, usually $DISCR_MIXED_LOCATION.}#
  tree_array_ref_full
  tree_array_type
  tree_block
+ tree_chain_append
+ tree_chain_join
+ tree_chain_prepend
  tree_component_ref
  tree_component_ref_full
  tree_component_ref_typed
-- 
1.7.6



[Ada] Inline expression functions whenever possible

2011-08-02 Thread Arnaud Charlet
This patch treats expression functions as functions with an implicit pragma
Inline_Always. This ensures that they are chained to the list of inlined
subprograms of the enclosing unit, and made available to the back end for
inlining. The front-end does not examine whether inlining is actually possible
because the back end can do this more accurately.

Tested on x86_64-pc-linux-gnu, committed on trunk

2011-08-02  Ed Schonberg  

* sem_ch6 (Analyze_Expression_Function): treat the function as
Inline_Always, and introduce a subprogram declaration for it when it is
not a completion.
* inline.adb (Add_Inlined_Body): recognize bodies that come from
expression functions, so that the back-end can determine whether they
can in fact be inlined.
* sem_util.adb (Is_Expression_Function): predicate to determine whether
a function body comes from an expression function.

Index: inline.adb
===
--- inline.adb  (revision 177144)
+++ inline.adb  (working copy)
@@ -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- --
@@ -342,7 +342,9 @@
   null;
 
elsif not Is_Inlined (Pack)
- and then not Has_Completion (E)
+ and then
+   (not Has_Completion (E)
+  or else Is_Expression_Function (E))
then
   Set_Is_Inlined (Pack);
   Inlined_Bodies.Increment_Last;
Index: sem_util.adb
===
--- sem_util.adb(revision 177153)
+++ sem_util.adb(working copy)
@@ -6541,6 +6541,26 @@
   end if;
end Is_Descendent_Of;
 
+   
+   -- Is_Expression_Function --
+   
+
+   function Is_Expression_Function (Subp : Entity_Id) return Boolean is
+  Decl : constant Node_Id := Unit_Declaration_Node (Subp);
+
+   begin
+  return Ekind (Subp) = E_Function
+and then Nkind (Decl) = N_Subprogram_Declaration
+and then
+  (Nkind (Original_Node (Decl)) = N_Expression_Function
+or else
+  (Present (Corresponding_Body (Decl))
+and then
+  Nkind (Original_Node
+ (Unit_Declaration_Node (Corresponding_Body (Decl
+ = N_Expression_Function));
+   end Is_Expression_Function;
+
--
-- Is_False --
--
Index: sem_util.ads
===
--- sem_util.ads(revision 177152)
+++ sem_util.ads(working copy)
@@ -6,7 +6,7 @@
 --  --
 -- S p e c  --
 --  --
---  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- --
@@ -741,6 +741,10 @@
--  First determine whether type T is an interface and then check whether
--  it is of protected, synchronized or task kind.
 
+   function Is_Expression_Function (Subp : Entity_Id) return Boolean;
+   --  Predicate to determine whether a function entity comes from a rewritten
+   --  expression function, and should be inlined unconditionally.
+
function Is_False (U : Uint) return Boolean;
pragma Inline (Is_False);
--  The argument is a Uint value which is the Boolean'Pos value of a Boolean
Index: sem_ch6.adb
===
--- sem_ch6.adb (revision 177172)
+++ sem_ch6.adb (working copy)
@@ -271,6 +271,7 @@
   LocX : constant Source_Ptr := Sloc (Expression (N));
   Def_Id   : constant Entity_Id  := Defining_Entity (Specification (N));
   New_Body : Node_Id;
+  New_Decl : Node_Id;
 
   Prev : constant Entity_Id := Current_Entity_In_Scope (Def_Id);
   --  If the expression is a completion, Prev is the 

[Ada] New entity flag defines which entities are in ALFA subset

2011-08-02 Thread Arnaud Charlet
The ALFA subset corresponds to those entities which can be formally analyzed
through the SPARK or Why tool-sets. This is the initial work to identify these
entities, for integer/enumeration types and subtypes, objects of such types
and subprogram specifications.

Tested on x86_64-pc-linux-gnu, committed on trunk

2011-08-02  Yannick Moy  

* cstand.adb (Create_Standard): sets Is_In_ALFA component of standard
types.
* einfo.adb, einfo.ads (Is_In_ALFA): add flag for all entities
(Is_In_ALFA, Set_Is_In_ALFA): new subprograms to access flag Is_In_ALFA
* sem_ch3.adb
(Analyze_Object_Declaration): set Is_In_ALFA flag for objects
(Constrain_Enumeration): set Is_In_ALFA flag for enumeration subtypes
(Constrain_Integer): set Is_In_ALFA flag for integer subtypes
(Enumeration_Type_Declaration): set Is_In_ALFA flag for enumeration
types.
(Set_Scalar_Range_For_Subtype): unset Is_In_ALFA flag for subtypes with
non-static range.
* sem_ch6.adb (Analyze_Return_Type): unset Is_In_ALFA flag for
functions whose return type is not in ALFA.
(Analyze_Subprogram_Specification): set Is_In_ALFA flag for subprogram
specifications.
(Process_Formals): unset Is_In_ALFA flag for subprograms if a
parameter's type is not in ALFA.
* stand.ads (Standard_Type_Is_In_ALFA): array defines which standard
types are in ALFA.

Index: sem_ch3.adb
===
--- sem_ch3.adb (revision 177169)
+++ sem_ch3.adb (working copy)
@@ -3030,6 +3030,12 @@
 
   Act_T := T;
 
+  --  The object is in ALFA if-and-only-if its type is in ALFA
+
+  if Is_In_ALFA (T) then
+ Set_Is_In_ALFA (Id);
+  end if;
+
   --  These checks should be performed before the initialization expression
   --  is considered, so that the Object_Definition node is still the same
   --  as in source code.
@@ -3987,9 +3993,9 @@
 
   if Skip
 or else (Present (Etype (Id))
-   and then (Is_Private_Type (Etype (Id))
-   or else Is_Task_Type (Etype (Id))
-   or else Is_Rewrite_Substitution (N)))
+  and then (Is_Private_Type (Etype (Id))
+ or else Is_Task_Type (Etype (Id))
+ or else Is_Rewrite_Substitution (N)))
   then
  null;
 
@@ -4017,7 +4023,7 @@
 
   if Has_Predicates (T)
 or else (Present (Ancestor_Subtype (T))
-   and then Has_Predicates (Ancestor_Subtype (T)))
+  and then Has_Predicates (Ancestor_Subtype (T)))
   then
  Set_Has_Predicates (Id);
  Set_Has_Delayed_Freeze (Id);
@@ -7914,11 +7920,11 @@
begin
   --  Set common attributes
 
-  Set_Scope (Derived_Type, Current_Scope);
+  Set_Scope  (Derived_Type, Current_Scope);
 
-  Set_Ekind (Derived_Type, Ekind(Parent_Base));
-  Set_Etype (Derived_Type,   Parent_Base);
-  Set_Has_Task  (Derived_Type, Has_Task (Parent_Base));
+  Set_Ekind  (Derived_Type, Ekind(Parent_Base));
+  Set_Etype  (Derived_Type,   Parent_Base);
+  Set_Has_Task   (Derived_Type, Has_Task (Parent_Base));
 
   Set_Size_Info  (Derived_Type, Parent_Type);
   Set_RM_Size(Derived_Type, RM_Size(Parent_Type));
@@ -11496,6 +11502,16 @@
   C : constant Node_Id   := Constraint (S);
 
begin
+  --  By default, consider that the enumeration subtype is in ALFA if the
+  --  entity of its subtype mark is in ALFA. This is reversed later if the
+  --  range of the subtype is not static.
+
+  if Nkind (Original_Node (Parent (Def_Id))) = N_Subtype_Declaration
+and then Is_In_ALFA (T)
+  then
+ Set_Is_In_ALFA (Def_Id);
+  end if;
+
   Set_Ekind (Def_Id, E_Enumeration_Subtype);
 
   Set_First_Literal (Def_Id, First_Literal (Base_Type (T)));
@@ -11718,6 +11734,16 @@
   C : constant Node_Id   := Constraint (S);
 
begin
+  --  By default, consider that the integer subtype is in ALFA if the
+  --  entity of its subtype mark is in ALFA. This is reversed later if the
+  --  range of the subtype is not static.
+
+  if Nkind (Original_Node (Parent (Def_Id))) = N_Subtype_Declaration
+and then Is_In_ALFA (T)
+  then
+ Set_Is_In_ALFA (Def_Id);
+  end if;
+
   Set_Scalar_Range_For_Subtype (Def_Id, Range_Expression (C), T);
 
   if Is_Modular_Integer_Type (T) then
@@ -14469,6 +14495,12 @@
   Set_Enum_Esize  (T);
   Set_Enum_Pos_To_Rep (T, Empty);
 
+  --  Enumeration type is in ALFA only if it is not a character type
+
+  if not Is_Character_Type (T) then
+ Set_Is_In_ALFA (T);
+  end if;
+
   --  Set Discard_Names if conf

Re: [PATCH 2/2] Fix PR47594: Build signed niter expressions

2011-08-02 Thread Sebastian Pop
On Tue, Aug 2, 2011 at 04:50, Richard Guenther  wrote:
> On Tue, 2 Aug 2011, Sebastian Pop wrote:
>
>> --- a/gcc/graphite-scop-detection.c
>> +++ b/gcc/graphite-scop-detection.c
>> @@ -196,6 +196,12 @@ graphite_can_represent_scev (tree scev)
>>    if (chrec_contains_undetermined (scev))
>>      return false;
>>
>> +  /* FIXME: As long as Graphite cannot handle wrap around effects of
>> +     induction variables, we discard them.  */
>> +  if (TYPE_UNSIGNED (TREE_TYPE (scev))
>> +      && !POINTER_TYPE_P (TREE_TYPE (scev)))
>> +    return false;
>
> What does it take to fix that?
>

Converting Graphite to ISL.

As I already proposed another solution is to directly insert the loop
exit constraints in the iteration domain polyhedron instead of using
the niter expressions.

Sebastian


[Ada] Add flag Body_Is_In_ALFA on subprogram entities

2011-08-02 Thread Arnaud Charlet
Follow-up of changes to define which entities are in the ALFA subset for formal
verification. Here, we define a flag Body_Is_In_ALFA that applies to entities
for subprograms, which is set to True when the subprogram body can be analyzed
formally. This is the initial definition, to be refined.

Tested on x86_64-pc-linux-gnu, committed on trunk

2011-08-02  Yannick Moy  

* einfo.adb, einfo.ads (Body_Is_In_ALFA, Set_Body_Is_In_ALFA): get/set
for new flag denoting which subprogram bodies are in ALFA
* restrict.adb, sem_ch7.adb: Update comment
* sem_ch11.adb, sem_ch2.adb, sem_ch3.adb, sem_ch4.adb, sem_ch5.adb,
sem_ch9.adb, sem_res.adb: Add calls to
Current_Subprogram_Body_Is_Not_In_ALFA on unsupported constructs.
* sem_ch6.adb (Analyze_Function_Return): add calls to
Current_Subprogram_Body_Is_Not_In_ALFA on return statement in the
middle of the body, and extended return.
(Check_Missing_Return): add calls to Set_Body_Is_In_ALFA with argument
False when missing return.
(Analyze_Subprogram_Body_Helper): initialize the flag Body_Is_In_ALFA
to True for subprograms whose spec is in ALFA. Remove later on the flag
on the entity used for a subprogram body when there exists a separate
declaration.
* sem_util.adb, sem_util.ads (Current_Subprogram_Body_Is_Not_In_ALFA):
if Current_Subprogram is not Empty, set its flag Body_Is_In_ALFA to
False, otherwise do nothing.

Index: sem_ch3.adb
===
--- sem_ch3.adb (revision 177175)
+++ sem_ch3.adb (working copy)
@@ -3030,10 +3030,13 @@
 
   Act_T := T;
 
-  --  The object is in ALFA if-and-only-if its type is in ALFA
+  --  The object is in ALFA if-and-only-if its type is in ALFA and it is
+  --  not aliased.
 
-  if Is_In_ALFA (T) then
+  if Is_In_ALFA (T) and then not Aliased_Present (N) then
  Set_Is_In_ALFA (Id);
+  else
+ Current_Subprogram_Body_Is_Not_In_ALFA;
   end if;
 
   --  These checks should be performed before the initialization expression
Index: sem_ch5.adb
===
--- sem_ch5.adb (revision 177175)
+++ sem_ch5.adb (working copy)
@@ -815,7 +815,7 @@
   HSS   : constant Node_Id := Handled_Statement_Sequence (N);
 
begin
-  --  In formal mode, we reject block statements. Note that the case of
+  --  In SPARK mode, we reject block statements. Note that the case of
   --  block statements generated by the expander is fine.
 
   if Nkind (Original_Node (N)) = N_Block_Statement then
@@ -1113,6 +1113,7 @@
   if Others_Present
 and then List_Length (Alternatives (N)) = 1
   then
+ Current_Subprogram_Body_Is_Not_In_ALFA;
  Check_SPARK_Restriction
("OTHERS as unique case alternative is not allowed", N);
   end if;
@@ -1194,6 +1195,7 @@
 
  else
 if Has_Loop_In_Inner_Open_Scopes (U_Name) then
+   Current_Subprogram_Body_Is_Not_In_ALFA;
Check_SPARK_Restriction
  ("exit label must name the closest enclosing loop", N);
 end if;
@@ -1235,17 +1237,19 @@
  Check_Unset_Reference (Cond);
   end if;
 
-  --  In formal mode, verify that the exit statement respects the SPARK
+  --  In SPARK mode, verify that the exit statement respects the SPARK
   --  restrictions.
 
   if Present (Cond) then
  if Nkind (Parent (N)) /= N_Loop_Statement then
+Current_Subprogram_Body_Is_Not_In_ALFA;
 Check_SPARK_Restriction
   ("exit with when clause must be directly in loop", N);
  end if;
 
   else
  if Nkind (Parent (N)) /= N_If_Statement then
+Current_Subprogram_Body_Is_Not_In_ALFA;
 if Nkind (Parent (N)) = N_Elsif_Part then
Check_SPARK_Restriction
  ("exit must be in IF without ELSIF", N);
@@ -1254,6 +1258,7 @@
 end if;
 
  elsif Nkind (Parent (Parent (N))) /= N_Loop_Statement then
+Current_Subprogram_Body_Is_Not_In_ALFA;
 Check_SPARK_Restriction
   ("exit must be in IF directly in loop", N);
 
@@ -1261,12 +1266,14 @@
 --  leads to an error mentioning the ELSE.
 
  elsif Present (Else_Statements (Parent (N))) then
+Current_Subprogram_Body_Is_Not_In_ALFA;
 Check_SPARK_Restriction ("exit must be in IF without ELSE", N);
 
 --  An exit in an ELSIF does not reach here, as it would have been
 --  detected in the case (Nkind (Parent (N)) /= N_If_Statement).
 
  elsif Present (Elsif_Parts (Parent (N))) then
+Current_Subprogram_Body_Is_Not_In_ALFA;
 Check_SPARK_Restriction ("exit must be in IF without ELSIF", N);
  end if;
   end if;
@@ -129

[Ada] Spurious errors with complex slice expression

2011-08-02 Thread Arnaud Charlet
A tree node must never be analyzed if it is not attached to the tree for the
current compilation, because the parent link is used for numerous semantic
checks and code insertions. This patch fixes a violation of this rule in the
analysis of array aggregates, where expressions in component associations are
copied to be perfom some semantic checks before being fully analyzed.
A common use of the parent field is the determination of the proper point of
insertion for generated code, in Insert_Actions. In this case, Insert_Actions
was being called to create a reference for an itype, for use by the back-end.
Such a reference is not needed if expansion is currently disabled.

The following must compile quietly:

function To_String(Item : in String) return String is
   begin
  if Item'length <= 1 then
 return Item;
  end if;
  if Item(Item'first) = '<' and then Item(Item'last) = '>' then
 if Item'length = 2 then
return "";
 end if;
 return String'
  (1 .. 1 =>
  Character'val
(Integer'value
   (Item(Item'first + 1 .. Item'last - 1;
  end if;
  return String'(1 .. 1 => Character'value(Item));
end To_String;

Tested on x86_64-pc-linux-gnu, committed on trunk

2011-08-02  Ed Schonberg  

* sem_aggr.adb (Resolve_Array_Aggregate): when copying the expression
in an association, set parent field of copy before partial analysis.
* sem_res.adb (Resolve_Slice): create reference to itype only when
expansion is enabled.

Index: sem_aggr.adb
===
--- sem_aggr.adb(revision 177175)
+++ sem_aggr.adb(working copy)
@@ -1974,6 +1974,11 @@
   begin
  Expander_Mode_Save_And_Set (False);
  Full_Analysis := False;
+
+ --  Analyze the expression, making sure it is properly
+ --  attached to the tree before we do the analysis.
+
+ Set_Parent (Expr, Parent (Expression (Assoc)));
  Analyze (Expr);
 
  --  If the expression is a literal, propagate this info
Index: sem_res.adb
===
--- sem_res.adb (revision 177177)
+++ sem_res.adb (working copy)
@@ -9817,9 +9817,10 @@
   --  so that the itype is frozen at the proper place in the tree (i.e. at
   --  the point where actions for the slice are analyzed). Note that this
   --  is different from freezing the itype immediately, which might be
-  --  premature (e.g. if the slice is within a transient scope).
+  --  premature (e.g. if the slice is within a transient scope). This needs
+  --  to be done only if expansion is enabled.
 
-  else
+  elsif Expander_Active then
  Ensure_Defined (Typ => Slice_Subtype, N => N);
   end if;
end Set_Slice_Subtype;


[Ada] Recognize HIDE directive in SPARK as special comment

2011-08-02 Thread Arnaud Charlet
In SPARK, some parts of code that are ignored in the analysis can be "hidden",
through the use of a HIDE directive formatted as a special comment. There is no
benefit in detecting violations of SPARK restriction in such hidden parts, so
we now recognize the HIDE directive from SPARK and do not report SPARK
violations in these hidden parts, using ranges of source-locations to record
hidden parts as is done for pragma Warnings (On|Off).

Tested on x86_64-pc-linux-gnu, committed on trunk

2011-08-02  Yannick Moy  

* par-ch11.adb (P_Handled_Sequence_Of_Statements): mark a sequence of
statements hidden in SPARK if preceded by the HIDE directive
(Parse_Exception_Handlers): mark each exception handler in a sequence of
exception handlers as hidden in SPARK if preceded by the HIDE directive
* par-ch6.adb (P_Subprogram): mark a subprogram body hidden in SPARK
if starting with the HIDE directive
* par-ch7.adb (P_Package): mark a package body hidden in SPARK if
starting with the HIDE directive; mark the declarations in a private
part as hidden in SPARK if the private part starts with the HIDE
directive
* restrict.adb, restrict.ads
(Set_Hidden_Part_In_SPARK): record a range of slocs as hidden in SPARK
(Is_In_Hidden_Part_In_SPARK): new function which returns whether its
argument node belongs to a part which is hidden in SPARK
(Check_SPARK_Restriction): do not issue violations on nodes in hidden
parts in SPARK; protect the possibly costly call to
Is_In_Hidden_Part_In_SPARK by a check that the SPARK restriction is on
* scans.ads (Token_Type): new value Tok_SPARK_Hide in enumeration
* scng.adb (Accumulate_Token_Checksum_GNAT_6_3,
Accumulate_Token_Checksum_GNAT_5_03): add case for new token
Tok_SPARK_Hide.
(Scan): recognize special comment starting with '#' and followed by
SPARK keyword "hide" as a HIDE directive.

Index: par-ch11.adb
===
--- par-ch11.adb(revision 176998)
+++ par-ch11.adb(working copy)
@@ -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- --
@@ -56,11 +56,28 @@
--  Error_Recovery : Cannot raise Error_Resync
 
function P_Handled_Sequence_Of_Statements return Node_Id is
-  Handled_Stmt_Seq_Node : Node_Id;
+  Handled_Stmt_Seq_Node  : Node_Id;
+  Seq_Is_Hidden_In_SPARK : Boolean;
+  Hidden_Region_Start: Source_Ptr;
 
begin
   Handled_Stmt_Seq_Node :=
 New_Node (N_Handled_Sequence_Of_Statements, Token_Ptr);
+
+  --  In SPARK, a HIDE directive can be placed at the beginning of a
+  --  package initialization, thus hiding the sequence of statements (and
+  --  possible exception handlers) from SPARK tool-set. No violation of the
+  --  SPARK restriction should be issued on nodes in a hidden part, which
+  --  is obtained by marking such hidden parts.
+
+  if Token = Tok_SPARK_Hide then
+ Seq_Is_Hidden_In_SPARK := True;
+ Hidden_Region_Start:= Token_Ptr;
+ Scan; -- past HIDE directive
+  else
+ Seq_Is_Hidden_In_SPARK := False;
+  end if;
+
   Set_Statements
 (Handled_Stmt_Seq_Node, P_Sequence_Of_Statements (SS_Extm_Sreq));
 
@@ -70,6 +87,10 @@
(Handled_Stmt_Seq_Node, Parse_Exception_Handlers);
   end if;
 
+  if Seq_Is_Hidden_In_SPARK then
+ Set_Hidden_Part_In_SPARK (Hidden_Region_Start, Token_Ptr);
+  end if;
+
   return Handled_Stmt_Seq_Node;
end P_Handled_Sequence_Of_Statements;
 
@@ -229,10 +250,26 @@
--  Error recovery: cannot raise Error_Resync
 
function Parse_Exception_Handlers return List_Id is
-  Handler   : Node_Id;
-  Handlers_List : List_Id;
+  Handler: Node_Id;
+  Handlers_List  : List_Id;
+  Handler_Is_Hidden_In_SPARK : Boolean;
+  Hidden_Region_Start: Source_Ptr;
 
begin
+  --  In SPARK, a HIDE directive can be placed at the beginning of a
+  --  sequence of exception handlers for a subprogram implementation, thus
+  --  hiding the exception handlers from SPARK tool-set. No violation of
+  --  the SPARK restriction should be issued on nodes in a hidden part,
+  --  which is obtained by marking

[Ada] Locate_Exec_On_Path should only return executable files

2011-08-02 Thread Arnaud Charlet
When searching for an executable to run, Unix shells check every directory
on PATH and stop at the first matching executable found.
GNAT.OS_Lib.Locate_Exec_On_Path, however, returned the first matching
regular file, even if it wasn't executable. As a result, when an executable
tries to find where it is run from, we could end up with a discrepency.

To test the issue: create two directories bin1 and bin2. The first one
should contain a non-executable "exec" file, the second should contain
the result of compiling the following program. Add the directories in
that order on the PATH, and run "exec" from the command line. The Unix
shell will execute the one from bin2/ (since the one in bin1/ is not
executable), and the result of the execution should show that the file
was executed from bin2/

   with GNAT.OS_Lib;  use GNAT.OS_Lib;
   with Ada.Text_IO;  use Ada.Text_IO;
   procedure Exec is
   begin
  Put_Line ("Installed in " & Locate_Exec_On_Path ("exec").all);
   end Exec;

Tested on x86_64-pc-linux-gnu, committed on trunk

2011-08-02  Emmanuel Briot  

* adaint.c (__gnat_locate_exec_on_path): only returns executable
files, not any regular file.
(__gnat_locate_file_with_predicate): new subprogram.

Index: adaint.c
===
--- adaint.c(revision 177121)
+++ adaint.c(working copy)
@@ -2700,10 +2700,11 @@
   exit (status);
 }
 
-/* Locate a regular file, give a Path value.  */
+/* Locate file on path, that matches a predicate */
 
 char *
-__gnat_locate_regular_file (char *file_name, char *path_val)
+__gnat_locate_file_with_predicate
+   (char *file_name, char *path_val, int (*predicate)(char*))
 {
   char *ptr;
   char *file_path = (char *) alloca (strlen (file_name) + 1);
@@ -2733,7 +2734,7 @@
 
   if (absolute)
 {
- if (__gnat_is_regular_file (file_path))
+ if (predicate (file_path))
return xstrdup (file_path);
 
   return 0;
@@ -2746,7 +2747,7 @@
 
   if (*ptr != 0)
 {
-  if (__gnat_is_regular_file (file_name))
+  if (predicate (file_name))
 return xstrdup (file_name);
 }
 
@@ -2787,7 +2788,7 @@
 
   strcpy (++ptr, file_name);
 
-  if (__gnat_is_regular_file (file_path))
+  if (predicate (file_path))
 return xstrdup (file_path);
 
   if (*path_val == 0)
@@ -2802,6 +2803,24 @@
   return 0;
 }
 
+/* Locate an executable file, give a Path value.  */
+
+char *
+__gnat_locate_executable_file (char *file_name, char *path_val)
+{
+   return __gnat_locate_file_with_predicate
+  (file_name, path_val, &__gnat_is_executable_file);
+}
+
+/* Locate a regular file, give a Path value.  */
+
+char *
+__gnat_locate_regular_file (char *file_name, char *path_val)
+{
+   return __gnat_locate_file_with_predicate
+  (file_name, path_val, &__gnat_is_regular_file);
+}
+
 /* Locate an executable given a Path argument. This routine is only used by
gnatbl and should not be used otherwise.  Use locate_exec_on_path
instead.  */
@@ -2818,14 +2837,14 @@
 
   strcpy (full_exec_name, exec_name);
   strcat (full_exec_name, HOST_EXECUTABLE_SUFFIX);
-  ptr = __gnat_locate_regular_file (full_exec_name, path_val);
+  ptr = __gnat_locate_executable_file (full_exec_name, path_val);
 
   if (ptr == 0)
- return __gnat_locate_regular_file (exec_name, path_val);
+ return __gnat_locate_executable_file (exec_name, path_val);
   return ptr;
 }
   else
-return __gnat_locate_regular_file (exec_name, path_val);
+return __gnat_locate_executable_file (exec_name, path_val);
 }
 
 /* Locate an executable using the Systems default PATH.  */


Re: C++ PATCH for c++/49260 (lambda-eh2.C failure on several targets)

2011-08-02 Thread Jason Merrill

On 06/22/2011 11:50 AM, Jason Merrill wrote:

This failure was happening on all targets that don't use either CFI
assembler directives or asynchronous unwind tables: we were mistakenly
deciding that the _FUN thunk for returning from the lambda function
pointer conversion operator couldn't throw because build_call_a wasn't
setting cp_function_chain->can_throw. There seems to be no reason to set
that flag in build_cxx_call rather than build_call_a, so I've moved it.


Looking at this again before applying it to 4.6.2, I'm not sure that 
it's safe to drop the at_function_scope_p() check, so I'm going to put 
it back in to be safe.


Tested x86_64-pc-linux-gnu, applying to trunk and 4.6.2.

commit 631465c6d70a602d274e760af7912ad384f67750
Author: Jason Merrill 
Date:   Tue Aug 2 09:06:05 2011 -0400

	* call.c (build_call_a): Also check at_function_scope_p.

diff --git a/gcc/cp/call.c b/gcc/cp/call.c
index 2eab782..b0133e2 100644
--- a/gcc/cp/call.c
+++ b/gcc/cp/call.c
@@ -352,7 +352,7 @@ build_call_a (tree function, int n, tree *argarray)
   nothrow = ((decl && TREE_NOTHROW (decl))
 	 || TYPE_NOTHROW_P (TREE_TYPE (TREE_TYPE (function;
 
-  if (!nothrow && cfun && cp_function_chain)
+  if (!nothrow && at_function_scope_p () && cfun && cp_function_chain)
 cp_function_chain->can_throw = 1;
 
   if (decl && TREE_THIS_VOLATILE (decl) && cfun && cp_function_chain)


Re: [patch tree-optimization]: Add cleanup code for possible unused statements in binary optimization

2011-08-02 Thread Kai Tietz
2011/8/2 Richard Guenther :
> On Tue, Aug 2, 2011 at 12:39 PM, Kai Tietz  wrote:

Thanks, yes, I noticed that.  Patch adjusted for cfg_tree.

ChangeLog

2011-08-02  Kai Tietz  

        * tree-ssa-forwprop.c (simplify_bitwise_binary):
        Remove possible unused statement after optimization
   and change result to indicate cfg-tree change.
   (ssa_forward_propagate_and_combine): Adjust handling for
   simplify_bitwise_binary call.

2011-08-02  Kai Tietz  

        * gcc.dg/tree-ssa/forwprop-15.c: Add test for no int casts.

Bootstrapped and regression-tested for all languages (including Ada
and Obj-C++) on host x86_64-pc-linux-gnu.
Ok for apply?

Index: gcc/gcc/tree-ssa-forwprop.c
===
--- gcc.orig/gcc/tree-ssa-forwprop.c
+++ gcc/gcc/tree-ssa-forwprop.c
@@ -1703,9 +1703,10 @@ simplify_bitwise_binary_1 (enum tree_cod
 }

 /* Simplify bitwise binary operations.
-   Return true if a transformation applied, otherwise return false.  */
+   Returns 1 if there were any changes made, 2 if cfg-cleanup needs to
+   run.  Else it returns 0.  */

-static bool
+static int
 simplify_bitwise_binary (gimple_stmt_iterator *gsi)
 {
   gimple stmt = gsi_stmt (*gsi);
@@ -1716,6 +1717,7 @@ simplify_bitwise_binary (gimple_stmt_ite
   gimple def1 = NULL, def2 = NULL;
   tree def1_arg1, def2_arg1;
   enum tree_code def1_code, def2_code;
+  bool ischanged = false;

   def1_code = TREE_CODE (arg1);
   def1_arg1 = arg1;
@@ -1761,24 +1763,23 @@ simplify_bitwise_binary (gimple_stmt_ite
   gimple_assign_set_rhs_with_ops_1 (gsi, NOP_EXPR,
tem, NULL_TREE, NULL_TREE);
   update_stmt (gsi_stmt (*gsi));
-  return true;
+  ischanged = true;
 }
-
   /* For bitwise binary operations apply operand conversions to the
  binary operation result instead of to the operands.  This allows
  to combine successive conversions and bitwise binary operations.  */
-  if (CONVERT_EXPR_CODE_P (def1_code)
-  && CONVERT_EXPR_CODE_P (def2_code)
-  && types_compatible_p (TREE_TYPE (def1_arg1), TREE_TYPE (def2_arg1))
-  /* Make sure that the conversion widens the operands, or has same
-precision,  or that it changes the operation to a bitfield
-precision.  */
-  && ((TYPE_PRECISION (TREE_TYPE (def1_arg1))
-  <= TYPE_PRECISION (TREE_TYPE (arg1)))
- || (GET_MODE_CLASS (TYPE_MODE (TREE_TYPE (arg1)))
- != MODE_INT)
- || (TYPE_PRECISION (TREE_TYPE (arg1))
- != GET_MODE_PRECISION (TYPE_MODE (TREE_TYPE (arg1))
+  else if (CONVERT_EXPR_CODE_P (def1_code)
+  && CONVERT_EXPR_CODE_P (def2_code)
+  && types_compatible_p (TREE_TYPE (def1_arg1), TREE_TYPE (def2_arg1))
+  /* Make sure that the conversion widens the operands, or has same
+ precision,  or that it changes the operation to a bitfield
+ precision.  */
+  && ((TYPE_PRECISION (TREE_TYPE (def1_arg1))
+   <= TYPE_PRECISION (TREE_TYPE (arg1)))
+  || (GET_MODE_CLASS (TYPE_MODE (TREE_TYPE (arg1)))
+  != MODE_INT)
+  || (TYPE_PRECISION (TREE_TYPE (arg1))
+  != GET_MODE_PRECISION (TYPE_MODE (TREE_TYPE (arg1))
 {
   gimple newop;
   tree tem = create_tmp_reg (TREE_TYPE (def1_arg1),
@@ -1791,77 +1792,84 @@ simplify_bitwise_binary (gimple_stmt_ite
   gimple_assign_set_rhs_with_ops_1 (gsi, NOP_EXPR,
tem, NULL_TREE, NULL_TREE);
   update_stmt (gsi_stmt (*gsi));
-  return true;
+  ischanged = true;
 }
-
   /* (a | CST1) & CST2  ->  (a & CST2) | (CST1 & CST2).  */
-  if (code == BIT_AND_EXPR
-  && def1_code == BIT_IOR_EXPR
-  && TREE_CODE (arg2) == INTEGER_CST
-  && TREE_CODE (gimple_assign_rhs2 (def1)) == INTEGER_CST)
+  else if (code == BIT_AND_EXPR
+  && def1_code == BIT_IOR_EXPR
+  && TREE_CODE (arg2) == INTEGER_CST
+  && TREE_CODE (gimple_assign_rhs2 (def1)) == INTEGER_CST)
 {
   tree cst = fold_build2 (BIT_AND_EXPR, TREE_TYPE (arg2),
  arg2, gimple_assign_rhs2 (def1));
   tree tem;
   gimple newop;
   if (integer_zerop (cst))
-   {
- gimple_assign_set_rhs1 (stmt, def1_arg1);
- update_stmt (stmt);
- return true;
+   gimple_assign_set_rhs1 (stmt, def1_arg1);
+  else
+{
+ tem = create_tmp_reg (TREE_TYPE (arg2), NULL);
+ newop = gimple_build_assign_with_ops (BIT_AND_EXPR,
+   tem, def1_arg1, arg2);
+ tem = make_ssa_name (tem, newop);
+ gimple_assign_set_lhs (newop, tem);
+ gimple_set_location (newop, gimple_location (stmt));
+ /* Make sure to re-process the new stmt as it's walking upwards.  */
+ gsi_insert_before (gsi, newop, GSI_NEW_STMT);
+ gimple_assign_set_rhs1 (stmt, tem)

Re: [PATCH 1/3] Make CLooG isl the only supported CLooG version.

2011-08-02 Thread Sebastian Pop
Ping.

Could one of the configure maintainers review these changes?

Thanks,
Sebastian

On Thu, Jul 21, 2011 at 18:00, Tobias Grosser  wrote:
> 2011-07-21  Tobias Grosser  
>
>        * configure: Regenerated.
>        * config/cloog.m4: Remove support for CLooG-ppl and CLooG-parma,
>        both cloog.org and legacy versions. The only supported version will
>        be CLooG with the isl backend.
> ---
>  ChangeLog       |    7 ++
>  config/cloog.m4 |  107 +++---
>  configure       |  170 
> +++
>  3 files changed, 26 insertions(+), 258 deletions(-)
>
> diff --git a/ChangeLog b/ChangeLog
> index 6a27fb7..a08a780 100644
> --- a/ChangeLog
> +++ b/ChangeLog
> @@ -1,3 +1,10 @@
> +2011-07-21  Tobias Grosser  
> +
> +       * configure: Regenerated.
> +       * config/cloog.m4: Remove support for CLooG-ppl and CLooG-parma,
> +       both cloog.org and legacy versions. The only supported version will
> +       be CLooG with the isl backend.
> +
>  2011-07-21  Joseph Myers  
>
>        * MAINTAINERS (Global Reviewers): Add self.
> diff --git a/config/cloog.m4 b/config/cloog.m4
> index e95b98d..8662acd 100644
> --- a/config/cloog.m4
> +++ b/config/cloog.m4
> @@ -37,17 +37,6 @@ AC_DEFUN([CLOOG_INIT_FLAGS],
>       [--with-cloog-lib=PATH],
>       [Specify the directory for the installed CLooG library])])
>
> -  AC_ARG_ENABLE(cloog-backend,
> -    [AS_HELP_STRING(
> -      [--enable-cloog-backend[[=BACKEND]]],
> -      [set the CLooG BACKEND used to either isl, ppl or ppl-legacy 
> (default)])],
> -    [ if   test "x${enableval}" = "xisl"; then
> -       cloog_backend=isl
> -      elif test "x${enableval}" = "xppl"; then
> -       cloog_backend=ppl
> -      else
> -       cloog_backend=ppl-legacy
> -      fi], cloog_backend=ppl-legacy)
>   AC_ARG_ENABLE(cloog-version-check,
>     [AS_HELP_STRING(
>       [--disable-cloog-version-check],
> @@ -107,23 +96,6 @@ m4_define([_CLOOG_ORG_PROG_ISL],[AC_LANG_PROGRAM(
>   [#include "cloog/cloog.h" ],
>   [cloog_version ()])])
>
> -# _CLOOG_ORG_PROG_PPL ()
> -# --
> -# Helper for detecting CLooG.org's PPL backend.
> -m4_define([_CLOOG_ORG_PROG_PPL],[AC_LANG_PROGRAM(
> -  [#include "cloog/cloog.h"
> -   #include "cloog/ppl/cloog.h"],
> -  [cloog_version ()])])
> -
> -# _CLOOG_PPL_LEGACY_PROG ()
> -# -
> -# Helper for detecting CLooG-Legacy (CLooG-PPL).
> -m4_define([_CLOOG_PPL_LEGACY_PROG], [AC_LANG_PROGRAM(
> -  [#include "cloog/cloog.h"],
> -  [#ifndef CLOOG_PPL_BACKEND
> -    choke me
> -   #endif ])])
> -
>  # CLOOG_FIND_FLAGS ()
>  # --
>  # Detect the used CLooG-backend and set clooginc/clooglibs/cloog_org.
> @@ -144,49 +116,17 @@ AC_DEFUN([CLOOG_FIND_FLAGS],
>   CPPFLAGS="${CPPFLAGS} ${_cloogorginc}"
>   LDFLAGS="${LDFLAGS} ${clooglibs}"
>
> -  case $cloog_backend in
> -    "ppl-legacy")
> -    CFLAGS="${CFLAGS} ${pplinc}"
> -    LDFLAGS="${LDFLAGS} ${ppllibs}"
> -    AC_CACHE_CHECK([for installed CLooG PPL Legacy], [gcc_cv_cloog_type],
> -      [LIBS="-lcloog ${_cloog_saved_LIBS}"
> -      AC_LINK_IFELSE([_CLOOG_PPL_LEGACY_PROG], [gcc_cv_cloog_type="PPL 
> Legacy"],
> -                    [gcc_cv_cloog_type=no])])
> -    ;;
> -    "isl")
> -    AC_CACHE_CHECK([for installed CLooG ISL], [gcc_cv_cloog_type],
> -      [LIBS="-lcloog-isl ${_cloog_saved_LIBS}"
> -      AC_LINK_IFELSE([_CLOOG_ORG_PROG_ISL], [gcc_cv_cloog_type="ISL"],
> -                    [gcc_cv_cloog_type=no])])
> -    ;;
> -    "ppl")
> -    CFLAGS="${CFLAGS} ${pplinc}"
> -    LDFLAGS="${LDFLAGS} ${ppllibs}"
> -    AC_CACHE_CHECK([for installed CLooG PPL], [gcc_cv_cloog_type],
> -      [LIBS="-lcloog-ppl ${_cloog_saved_LIBS}"
> -      AC_LINK_IFELSE([_CLOOG_ORG_PROG_PPL], [gcc_cv_cloog_type="PPL"],
> -                    [gcc_cv_cloog_type=no])])
> -    ;;
> -    *)
> -      gcc_cv_cloog_type=""
> -  esac
> +  AC_CACHE_CHECK([for installed CLooG ISL], [gcc_cv_cloog_type],
> +    [LIBS="-lcloog-isl ${_cloog_saved_LIBS}"
> +    AC_LINK_IFELSE([_CLOOG_ORG_PROG_ISL], [gcc_cv_cloog_type="ISL"],
> +                  [gcc_cv_cloog_type=no])])
>
>   case $gcc_cv_cloog_type in
> -    "PPL Legacy")
> -      clooginc="${clooginc}"
> -      clooglibs="${clooglibs} -lcloog"
> -      cloog_org=no
> -      ;;
>     "ISL")
>       clooginc="${clooginc} ${_cloogorginc}"
>       clooglibs="${clooglibs} -lcloog-isl -lisl"
>       cloog_org=yes
>       ;;
> -    "PPL")
> -      clooginc="${clooginc} ${_cloogorginc}"
> -      clooglibs="${clooglibs} -lcloog-ppl"
> -      cloog_org=yes
> -      ;;
>     *)
>       clooglibs=
>       clooginc=
> @@ -212,25 +152,10 @@ m4_define([_CLOOG_CHECK_CT_PROG],[AC_LANG_PROGRAM(
>     choke me
>    #endif])])
>
> -# _CLOOG_CHECK_RT_PROG ()
> -# ---
> -# Helper for verifying that CLooG's compile time version
> -# matches the run time version.
> -m4_define([_CLOOG_CHECK_RT_PROG],[AC_LANG_PROGRAM(
> -  [#include "cloog/cloog.h"],
> -  [if (

Re: [PATCH 2/3] Require cloog 0.16.3

2011-08-02 Thread Sebastian Pop
Ping.

Could one of the configure maintainers review these changes?

Thanks,
Sebastian


On Thu, Jul 21, 2011 at 18:00, Tobias Grosser  wrote:
> 2011-07-21  Tobias Grosser  
>
>        * configure: Regenerated.
>        * configure.ac: Require cloog isl 0.16.3
> ---
>  ChangeLog    |    5 +
>  configure    |    6 +++---
>  configure.ac |    2 +-
>  3 files changed, 9 insertions(+), 4 deletions(-)
>
> diff --git a/ChangeLog b/ChangeLog
> index a08a780..3d83bd2 100644
> --- a/ChangeLog
> +++ b/ChangeLog
> @@ -1,6 +1,11 @@
>  2011-07-21  Tobias Grosser  
>
>        * configure: Regenerated.
> +       * configure.ac: Require cloog isl 0.16.3
> +
> +2011-07-21  Tobias Grosser  
> +
> +       * configure: Regenerated.
>        * config/cloog.m4: Remove support for CLooG-ppl and CLooG-parma,
>        both cloog.org and legacy versions. The only supported version will
>        be CLooG with the isl backend.
> diff --git a/configure b/configure
> index 6608b86..57f099b 100755
> --- a/configure
> +++ b/configure
> @@ -5834,8 +5834,8 @@ $as_echo "$gcc_cv_cloog_type" >&6; }
>     CFLAGS="${_cloog_saved_CFLAGS} ${clooginc} ${pplinc} ${gmpinc}"
>     LDFLAGS="${_cloog_saved_LDFLAGS} ${clooglibs} ${ppllibs}"
>
> -    { $as_echo "$as_me:${as_lineno-$LINENO}: checking for version 0.16.1 of 
> CLooG" >&5
> -$as_echo_n "checking for version 0.16.1 of CLooG... " >&6; }
> +    { $as_echo "$as_me:${as_lineno-$LINENO}: checking for version 0.16.3 of 
> CLooG" >&5
> +$as_echo_n "checking for version 0.16.3 of CLooG... " >&6; }
>  if test "${gcc_cv_cloog+set}" = set; then :
>   $as_echo_n "(cached) " >&6
>  else
> @@ -5847,7 +5847,7 @@ main ()
>  {
>  #if CLOOG_VERSION_MAJOR != 0 \
>     || CLOOG_VERSION_MINOR != 16 \
> -    || CLOOG_VERSION_REVISION < 1
> +    || CLOOG_VERSION_REVISION < 3
>     choke me
>    #endif
>   ;
> diff --git a/configure.ac b/configure.ac
> index e64e577..00325a1 100644
> --- a/configure.ac
> +++ b/configure.ac
> @@ -1588,7 +1588,7 @@ if test "x$with_cloog" != "xno"; then
>   dnl
>   dnl If we use CLooG-Legacy, the provided version information is
>   dnl ignored.
> -  CLOOG_CHECK_VERSION(0,16,1)
> +  CLOOG_CHECK_VERSION(0,16,3)
>
>   dnl Only execute fail-action, if CLooG has been requested.
>   CLOOG_IF_FAILED([
> --
> 1.7.4.1
>
>


[Patch, Fortran] Allocatable coarrays: Pass "token" to caf_registering

2011-08-02 Thread Tobias Burnus
Simple patch: Coarrays are identified by a token; this patch passes the 
token (which is stored in the descriptor allocatable coarrays) to 
libcaf's registering function.


In terms of token and allocatable coarrays: The next step is to fix 
passing actual arguments to assumed-shape coarrays dummies. (Explicit 
shape and deferred shape is OK.) And handling the explicit and automatic 
deallocation of allocatable coarrays.


Build and regtested on x86-64-linux.
OK for the trunk?

Tobias
2011-08-02  Tobias Burnus  

	* trans-array.c (gfc_array_allocate): Pass token to
	  gfc_allocate_allocatable for -fcoarray=lib.
	* trans-stmt.c (gfc_trans_allocate): Update
	gfc_allocate_allocatable call.
	* trans.h (gfc_allocate_allocatable): Update prototype.
	(gfc_allocate_using_lib): Remove.
	* trans.c (gfc_allocate_using_lib): Make static, handle
	token.
	(gfc_allocate_allocatable): Ditto.
	
diff --git a/gcc/fortran/trans-array.c b/gcc/fortran/trans-array.c
index dc8fdb8..a151c56 100644
--- a/gcc/fortran/trans-array.c
+++ b/gcc/fortran/trans-array.c
@@ -4409,6 +4409,7 @@ gfc_array_allocate (gfc_se * se, gfc_expr * expr, tree status, tree errmsg,
   tree tmp;
   tree pointer;
   tree offset = NULL_TREE;
+  tree token = NULL_TREE;
   tree size;
   tree msg;
   tree error = NULL_TREE;
@@ -4521,9 +4522,13 @@ gfc_array_allocate (gfc_se * se, gfc_expr * expr, tree status, tree errmsg,
   pointer = gfc_conv_descriptor_data_get (se->expr);
   STRIP_NOPS (pointer);
 
+  if (coarray && gfc_option.coarray == GFC_FCOARRAY_LIB)
+token = gfc_build_addr_expr (NULL_TREE,
+ gfc_conv_descriptor_token (se->expr));
+
   /* The allocatable variant takes the old pointer as first argument.  */
   if (allocatable)
-gfc_allocate_allocatable (&elseblock, pointer, size,
+gfc_allocate_allocatable (&elseblock, pointer, size, token,
 			  status, errmsg, errlen, expr);
   else
 gfc_allocate_using_malloc (&elseblock, pointer, size, status);
diff --git a/gcc/fortran/trans-stmt.c b/gcc/fortran/trans-stmt.c
index defa445..a911a5b 100644
--- a/gcc/fortran/trans-stmt.c
+++ b/gcc/fortran/trans-stmt.c
@@ -4867,7 +4867,7 @@ gfc_trans_allocate (gfc_code * code)
 
 	  /* Allocate - for non-pointers with re-alloc checking.  */
 	  if (gfc_expr_attr (expr).allocatable)
-	gfc_allocate_allocatable (&se.pre, se.expr, memsz,
+	gfc_allocate_allocatable (&se.pre, se.expr, memsz, NULL_TREE,
   stat, errmsg, errlen, expr);
 	  else
 	gfc_allocate_using_malloc (&se.pre, se.expr, memsz, stat);
diff --git a/gcc/fortran/trans.c b/gcc/fortran/trans.c
index 2f8c7fd..e313803 100644
--- a/gcc/fortran/trans.c
+++ b/gcc/fortran/trans.c
@@ -635,19 +635,21 @@ gfc_allocate_using_malloc (stmtblock_t * block, tree pointer,
This function follows the following pseudo-code:
 
 void *
-allocate (size_t size, integer_type stat)
+allocate (size_t size, void** token, int *stat, char* errmsg, int errlen)
 {
   void *newmem;
-
-  newmem = _caf_register ( size, regtype, NULL, &stat, NULL, NULL);
+
+  newmem = _caf_register (size, regtype, token, &stat, errmsg, errlen);
   return newmem;
 }  */
 void
 gfc_allocate_using_lib (stmtblock_t * block, tree pointer, tree size,
-			tree status, tree errmsg, tree errlen)
+			tree token, tree status, tree errmsg, tree errlen)
 {
   tree tmp, pstat;
 
+  gcc_assert (token != NULL_TREE);
+
   /* Evaluate size only once, and make sure it has the right type.  */
   size = gfc_evaluate_now (size, block);
   if (TREE_TYPE (size) != TREE_TYPE (size_type_node))
@@ -673,8 +675,7 @@ gfc_allocate_using_lib (stmtblock_t * block, tree pointer, tree size,
 			  build_int_cst (size_type_node, 1)),
 	 build_int_cst (integer_type_node,
 			GFC_CAF_COARRAY_ALLOC),
-	 null_pointer_node,  /* token  */
-	 pstat, errmsg, errlen);
+	 token, pstat, errmsg, errlen);
 
   tmp = fold_build2_loc (input_location, MODIFY_EXPR,
 			 TREE_TYPE (pointer), pointer,
@@ -706,8 +707,8 @@ gfc_allocate_using_lib (stmtblock_t * block, tree pointer, tree size,
 expr must be set to the original expression being allocated for its locus
 and variable name in case a runtime error has to be printed.  */
 void
-gfc_allocate_allocatable (stmtblock_t * block, tree mem, tree size, tree status,
-			  tree errmsg, tree errlen, gfc_expr* expr)
+gfc_allocate_allocatable (stmtblock_t * block, tree mem, tree size, tree token,
+			  tree status, tree errmsg, tree errlen, gfc_expr* expr)
 {
   stmtblock_t alloc_block;
   tree tmp, null_mem, alloc, error;
@@ -726,7 +727,7 @@ gfc_allocate_allocatable (stmtblock_t * block, tree mem, tree size, tree status,
 
   if (gfc_option.coarray == GFC_FCOARRAY_LIB
   && gfc_expr_attr (expr).codimension)
-gfc_allocate_using_lib (&alloc_block, mem, size, status,
+gfc_allocate_using_lib (&alloc_block, mem, size, token, status,
 			errmsg, errlen);
   else
 gfc_allocate_using_malloc (&alloc_block, mem, size, status);
diff --git a/gcc/fortran/

Re: [PATCH 3/3] Remove code that supported legacy CLooG.

2011-08-02 Thread Sebastian Pop
Ping.

Could one of the configure maintainers review these changes?

Thanks,
Sebastian

On Thu, Jul 21, 2011 at 18:00, Tobias Grosser  wrote:
> 2011-07-21  Tobias Grosser  
>
>        * configure: Regenerated.
>        * config/cloog.m4: Do not define CLOOG_ORG
>
> and in gcc/
>
> 2011-07-21  Tobias Grosser  
>
>        * Makefile.in (graphite-clast-to-gimple.o, graphite-cloog-util.o):
>        Remove graphite-cloog-util.h.
>        * graphite-clast-to-gimple.c (gcc_type_for_iv_of_clast_loop,
>        build_iv_mapping, translate_clast_user, translate_clast,
>        free_scattering, initialize_cloog_names, build_cloog_prog,
>        create_params_index): Do not use old compatibility functions.
>        (clast_name_to_index, set_cloog_options): Remove code for legacy cloog.
>        * graphite-cloog-util.c (openscop_print_cloog_matrix): Do not use old
>        compatibility functions.
>        (new_Cloog_Scattering_from_ppl_Polyhedron): Remove code for legacy
>        cloog.
>        * graphite-cloog-util.h: Remove include of graphite-cloog-util.h.
>        * graphite.c (graphite.c): Do not call outdated cloog_initialize() and
>        cloog_finalize().
>        * graphite-cloog-compat.h: Remove.
> ---
>  ChangeLog                      |    5 +
>  config/cloog.m4                |    2 +-
>  configure                      |    2 +-
>  gcc/ChangeLog                  |   18 +++
>  gcc/Makefile.in                |    4 +-
>  gcc/graphite-clast-to-gimple.c |   93 ++
>  gcc/graphite-cloog-compat.h    |  275 
> 
>  gcc/graphite-cloog-util.c      |   15 +--
>  gcc/graphite-cloog-util.h      |    1 -
>  gcc/graphite.c                 |    2 -
>  10 files changed, 72 insertions(+), 345 deletions(-)
>  delete mode 100644 gcc/graphite-cloog-compat.h
>
> diff --git a/ChangeLog b/ChangeLog
> index 3d83bd2..9499da4 100644
> --- a/ChangeLog
> +++ b/ChangeLog
> @@ -1,6 +1,11 @@
>  2011-07-21  Tobias Grosser  
>
>        * configure: Regenerated.
> +       * config/cloog.m4: Do not define CLOOG_ORGt
> +
> +2011-07-21  Tobias Grosser  
> +
> +       * configure: Regenerated.
>        * configure.ac: Require cloog isl 0.16.3
>
>  2011-07-21  Tobias Grosser  
> diff --git a/config/cloog.m4 b/config/cloog.m4
> index 8662acd..9c42445 100644
> --- a/config/cloog.m4
> +++ b/config/cloog.m4
> @@ -109,7 +109,7 @@ AC_DEFUN([CLOOG_FIND_FLAGS],
>   _cloog_saved_LDFLAGS=$LDFLAGS
>   _cloog_saved_LIBS=$LIBS
>
> -  _cloogorginc="-DCLOOG_INT_GMP -DCLOOG_ORG"
> +  _cloogorginc="-DCLOOG_INT_GMP"
>
>   dnl clooglibs & clooginc may have been initialized by CLOOG_INIT_FLAGS.
>   CFLAGS="${CFLAGS} ${clooginc} ${gmpinc}"
> diff --git a/configure b/configure
> index 57f099b..8de7bc69 100755
> --- a/configure
> +++ b/configure
> @@ -5771,7 +5771,7 @@ if test "x$with_cloog" != "xno"; then
>   _cloog_saved_LDFLAGS=$LDFLAGS
>   _cloog_saved_LIBS=$LIBS
>
> -  _cloogorginc="-DCLOOG_INT_GMP -DCLOOG_ORG"
> +  _cloogorginc="-DCLOOG_INT_GMP"
>
>     CFLAGS="${CFLAGS} ${clooginc} ${gmpinc}"
>   CPPFLAGS="${CPPFLAGS} ${_cloogorginc}"
> diff --git a/gcc/ChangeLog b/gcc/ChangeLog
> index b9d95fa..b6009b7 100644
> --- a/gcc/ChangeLog
> +++ b/gcc/ChangeLog
> @@ -1,3 +1,21 @@
> +2011-07-21  Tobias Grosser  
> +
> +       * Makefile.in (graphite-clast-to-gimple.o, graphite-cloog-util.o):
> +       Remove graphite-cloog-util.h.
> +       * graphite-clast-to-gimple.c (gcc_type_for_iv_of_clast_loop,
> +       build_iv_mapping, translate_clast_user, translate_clast,
> +       free_scattering, initialize_cloog_names, build_cloog_prog,
> +       create_params_index): Do not use old compatibility functions.
> +       (clast_name_to_index, set_cloog_options): Remove code for legacy 
> cloog.
> +       * graphite-cloog-util.c (openscop_print_cloog_matrix): Do not use old
> +       compatibility functions.
> +       (new_Cloog_Scattering_from_ppl_Polyhedron): Remove code for legacy
> +       cloog.
> +       * graphite-cloog-util.h: Remove include of graphite-cloog-util.h.
> +       * graphite.c (graphite.c): Do not call outdated cloog_initialize() and
> +       cloog_finalize().
> +       * graphite-cloog-compat.h: Remove.
> +
>  2011-07-21  Georg-Johann Lay  
>
>        * config/avr/avr.c (final_prescan_insn): Fix printing of rtx_costs.
> diff --git a/gcc/Makefile.in b/gcc/Makefile.in
> index d924fb6..c5a2f7f 100644
> --- a/gcc/Makefile.in
> +++ b/gcc/Makefile.in
> @@ -2690,9 +2690,9 @@ graphite-clast-to-gimple.o : graphite-clast-to-gimple.c 
> $(CONFIG_H) \
>    $(SYSTEM_H) coretypes.h $(DIAGNOSTIC_CORE_H) $(TREE_FLOW_H) $(TREE_DUMP_H) 
> \
>    $(CFGLOOP_H) $(TREE_DATA_REF_H) sese.h graphite-cloog-util.h \
>    graphite-ppl.h graphite-poly.h graphite-clast-to-gimple.h \
> -   graphite-dependences.h graphite-cloog-compat.h
> +   graphite-dependences.h
>  graphite-cloog-util.o : graphite-cloog-util.c $(CONFIG_H) $(SYSTEM_H) \
> -   coretypes.h graphite-cloog-util.h graphite-cloog-compat.h
> +   coretypes.h graphite-cloog-u

Re: PING: PATCH [8/n]: Prepare x32: PR other/48007: Unwind library doesn't work with UNITS_PER_WORD > sizeof (void *)

2011-08-02 Thread H.J. Lu
PING.

On Thu, Jul 28, 2011 at 3:01 PM, H.J. Lu  wrote:
> Hi Richard, Jason,
>
> Is this patch
>
> http://gcc.gnu.org/ml/gcc-patches/2011-06/msg02401.html
>
> OK for trunk?
>
> Thanks.
>
>
> H.J.
> On Mon, Jul 11, 2011 at 3:21 PM, H.J. Lu  wrote:
>> Ping.
>>
>> On Wed, Jul 6, 2011 at 2:20 PM, H.J. Lu  wrote:
>>> PING.
>>>
>>> On Thu, Jun 30, 2011 at 1:47 PM, H.J. Lu  wrote:
 On Thu, Jun 30, 2011 at 12:02 PM, Richard Henderson  
 wrote:
> On 06/30/2011 11:23 AM, H.J. Lu wrote:
>> +#ifdef REG_VALUE_IN_UNWIND_CONTEXT
>> +typedef _Unwind_Word _Unwind_Context_Reg_Val;
>> +/* Signal frame context.  */
>> +#define SIGNAL_FRAME_BIT ((_Unwind_Word) 1 >> 0)
>
> There's absolutely no reason to re-define this.
> So what if the value is most-significant-bit set?
>
> Nor do I see any reason not to continue setting E_C_B.

 Done.

>> +#define _Unwind_IsExtendedContext(c) 1
>
> Why is this not still an inline function?

 It is defined before _Unwind_Context is declared.  I used
 macros so that there can be one less "#ifdef".

>> +
>> +static inline _Unwind_Word
>> +_Unwind_Get_Unwind_Word (_Unwind_Context_Reg_Val val)
>> +{
>> +  return val;
>> +}
>> +
>> +static inline _Unwind_Context_Reg_Val
>> +_Unwind_Get_Unwind_Context_Reg_Val (_Unwind_Word val)
>> +{
>> +  return val;
>> +}
>
> I cannot believe this actually works.  I see nowhere that
> you copy the by-address slot out of the stack frame and
> place it into the by-value slot in the unwind context.

 I changed the implantation based on the feedback from
 Jason.  Now I use the same reg field for both value and
 address.

>>    /* This will segfault if the register hasn't been saved.  */
>>    if (size == sizeof(_Unwind_Ptr))
>> -    return * (_Unwind_Ptr *) ptr;
>> +    return * (_Unwind_Ptr *) (_Unwind_Internal_Ptr) val;
>>    else
>>      {
>>        gcc_assert (size == sizeof(_Unwind_Word));
>> -      return * (_Unwind_Word *) ptr;
>> +      return * (_Unwind_Word *) (_Unwind_Internal_Ptr) val;
>>      }
>
> Indeed, this section is both wrong and belies the change
> you purport to make.
>
> You didn't even test this, did you?
>

 Here is the updated patch.  It works on simple tests.
 I am running full tests.  I kept config/i386/value-unwind.h
 since libgcc/md-unwind-support.h is included too late
 in unwind-dw2.c and I don't want to move it to be on
 the safe side.

 OK for trunk?

 Thanks.

 --
 H.J.
 ---
 gcc/

 2011-06-30  H.J. Lu  

        * config.gcc (libgcc_tm_file): Add i386/value-unwind.h for
        Linux/x86.

        * system.h (REG_VALUE_IN_UNWIND_CONTEXT): Poisoned.

        * unwind-dw2.c (_Unwind_Context_Reg_Val): New.
        (_Unwind_Get_Unwind_Word): Likewise.
        (_Unwind_Get_Unwind_Context_Reg_Val): Likewise.
        (_Unwind_Context): Use _Unwind_Context_Reg_Val on the reg field.
        (_Unwind_IsExtendedContext): Defined as macro.
        (_Unwind_GetGR): Updated.
        (_Unwind_SetGR): Likewise.
        (_Unwind_GetGRPtr): Likewise.
        (_Unwind_SetGRPtr): Likewise.
        (_Unwind_SetGRValue): Likewise.
        (_Unwind_GRByValue): Likewise.
        (__frame_state_for): Likewise.
        (uw_install_context_1): Likewise.

        * doc/tm.texi.in: Document REG_VALUE_IN_UNWIND_CONTEXT.
        * doc/tm.texi: Regenerated.

 libgcc/

 2011-06-30  H.J. Lu  

        * config/i386/value-unwind.h: New.

>>>
>>>
>



-- 
H.J.


Re: [Patch, Fortran testsuite, committed] Add/fix dg-final cleanup-module

2011-08-02 Thread Mikael Morin
It's a pity that I've made the same fixes myself. I was planing to commit 
soon. :-(

On Tuesday 02 August 2011 17:34:46 Tobias Burnus wrote:
> This patch fixes dg-final cleanup-modules issues:
> * Missing cleanups
> * Wrong case: All module files are lower case
This is not actually a problem as cleanup-module is:

# Remove files for specified Fortran modules.
proc cleanup-modules { modlist } {
foreach modname $modlist {
remove-build-file [string tolower $modname].mod
}
}

(note the "string tolower")


> * Wrong cleanup (clean up .mod which don't exist instead of the one
> which exists)
> 
> One test case actually failed because it had a spurious "use foo" in it
> - I have now deleted that line instead of creating a dummy module ...
> 
> There might be still some missing or wrong cleanups, but most remaining
> .mod files are from gfortran.fortran-torture.
> 
> Regtested on x86-64-linux and committed as Rev. 177184.

Thanks. I'll see if I have additional fixes after updating.

Mikael



[Patch, Fortran] (Coarray) Fix constraint checks for LOCK_TYPE

2011-08-02 Thread Tobias Burnus

This patch fixes two issues:

a) LOCK(coarray%lock_type_comp) is also a coarray.

b) The following constraint was incompletely checked for: C1302. For 
reference, I also list C1303/C1304.


C1302 A named variable of type LOCK TYPE shall be a coarray. A named 
variable with a noncoarray subcomponent of type LOCK TYPE shall be a 
coarray.


C1303 A lock variable shall not appear in a variable definition context 
except as the lock-variable in a LOCK or UNLOCK statement, as an 
allocate-object, or as an actual argument in a reference to a procedure 
with an explicit interface where the corresponding dummy argument has 
INTENT (INOUT).


C1304 A variable with a subobject of type LOCK TYPE shall not appear in 
a variable definition context except as an allocate-object or as an 
actual argument in a reference to a procedure with an explicit interface 
where the corresponding dummy argument has INTENT (INOUT).


Build and regtested on x86-64-linux.
OK for the trunk.

Tobias

PS: It somehow took me quite some time to understand "subcomponent" even 
though the standard is rather clear about it. For reference:


"1.3.33.3 subcomponent --  direct component that is a 
subobject of the structure (6.4.2)


"1.3.33.1 direct component -- one of the components, or one of the 
direct components of a nonpointer nonallocatable component (4.5.1)"
2011-08-02  Tobias Burnus  

	PR fortran/18918
	* parse.c (parse_derived): Add lock_type
	checks, improve coarray_comp handling.
	* resolve.c (resolve_allocate_expr,
	resolve_lock_unlock, resolve_symbol): Fix lock_type
	constraint checks.

2011-08-02  Tobias Burnus  

	PR fortran/18918
	* gfortran.dg/coarray_lock_1.f90: Update dg-error.
	* gfortran.dg/coarray_lock_3.f90: Fix test.
	* gfortran.dg/coarray_lock_4.f90: New.
	* gfortran.dg/coarray_lock_5.f90: New.
	* gfortran.dg/coarray_lock_6.f90: New.

diff --git a/gcc/fortran/parse.c b/gcc/fortran/parse.c
index ba28648..6fca032 100644
--- a/gcc/fortran/parse.c
+++ b/gcc/fortran/parse.c
@@ -2010,7 +2010,7 @@ parse_derived (void)
   gfc_statement st;
   gfc_state_data s;
   gfc_symbol *sym;
-  gfc_component *c;
+  gfc_component *c, *lock_comp = NULL;
 
   accept_statement (ST_DERIVED_DECL);
   push_state (&s, COMP_DERIVED, gfc_new_block);
@@ -2118,19 +2118,28 @@ endType:
   sym = gfc_current_block ();
   for (c = sym->components; c; c = c->next)
 {
+  bool coarray, lock_type, allocatable, pointer;
+  coarray = lock_type = allocatable = pointer = false;
+
   /* Look for allocatable components.  */
   if (c->attr.allocatable
 	  || (c->ts.type == BT_CLASS && c->attr.class_ok
 	  && CLASS_DATA (c)->attr.allocatable)
 	  || (c->ts.type == BT_DERIVED && c->ts.u.derived->attr.alloc_comp))
-	sym->attr.alloc_comp = 1;
+	{
+	  allocatable = true;
+	  sym->attr.alloc_comp = 1;
+	}
 
   /* Look for pointer components.  */
   if (c->attr.pointer
 	  || (c->ts.type == BT_CLASS && c->attr.class_ok
 	  && CLASS_DATA (c)->attr.class_pointer)
 	  || (c->ts.type == BT_DERIVED && c->ts.u.derived->attr.pointer_comp))
-	sym->attr.pointer_comp = 1;
+	{
+	  pointer = true;
+	  sym->attr.pointer_comp = 1;
+	}
 
   /* Look for procedure pointer components.  */
   if (c->attr.proc_pointer
@@ -2140,15 +2149,62 @@ endType:
 
   /* Looking for coarray components.  */
   if (c->attr.codimension
-	  || (c->attr.coarray_comp && !c->attr.pointer && !c->attr.allocatable))
-	sym->attr.coarray_comp = 1;
+	  || (c->ts.type == BT_CLASS && c->attr.class_ok
+	  && CLASS_DATA (c)->attr.codimension))
+	{
+	  coarray = true;
+	  sym->attr.coarray_comp = 1;
+	}
+ 
+  if (c->ts.type == BT_DERIVED && c->ts.u.derived->attr.codimension)
+	{
+	  coarray = true;
+	  if (!pointer && !allocatable)
+	sym->attr.coarray_comp = 1;
+	}
 
   /* Looking for lock_type components.  */
-  if (c->attr.lock_comp
-	  || (sym->ts.type == BT_DERIVED
+  if ((c->ts.type == BT_DERIVED
 	  && c->ts.u.derived->from_intmod == INTMOD_ISO_FORTRAN_ENV
-	  && c->ts.u.derived->intmod_sym_id == ISOFORTRAN_LOCK_TYPE))
-	sym->attr.lock_comp = 1;
+	  && c->ts.u.derived->intmod_sym_id == ISOFORTRAN_LOCK_TYPE)
+	  || (c->ts.type == BT_CLASS && c->attr.class_ok
+	  && CLASS_DATA (c)->ts.u.derived->from_intmod
+		 == INTMOD_ISO_FORTRAN_ENV
+	  && CLASS_DATA (c)->ts.u.derived->intmod_sym_id
+		 == ISOFORTRAN_LOCK_TYPE))
+	{
+	  if (pointer)
+	gfc_error ("Pointer component %s at %L of LOCK_TYPE must be a "
+		   "coarray", c->name, &c->loc);
+	  lock_type = 1;
+	  lock_comp = c;
+	  sym->attr.lock_comp = 1;
+	}
+
+  if (c->ts.type == BT_DERIVED && c->ts.u.derived->attr.lock_comp
+	  && !allocatable && !pointer)
+	{
+	  lock_type = 1;
+	  lock_comp = c;
+	  sym->attr.lock_comp = 1;
+	}
+
+  /* F2008, C1302.  */
+
+  if (lock_type && allocatable && !coarray)
+	gfc_error ("Component %s at %L of LOCK_TYPE or with LOCK_TYPE "
+		   "component is allocatable but not a coarray",
+		   c->name, &c->loc);
+
+  

Re: [Patch, Fortran testsuite, committed] Add/fix dg-final cleanup-module

2011-08-02 Thread Tobias Burnus

On 08/02/2011 06:01 PM, Mikael Morin wrote:

It's a pity that I've made the same fixes myself. I was planing to commit
soon. :-(


Indeed it would have been more useful to avoid replicating the work. :-(


On Tuesday 02 August 2011 17:34:46 Tobias Burnus wrote:

* Wrong case: All module files are lower case

This is not actually a problem as cleanup-module is:
remove-build-file [string tolower $modname].mod
(note the "string tolower")


Missed that. There were by chance that many .mod files where the case 
didn't fit that I thought that the case had to be the lower case.



Thanks. I'll see if I have additional fixes after updating.


OK. It also helps to check for '{ dg-do "run" }' (spurious quotation) or 
for "{dg-do run }" (missing space after "{"). I grepped a bit but I 
might have missed also some of those.


Tobias


Re: [Patch, Fortran] Allocatable coarrays: Pass "token" to caf_registering

2011-08-02 Thread Mikael Morin
On Tuesday 02 August 2011 17:47:37 Tobias Burnus wrote:
> Simple patch: Coarrays are identified by a token; this patch passes the
> token (which is stored in the descriptor allocatable coarrays) to
> libcaf's registering function.
> 
> In terms of token and allocatable coarrays: The next step is to fix
> passing actual arguments to assumed-shape coarrays dummies. (Explicit
> shape and deferred shape is OK.) And handling the explicit and automatic
> deallocation of allocatable coarrays.
> 
> Build and regtested on x86-64-linux.
> OK for the trunk?
> 
> Tobias
> 
>   2011-08-02  Tobias Burnus  
> 
[...]
> * trans.c (gfc_allocate_using_lib): Make static, 

This is missing in the patch; OK once it is fixed. 
Thanks

Mikael



Re: [MELT] Add a few tree primitives

2011-08-02 Thread Basile Starynkevitch
On Tue, 2 Aug 2011 17:02:05 +0200
Romain Geissler  wrote:

> Hi,
> 
> I added a few primitives about trees, plus a string_to_long
> conversion primitive and a foreach_pair_between iterator
> that allows to iterate between two pairs of the same list (and
> thus iterate on sublist).
> 
> Note: again, it's a git patch for Pierre until Basil returns.

I'm still near Paris for a few days.

I applied it to the MELT branch.
Transmitting file data ...
Committed revision 177195.

Romain, could you try to compile the latest MELT branch, please. I'm able to 
build it till
MELT stage3, but Pierre is not able to do that (& we spent several hours 
understanding
why without success). It does not build yet past xtramelt*.melt files (and it 
cannot be
installed). 

You should build MELT in an empty build tree. Please give us the log file of 
your make
(don't use make -j, only a sequential make).

Cheers.


-- 
Basile STARYNKEVITCH http://starynkevitch.net/Basile/
email: basilestarynkevitchnet mobile: +33 6 8501 2359
8, rue de la Faiencerie, 92340 Bourg La Reine, France
*** opinions {are only mine, sont seulement les miennes} ***


Re: [PATCH][2/2][RFC] Fix PR49806, promote/demote binary operations in VRP

2011-08-02 Thread Ira Rosen


Richard Guenther  wrote on 02/08/2011 04:25:58 PM:


>
> Thinking about it it probably makes sense to keep a variant of this
> in the vectorizer - after all it has quite specific requirements on
> operand sizes while VRP would probably demote as far as possible
> (maybe taking PROMOTE_MODE into account).
>
> A quick look at your patch reveals
>
> +  if (gimple_assign_rhs_code (use_stmt) == CONVERT_EXPR)
>
> CONVERT_EXPR_CODE_P (gimple_assign_rhs_code (use_stmt))
>
> +  tmp = create_tmp_var (use_type, NULL);
>
> create_tmp_reg

Why? USE_TYPE is neither COMPLEX_TYPE nor VECTOR_TYPE.

Thanks,
Ira


>
> +  if (!types_compatible_p (TREE_TYPE (oprnd0), type)
> +  || !types_compatible_p (TREE_TYPE (oprnd1), type)
> +  || (TREE_CODE (oprnd0) != INTEGER_CST
> +  && TREE_CODE (oprnd1) != INTEGER_CST))
>
> it's always the second operand that is constant, you can simplify
> the code to not handle CST op SSA.
>
> +  code = gimple_assign_rhs_code (stmt);
> +  if (code != LSHIFT_EXPR && code != RSHIFT_EXPR
> +  && code != BIT_IOR_EXPR && code != BIT_XOR_EXPR && code !=
> BIT_AND_EXPR)
> +return false;
> +
> +  oprnd0 = gimple_assign_rhs1 (stmt);
> +  oprnd1 = gimple_assign_rhs2 (stmt);
> +  type = gimple_expr_type (stmt);
> +  if (!types_compatible_p (TREE_TYPE (oprnd0), type)
> +  || !types_compatible_p (TREE_TYPE (oprnd1), type)
>
> for shifts the type compatibility check of oprnd1 isn't guaranteed
> (but do we care?  we only will handle constant shift amounts), for
> the other operands of the codes you handle they always return true.
>
> So I'd simplify the check to
>
>   if (TREE_CODE (oprnd0) != SSA_NAME
>   || TREE_CODE (oprnd1) != INTEGER_CST)
> return false;
>
> Otherwise the patch looks sensible.
>
> Richard.



Re: [patch tree-optimization]: Avoid !=/== 0/1 comparisons for boolean-typed argument

2011-08-02 Thread H.J. Lu
On Tue, Aug 2, 2011 at 6:14 AM, Kai Tietz  wrote:
> 2011/8/2 Richard Guenther :
>> On Tue, Aug 2, 2011 at 12:17 PM, Kai Tietz  wrote:
>>> Hello,
>>>
>>> this patch removes in forward-propagation useless comparisons X != 0
>>> and X != ~0 for boolean-typed X.  For one-bit precision typed X we
>>> simplifiy X == 0 (and X != ~0) to ~X, and for X != 0 (and X == ~0) to
>>> X.
>>> For none one-bit precisione typed X, we simplify here X == 0 -> X ^ 1,
>>> and for X != 0 -> X.  We can do this as even for Ada - which has only
>>> boolean-type with none-one-bit precision - the truth-value is one.
>>
>> This isn't a simplification but a canonicalization and thus should be
>> done by fold_stmt instead (we are not propagating anything after all).
>> In fact, fold_stmt should do parts of this already by means of its
>> canonicalizations via fold.
>
> Well, it simplifies and canonicalizes.  But to put this into
> gimple-fold looks better.
>
>>> Additionally this patch changes for function
>>> forward_propagate_comparison the meaning of true-result.  As this
>>> result wasn't used and it is benefitial to use this propagation also
>>
>> which is a bug - for a true return value we need to set cfg_changed to true.
>
> I addressed this in my updated patch (see below)
>
>>> in second loop in function ssa_forward_propagate_and_combine, it
>>> returns true iff statement was altered.  Additionally this function
>>> handles now the boolean-typed simplifications.
>>
>> why call it twice?  How should that be "beneficial"?  I think that
>> forward_propagate_into_comparison should instead fold the changed
>> statement.
>
> Well, due missing fold_stmt call, there were still none-converted
> comparisons. I've added here the call to fold_stmt_inplace, and it
> solved the issue.
>
>>> For the hunk in gimple.c for function canonicalize_cond_expr_cond:
>>> This change seems to show no real effect, but IMHO it makes sense to
>>> add here the check for cast from boolean-type to be consitant.
>>
>> Probably yes.
>>
>> Thanks,
>> Richard.
>
>
> 2011-08-02  Kai Tietz  
>
>       * gimple.c (canonicalize_cond_expr_cond): Handle cast from boolean-type.
>       (ssa_forward_propagate_and_combine): Interprete result of
>       forward_propagate_comparison.
>       * gcc/gimple-fold.c (fold_gimple_assign): Add canonicalization for
>       boolean-typed operands for comparisons.
>
> 2011-08-02  Kai Tietz  
>
>        * gcc.dg/tree-ssa/forwprop-15.c: New testcase.
>
> Regression tested and bootstrapped for all languages (including Ada
> and Obj-C++).  Ok for apply?
>

It caused:

http://gcc.gnu.org/bugzilla/show_bug.cgi?id=49947


-- 
H.J.


Doc updates for OpenMP 3.1 support, -grecord-gcc-switches, __builtin_assume_aligned and debug info improvements

2011-08-02 Thread Jakub Jelinek
Hi!

--- index.html  15 Jul 2011 09:48:15 -  1.808
+++ index.html  2 Aug 2011 17:01:52 -
@@ -53,6 +53,13 @@ mission statement.
 
 
 
+August 2, 2011
+An implementation of the http://www.openmp.org/mp-documents/OpenMP3.1.pdf";>OpenMP v3.1
+parallel programming interface for C, C++ and Fortran has been added.
+Code was contributed by Jakub Jelinek of Red Hat, Inc. and
+Tobias Burnus.
+
 July 15, 2011
 A port for the TI C6X family of processors has been contributed by
 CodeSourcery.
--- gcc-4.7/changes.html18 Jul 2011 09:23:46 -  1.23
+++ gcc-4.7/changes.html2 Aug 2011 17:01:52 -
@@ -62,6 +62,12 @@
 
 New Languages and Language specific improvements
 
+  
+Version 3.1 of the http://openmp.org/wp/openmp-specifications/";>OpenMP specification
+is now supported for the C, C++, and Fortran compilers.
+  
+
 Ada
 
   
@@ -73,6 +79,13 @@
 
 C family
 
+
+  A new built-in, __builtin_assume_aligned, has been added,
+  through which the compiler can be hinted about pointer alignment
+  and can use it to improve generated code.
+  
+
+
 C++
 
 
@@ -263,5 +276,30 @@ struct F: E { }; // error: deriving from
 
 Other significant improvements
 
+
+  
+A new option (-grecord-gcc-switches) was added to request
+appending of compiler command line options that might affect code
+generation to the DW_AT_producer attribute string in the
+DWARF debugging information.
+  
+
+  
+GCC now supports various new DWARF debugging information format
+GNU extensions, like
+http://www.dwarfstd.org/ShowIssue.php?issue=100909.1&type=open";>entry
+value and http://www.dwarfstd.org/ShowIssue.php?issue=100909.2&type=open";>call
+site information, http://www.dwarfstd.org/doc/040408.1.html";>typed DWARF stack
+or http://www.dwarfstd.org/ShowIssue.php?issue=110722.1&type=open";>a
+more compact macro representation.  Support for these extensions
+will come in GDB 7.4, they can be disabled through
+-gstrict-dwarf command line option.
+  
+
+
 
 
--- projects/gomp/index.html30 Mar 2009 00:07:58 -  1.10
+++ projects/gomp/index.html2 Aug 2011 17:01:52 -
@@ -56,8 +56,27 @@ provide read access to our development s
 http://gcc.gnu.org/bugzilla/";>bugzilla.  In all cases,
 please add "openmp" to the keywords field in the bug report.
 
+Documentation
+libgomp, the GOMP support library, has
+http://gcc.gnu.org/onlinedocs/libgomp/";>online documentation
+available.
+
 Status
 
+Aug 2, 2011
+The gomp-3_1-branch has been merged into SVN
+mainline, so GCC 4.7 and later will feature OpenMP v3.1 support.
+
+July 9, 2011
+The final http://www.openmp.org/mp-documents/OpenMP3.1.pdf";>OpenMP v3.1
+specification has been released.
+
+February 6, 2011
+Draft of the OpenMP v3.1 specification has been released for
+public review, the gomp-3_1-branch branch has been
+created in SVN and work began on implementing v3.1 support.
+
 June 6, 2008
 The gomp-3_0-branch has been merged into SVN
 mainline, so GCC 4.4 and later will feature OpenMP v3.0 support.

Jakub


Re: [GCC-MELT-150] [MELT] Add a few tree primitives

2011-08-02 Thread Romain Geissler

Le 2 août 2011 à 18:38, Basile Starynkevitch a écrit :

> On Tue, 2 Aug 2011 17:02:05 +0200
> Romain Geissler  wrote:
> 
>> Hi,
>> 
>> I added a few primitives about trees, plus a string_to_long
>> conversion primitive and a foreach_pair_between iterator
>> that allows to iterate between two pairs of the same list (and
>> thus iterate on sublist).
>> 
>> Note: again, it's a git patch for Pierre until Basil returns.
> 
> I'm still near Paris for a few days.
> 
> I applied it to the MELT branch.
> Transmitting file data ...
> Committed revision 177195.
> 
> Romain, could you try to compile the latest MELT branch, please. I'm able to 
> build it till
> MELT stage3, but Pierre is not able to do that (& we spent several hours 
> understanding
> why without success). It does not build yet past xtramelt*.melt files (and it 
> cannot be
> installed). 

I tried to built two different revision this afternoon, each time with an empty 
build directory, and none worked (same error as Pierre got, it stops at Melt 
stage 1). IIRC the last one was at revision **162 or something near this one. I 
do fully bootstrap GCC unlike you, but the error occurs at GCC stage 1, so GCC 
bootstrapping might not be the cause.

> 
> You should build MELT in an empty build tree. Please give us the log file of 
> your make
> (don't use make -j, only a sequential make).

Ok, i'll send you that tomorrow. Tell me if you want that i explore this issue 
on my configuration.


> Cheers.
> 
> 
> -- 
> Basile STARYNKEVITCH http://starynkevitch.net/Basile/
> email: basilestarynkevitchnet mobile: +33 6 8501 2359
> 8, rue de la Faiencerie, 92340 Bourg La Reine, France
> *** opinions {are only mine, sont seulement les miennes} ***
> 
> -- 
> Message from the http://groups.google.com/group/gcc-melt group.
> About GCC MELT http://gcc-melt.org/ a high level domain specific language to 
> code extensions to the Gnu Compiler Collection



Re: Ping: C-family stack check for threads

2011-08-02 Thread Thomas Klein

Hello

Here is my next try to put the stack check into rtl at prologue stage.
To me, it was not as easy as I hoped.
I've had little problems to get push/pop and the compare/jump working.
Hoping the way i choose is acceptable.
With rtl no extra pool to hold pointer or size values is required any more.
That's fine.
So this movement to rtl dose make sense.

Regards
  Thomas Klein


Index: gcc/opts.c
===
--- gcc/opts.c(revision 176974)
+++ gcc/opts.c(working copy)
@@ -1644,6 +1644,12 @@ common_handle_option (struct gcc_options *opts,
: STACK_CHECK_STATIC_BUILTIN
  ? STATIC_BUILTIN_STACK_CHECK
  : GENERIC_STACK_CHECK;
+  else if (!strcmp (arg, "indirect"))
+/* This is an other stack checking method.  */
+opts->x_flag_stack_check = INDIRECT_STACK_CHECK;
+  else if (!strcmp (arg, "direct"))
+/* This is an other stack checking method.  */
+opts->x_flag_stack_check = DIRECT_STACK_CHECK;
   else
 warning_at (loc, 0, "unknown stack check parameter \"%s\"", arg);
   break;
Index: gcc/flag-types.h
===
--- gcc/flag-types.h(revision 176974)
+++ gcc/flag-types.h(working copy)
@@ -153,7 +153,15 @@ enum stack_check_type

   /* Check the stack and entirely rely on the target configuration
  files, i.e. do not use the generic mechanism at all.  */
-  FULL_BUILTIN_STACK_CHECK
+  FULL_BUILTIN_STACK_CHECK,
+
+  /* Check the stack (if possible) before allocation of local variables at
+ each function entry. The stack limit is directly given e.g. by address
+ of a symbol */
+  DIRECT_STACK_CHECK,
+  /* Check the stack (if possible) before allocation of local variables at
+ each function entry. The stack limit is given by global variable. */
+  INDIRECT_STACK_CHECK
 };

 /* Names for the different levels of -Wstrict-overflow=N.  The numeric
Index: gcc/explow.c
===
--- gcc/explow.c(revision 176974)
+++ gcc/explow.c(working copy)
@@ -1358,7 +1358,12 @@ allocate_dynamic_stack_space (rtx size, unsigned s

   /* If needed, check that we have the required amount of stack.  Take 
into

  account what has already been checked.  */
-  if (STACK_CHECK_MOVING_SP)
+  if (  STACK_CHECK_MOVING_SP
+#ifdef HAVE_generic_limit_check_stack
+ || crtl->limit_stack
+#endif
+ || flag_stack_check == DIRECT_STACK_CHECK
+ || flag_stack_check == INDIRECT_STACK_CHECK)
 ;
   else if (flag_stack_check == GENERIC_STACK_CHECK)
 probe_stack_range (STACK_OLD_CHECK_PROTECT + 
STACK_CHECK_MAX_FRAME_SIZE,

@@ -1392,19 +1397,32 @@ allocate_dynamic_stack_space (rtx size, unsigned s
   /* Check stack bounds if necessary.  */
   if (crtl->limit_stack)
 {
+  rtx limit_rtx;
   rtx available;
   rtx space_available = gen_label_rtx ();
+  if (  GET_CODE (stack_limit_rtx) == SYMBOL_REF
+ && flag_stack_check == INDIRECT_STACK_CHECK)
+limit_rtx = expand_unop (Pmode, mov_optab,
+gen_rtx_MEM (Pmode, stack_limit_rtx),
+NULL_RTX, 1);
+  else
+limit_rtx = stack_limit_rtx;
 #ifdef STACK_GROWS_DOWNWARD
   available = expand_binop (Pmode, sub_optab,
-stack_pointer_rtx, stack_limit_rtx,
+stack_pointer_rtx, limit_rtx,
 NULL_RTX, 1, OPTAB_WIDEN);
 #else
   available = expand_binop (Pmode, sub_optab,
-stack_limit_rtx, stack_pointer_rtx,
+limit_rtx, stack_pointer_rtx,
 NULL_RTX, 1, OPTAB_WIDEN);
 #endif
   emit_cmp_and_jump_insns (available, size, GEU, NULL_RTX, Pmode, 1,
space_available);
+#ifdef HAVE_stack_failure
+  if (HAVE_stack_failure)
+emit_insn (gen_stack_failure ());
+  else
+#endif
 #ifdef HAVE_trap
   if (HAVE_trap)
 emit_insn (gen_trap ());
@@ -1547,6 +1565,13 @@ probe_stack_range (HOST_WIDE_INT first, rtx size)
 return;
 }
 #endif
+#ifdef HAVE_generic_limit_check_stack
+  else if (HAVE_generic_limit_check_stack)
+{
+  rtx addr = memory_address (Pmode,stack_pointer_rtx);
+  emit_insn (gen_generic_limit_check_stack (addr));
+}
+#endif

   /* Otherwise we have to generate explicit probes.  If we have a constant
  small number of them to generate, that's the easy case.  */
Index: gcc/config/arm/arm.c
===
--- gcc/config/arm/arm.c(revision 176974)
+++ gcc/config/arm/arm.c(working copy)
@@ -15809,6 +15809,299 @@ thumb_set_frame_pointer (arm_stack_offsets *offset
   RTX_FRAME_RELATED_P (insn) = 1;
 }

+/*search for possible work registers for stack-check operation at prologue
+ return the number of register that can be used without extra push/pop */
+
+static int
+stack_c

PR ada/49944 [4.5/4.6/4.7 regression] Bootstrapping on x86_64-pc-kfreebsd-gnu fails with "s-taprop.adb:856:10: "pthread_attr_setaffinity_np" is undefined (more references follow)"

2011-08-02 Thread Ludovic Brenta
I think the following patch fixes this problem; it consists only in
copying a few lines from s-osinte-linux.ads to
s-osinte-kfreebsd-gnu.ads:

Index: b/src/gcc/ada/s-osinte-kfreebsd-gnu.ads
===
--- a/src/gcc/ada/s-osinte-kfreebsd-gnu.ads
+++ b/src/gcc/ada/s-osinte-kfreebsd-gnu.ads
@@ -469,7 +479,20 @@
  (thread : pthread_t;
   cpusetsize : size_t;
   cpuset : access cpu_set_t) return int;
-   pragma Import (C, pthread_setaffinity_np, "__gnat_pthread_setaffinity_np");
+   pragma Import (C, pthread_setaffinity_np, "pthread_setaffinity_np");
+   pragma Weak_External (pthread_setaffinity_np);
+   --  Use a weak symbol because this function may be available or not,
+   --  depending on the version of the system.
+
+   function pthread_attr_setaffinity_np
+ (attr   : access pthread_attr_t;
+  cpusetsize : size_t;
+  cpuset : access cpu_set_t) return int;
+   pragma Import (C, pthread_attr_setaffinity_np,
+"pthread_attr_setaffinity_np");
+   pragma Weak_External (pthread_attr_setaffinity_np);
+   --  Use a weak symbol because this function may be available or not,
+   --  depending on the version of the system.
 
 private
 
Index: b/src/gcc/ada/ChangeLog
===
--- a/src/gcc/ada/ChangeLog
+++ b/src/gcc/ada/ChangeLog
@@ -0,0 +1,15 @@
+2011-08-02  Ludovic Brenta  
+
+   PR ada/49944
+   * s-osinte-kfreebsd-gnu.ads (pthread_setaffinity_np): import
+   pthread_setaffinity_np instead of __gnat_pthread_setaffinity_np,
+   which no longer exists; and use a Weak_External reference, like we
+   do on Linux.
+   (pthread_attr_setaffinity_np): new, copy from s-osinte-linux.ads.
+


Re: [AVR] Fix PR49881

2011-08-02 Thread Richard Henderson
On 08/02/2011 12:52 AM, Georg-Johann Lay wrote:
> There are still unrecognizables:
> 
> gcc.c-torture/execute/complex-7.c:56:1: error: unrecognizable insn:
> (insn 17 14 18 3 (set (mem:SF (post_dec:HI (reg/f:HI 32 __SP_L__)) [0 S4 A8])
> (reg:SF 43 [ f5.0+4 ]))
> /mnt/nfs/home/georg/gnu/gcc.gnu.org/trunk/gcc/testsuite/gcc.c-torture/execute/complex-7.c:52
>  -1
>  (nil))

I was pretty sure I ran the compile tests.  I've tried several
times to come up with an environment that would properly run
the simulator, without success.  AVR support seems to be in
too many different places, none of which properly communicate
with each other.

That said, this fixes that test case, committed as obvious.


r~
* config/avr/avr.md (push1): Don't constrain the operand.

diff --git a/gcc/config/avr/avr.md b/gcc/config/avr/avr.md
index f60f9f0..b8560df 100644
--- a/gcc/config/avr/avr.md
+++ b/gcc/config/avr/avr.md
@@ -221,7 +221,7 @@
(SF "") (SC "")])
 
 (define_expand "push1"
-  [(match_operand:MPUSH 0 "general_operand" "")]
+  [(match_operand:MPUSH 0 "" "")]
   ""
 {
   int i;


C++ PATCH for c++/49834 (auto not deduced in for-range-declaration)

2011-08-02 Thread Jason Merrill
Even in a template, if the range-init is not type-dependent, we can 
deduce 'auto' in the for-range-declaration.


Tested x86_64-pc-linux-gnu, applying to trunk.
commit 5384cac2db4875bc2f34bce11c6d1a3c360cd66d
Author: Jason Merrill 
Date:   Tue Aug 2 13:42:21 2011 -0400

	PR c++/49834
	* parser.c (build_range_temp): Split out from...
	(cp_convert_range_for): ...here.
	(do_range_for_auto_deduction): New.
	(cp_parser_range_for): Use it.

diff --git a/gcc/cp/parser.c b/gcc/cp/parser.c
index 3828ca9..e8c4b5f 100644
--- a/gcc/cp/parser.c
+++ b/gcc/cp/parser.c
@@ -1629,6 +1629,8 @@ static tree cp_parser_c_for
   (cp_parser *, tree, tree);
 static tree cp_parser_range_for
   (cp_parser *, tree, tree, tree);
+static void do_range_for_auto_deduction
+  (tree, tree);
 static tree cp_parser_perform_range_for_lookup
   (tree, tree *, tree *);
 static tree cp_parser_range_for_member_function
@@ -8673,6 +8675,7 @@ cp_parser_range_for (cp_parser *parser, tree scope, tree init, tree range_decl)
 {
   stmt = begin_range_for_stmt (scope, init);
   finish_range_for_decl (stmt, range_decl, range_expr);
+  do_range_for_auto_deduction (range_decl, range_expr);
 }
   else
 {
@@ -8682,6 +8685,52 @@ cp_parser_range_for (cp_parser *parser, tree scope, tree init, tree range_decl)
   return stmt;
 }
 
+/* Subroutine of cp_convert_range_for: given the initializer expression,
+   builds up the range temporary.  */
+
+static tree
+build_range_temp (tree range_expr)
+{
+  tree range_type, range_temp;
+
+  /* Find out the type deduced by the declaration
+ `auto &&__range = range_expr'.  */
+  range_type = cp_build_reference_type (make_auto (), true);
+  range_type = do_auto_deduction (range_type, range_expr,
+  type_uses_auto (range_type));
+
+  /* Create the __range variable.  */
+  range_temp = build_decl (input_location, VAR_DECL,
+			   get_identifier ("__for_range"), range_type);
+  TREE_USED (range_temp) = 1;
+  DECL_ARTIFICIAL (range_temp) = 1;
+
+  return range_temp;
+}
+
+/* Used by cp_parser_range_for in template context: we aren't going to
+   do a full conversion yet, but we still need to resolve auto in the
+   type of the for-range-declaration if present.  This is basically
+   a shortcut version of cp_convert_range_for.  */
+
+static void
+do_range_for_auto_deduction (tree decl, tree range_expr)
+{
+  tree auto_node = type_uses_auto (TREE_TYPE (decl));
+  if (auto_node)
+{
+  tree begin_dummy, end_dummy, range_temp, iter_type, iter_decl;
+  range_temp = convert_from_reference (build_range_temp (range_expr));
+  iter_type = (cp_parser_perform_range_for_lookup
+		   (range_temp, &begin_dummy, &end_dummy));
+  iter_decl = build_decl (input_location, VAR_DECL, NULL_TREE, iter_type);
+  iter_decl = build_x_indirect_ref (iter_decl, RO_NULL,
+	tf_warning_or_error);
+  TREE_TYPE (decl) = do_auto_deduction (TREE_TYPE (decl),
+	iter_decl, auto_node);
+}
+}
+
 /* Converts a range-based for-statement into a normal
for-statement, as per the definition.
 
@@ -8720,7 +8769,6 @@ cp_parser_range_for (cp_parser *parser, tree scope, tree init, tree range_decl)
 tree
 cp_convert_range_for (tree statement, tree range_decl, tree range_expr)
 {
-  tree range_type, range_temp;
   tree begin, end;
   tree iter_type, begin_expr, end_expr;
   tree condition, expression;
@@ -8731,17 +8779,7 @@ cp_convert_range_for (tree statement, tree range_decl, tree range_expr)
 begin_expr = end_expr = iter_type = error_mark_node;
   else
 {
-  /* Find out the type deduced by the declaration
- `auto &&__range = range_expr'.  */
-  range_type = cp_build_reference_type (make_auto (), true);
-  range_type = do_auto_deduction (range_type, range_expr,
-  type_uses_auto (range_type));
-
-  /* Create the __range variable.  */
-  range_temp = build_decl (input_location, VAR_DECL,
-			   get_identifier ("__for_range"), range_type);
-  TREE_USED (range_temp) = 1;
-  DECL_ARTIFICIAL (range_temp) = 1;
+  tree range_temp = build_range_temp (range_expr);
   pushdecl (range_temp);
   cp_finish_decl (range_temp, range_expr,
 		  /*is_constant_init*/false, NULL_TREE,
diff --git a/gcc/testsuite/g++.dg/cpp0x/range-for20.C b/gcc/testsuite/g++.dg/cpp0x/range-for20.C
new file mode 100644
index 000..6587128
--- /dev/null
+++ b/gcc/testsuite/g++.dg/cpp0x/range-for20.C
@@ -0,0 +1,33 @@
+// PR c++/49834
+// { dg-options -std=c++0x }
+
+struct A
+{
+  template  T get_value() const;
+};
+
+struct B {
+  A first, second;
+};
+
+struct C
+{
+  B* begin() const;
+  B* end() const;
+};
+
+template 
+Ret f(const C &p)
+{
+  for (const B &i: p)		// OK
+i.second.get_value();
+  for (const auto &i: p)	// ERROR
+i.second.get_value();
+  return Ret(0);
+}
+
+void g()
+{
+  f(C());
+}
+


ping: [patch] libiberty/cp-demangle.c: Fix CP_DEMANGLE_DEBUG SIGSEGV

2011-08-02 Thread Jan Kratochvil
ping:

On Tue, 28 Jun 2011 22:15:04 +0200, Jan Kratochvil wrote:
Hi,

a mechanical patch which fixes during

#define CP_DEMANGLE_DEBUG
make check
->
/bin/sh: line 1:  9179 Segmentation fault  ./test-demangle < 
./demangle-expected

which also fixes confusing output for _Z1hI1AIiEdEDTcldtfp_1gIT0_EEET_S2_
binary operator arguments
  binary operator
operator .
binary operator arguments
???---> template
name 'g'
template argument list
  template parameter 1
  argument list


Thanks,
Jan


libiberty/
2011-06-28  Jan Kratochvil  

* cp-demangle.c (d_dump): Add " (zero-based)" to
DEMANGLE_COMPONENT_TEMPLATE_PARAM.  Implement
DEMANGLE_COMPONENT_FUNCTION_PARAM, DEMANGLE_COMPONENT_VECTOR_TYPE,
DEMANGLE_COMPONENT_NUMBER, DEMANGLE_COMPONENT_GLOBAL_CONSTRUCTORS,
DEMANGLE_COMPONENT_GLOBAL_DESTRUCTORS, DEMANGLE_COMPONENT_LAMBDA,
DEMANGLE_COMPONENT_DEFAULT_ARG and DEMANGLE_COMPONENT_UNNAMED_TYPE.
Print "??? %d" on unknown dc->type.

--- a/libiberty/cp-demangle.c
+++ b/libiberty/cp-demangle.c
@@ -506,7 +507,10 @@ d_dump (struct demangle_component *dc, int indent)
   printf ("name '%.*s'\n", dc->u.s_name.len, dc->u.s_name.s);
   return;
 case DEMANGLE_COMPONENT_TEMPLATE_PARAM:
-  printf ("template parameter %ld\n", dc->u.s_number.number);
+  printf ("template parameter %ld (zero-based)\n", dc->u.s_number.number);
+  return;
+case DEMANGLE_COMPONENT_FUNCTION_PARAM:
+  printf ("function parameter %ld (zero-based)\n", dc->u.s_number.number);
   return;
 case DEMANGLE_COMPONENT_CTOR:
   printf ("constructor %d\n", (int) dc->u.s_ctor.kind);
@@ -633,6 +637,9 @@ d_dump (struct demangle_component *dc, int indent)
 case DEMANGLE_COMPONENT_FIXED_TYPE:
   printf ("fixed-point type\n");
   break;
+case DEMANGLE_COMPONENT_VECTOR_TYPE:
+  printf ("vector type\n");
+  break;
 case DEMANGLE_COMPONENT_ARGLIST:
   printf ("argument list\n");
   break;
@@ -675,12 +682,35 @@ d_dump (struct demangle_component *dc, int indent)
 case DEMANGLE_COMPONENT_CHARACTER:
   printf ("character '%c'\n",  dc->u.s_character.character);
   return;
+case DEMANGLE_COMPONENT_NUMBER:
+  printf ("number %ld\n", dc->u.s_number.number);
+  return;
 case DEMANGLE_COMPONENT_DECLTYPE:
   printf ("decltype\n");
   break;
+case DEMANGLE_COMPONENT_GLOBAL_CONSTRUCTORS:
+  printf ("global constructors keyed to name\n");
+  break;
+case DEMANGLE_COMPONENT_GLOBAL_DESTRUCTORS:
+  printf ("global destructors keyed to name\n");
+  break;
+case DEMANGLE_COMPONENT_LAMBDA:
+  printf ("lambda %d (zero-based)\n", dc->u.s_unary_num.num);
+  d_dump (dc->u.s_unary_num.sub, indent + 2);
+  return;
+case DEMANGLE_COMPONENT_DEFAULT_ARG:
+  printf ("default argument %d (zero-based)\n", dc->u.s_unary_num.num);
+  d_dump (dc->u.s_unary_num.sub, indent + 2);
+  return;
+case DEMANGLE_COMPONENT_UNNAMED_TYPE:
+  printf ("unnamed type %ld\n", dc->u.s_number.number);
+  return;
 case DEMANGLE_COMPONENT_PACK_EXPANSION:
   printf ("pack expansion\n");
   break;
+default:
+  printf ("??? %d\n", dc->type);
+  break;
 }
 
   d_dump (d_left (dc), indent + 2);


[H8] Fix target/49878

2011-08-02 Thread Richard Henderson
The problem here is that reload finds a push of arg_pointer_rtx
and disables register elimination of AP->SP because of it.  This
leads to a register elimination (and assertion) failure when it
comes time to output debug info.

Preventing eliminable registers from being pushed fixes this.

The change to the pushqi/pushhi patterns, aside from using
register_no_sp_elim_operand, is cosmetic.  We can do a better
job with single_set insns, and PRE_MODIFY does the job fine.
Moreover, that's the pattern that will automatically be
generated by emit_single_push_insn.

The exact formulation of h8300_move_ok is perhaps more 
conservative than it needs to be.  The existing checks,

> -   && !(GET_CODE (operands[0]) == MEM
> -   && GET_CODE (XEXP (operands[0], 0)) == PRE_DEC
> -   && GET_CODE (XEXP (XEXP (operands[0], 0), 0)) == REG
> -   && GET_CODE (operands[1]) == REG
> -   && REGNO (XEXP (XEXP (operands[0], 0), 0)) == REGNO (operands[1]))"

only check for overlap on a store.  I assumed it was
merely an oversight that we didn't check for overlap
on a pre_inc load as well.

Committed.


r~
PR target/49878
* config/h8300/h8300.c (h8300_move_ok): New.
* config/h8300/h8300-protos.h: Declare it.
* config/h8300/h8300.md (P): New mode iterator.
(*movqi_h8300, *movqi_h8300hs, movqi): Use h8300_move_ok.
(*movqi_h8sx, *movhi_h8300, *movhi_h8300hs, movhi): Likewise.
(movsi, *movsi_h8300, *movsi_h8300hs): Likewise.
(*pushqi1_h8300): Rename from pushqi1_h8300; use PRE_MODIFY.
(*pushqi1_h8300hs_): Macroize from pushqi1_h8300hs_advanced
and pushqi1_h8300hs_normal; use PRE_MODIFY and
register_no_sp_elim_operand.
(*pushhi1_h8300hs_): Similarly.
(pushqi1, pushhi1, pushhi1_h8300): Remove.
* config/h8300/predicates.md (register_no_sp_elim_operand): New.

diff --git a/gcc/config/h8300/h8300-protos.h b/gcc/config/h8300/h8300-protos.h
index da3b75a..aeac904 100644
--- a/gcc/config/h8300/h8300-protos.h
+++ b/gcc/config/h8300/h8300-protos.h
@@ -101,6 +101,7 @@ extern int h8300_regs_ok_for_stm (int, rtx[]);
 extern int h8300_hard_regno_rename_ok (unsigned int, unsigned int);
 extern int h8300_hard_regno_nregs (int, enum machine_mode);
 extern int h8300_hard_regno_mode_ok (int, enum machine_mode);
+extern bool h8300_move_ok (rtx, rtx);
 
 struct cpp_reader;
 extern void h8300_pr_interrupt (struct cpp_reader *);
diff --git a/gcc/config/h8300/h8300.c b/gcc/config/h8300/h8300.c
index 62e9e85..ef48395 100644
--- a/gcc/config/h8300/h8300.c
+++ b/gcc/config/h8300/h8300.c
@@ -5813,6 +5813,40 @@ h8300_hard_regno_mode_ok (int regno, enum machine_mode 
mode)
goes.  */
 return regno == MAC_REG ? mode == SImode : 1;
 }
+
+/* Helper function for the move patterns.  Make sure a move is legitimate.  */
+
+bool
+h8300_move_ok (rtx dest, rtx src)
+{
+  rtx addr, other;
+
+  /* Validate that at least one operand is a register.  */
+  if (MEM_P (dest))
+{
+  if (MEM_P (src) || CONSTANT_P (src))
+   return false;
+  addr = XEXP (dest, 0);
+  other = src;
+}
+  else if (MEM_P (src))
+{
+  addr = XEXP (src, 0);
+  other = dest;
+}
+  else
+return true;
+
+  /* Validate that auto-inc doesn't affect OTHER.  */
+  if (GET_RTX_CLASS (GET_CODE (addr)) != RTX_AUTOINC)
+return true;
+  addr = XEXP (addr, 0);
+
+  if (addr == stack_pointer_rtx)
+return register_no_sp_elim_operand (other, VOIDmode);
+  else
+return !reg_overlap_mentioned_p(other, addr);
+}
 
 /* Perform target dependent optabs initialization.  */
 static void
diff --git a/gcc/config/h8300/h8300.md b/gcc/config/h8300/h8300.md
index db56e20..fa1809d 100644
--- a/gcc/config/h8300/h8300.md
+++ b/gcc/config/h8300/h8300.md
@@ -180,6 +180,15 @@
 (include "constraints.md")
 
 ;; --
+;; MACRO DEFINITIONS
+;; --
+
+;; This mode iterator allows :P to be used for patterns that operate on
+;; pointer-sized quantities.  Exactly one of the two alternatives will match.
+(define_mode_iterator P [(HI "Pmode == HImode") (SI "Pmode == SImode")])
+
+
+;; --
 ;; MOVE INSTRUCTIONS
 ;; --
 
@@ -189,8 +198,7 @@
   [(set (match_operand:QI 0 "general_operand_dst" "=r,r ,<,r,r,m")
(match_operand:QI 1 "general_operand_src" " I,r>,r,n,m,r"))]
   "TARGET_H8300
-   && (register_operand (operands[0], QImode)
-   || register_operand (operands[1], QImode))"
+   && h8300_move_ok (operands[0], operands[1])"
   "@
sub.b   %X0,%X0
mov.b   %R1,%X0
@@ -205,8 +213,7 @@
   [(set (match_operand:QI 0 "general_operand_dst" "=r,r ,<,r,r,m")
(match_operand:QI 1 "general_operand_src" " I,r>,r,n,m,r"))]
   "(TARGET_H8300H || TARGET_H8300S) && !TARGET_H8300SX

Re: [AVR] Fix PR49881

2011-08-02 Thread Georg-Johann Lay

In CCing Jörg.

Richard Henderson schrieb:

On 08/02/2011 12:52 AM, Georg-Johann Lay wrote:


There are still unrecognizables:

gcc.c-torture/execute/complex-7.c:56:1: error: unrecognizable insn:
(insn 17 14 18 3 (set (mem:SF (post_dec:HI (reg/f:HI 32 __SP_L__)) [0 S4 A8])
   (reg:SF 43 [ f5.0+4 ]))
(nil))


I was pretty sure I ran the compile tests.  I've tried several
times to come up with an environment that would properly run
the simulator, without success.  AVR support seems to be in
too many different places, none of which properly communicate
with each other.


Just ask :-)

For questions/answers you may want to read/post to the looow traffic 
avr-gcc-list:

   http://lists.gnu.org/archive/html/avr-gcc-list/

== binutils ==

configure plain vanilla: --target=avr --prefix=
build and install

== gcc ==

You've done that already. I'm using something around
configure --target=avr --enable-languages=c,c++ --disable-nls 
--prefix= --with-dwarf2


== avr-libc ==

Needed to run because it provides startup code and C libs.
A bit tricky, easiest to use is current CVS head.

With the latest version 1.7.1 from
http://download.savannah.gnu.org/releases/avr-libc/
you will need the patches
http://svn.sv.gnu.org/viewvc?view=rev&root=avr-libc&revision=2239
http://svn.sv.gnu.org/viewvc?view=rev&root=avr-libc&revision=2241

configure with --host=avr --prefix= CC=avr-gcc
If you give CC= (e.g. if your avr-gcc is noz in PATH) note that
the name must contain "avr" i.e. build using CC=xgcc or so does
not work. In-tree build is not supported.

Building is currently blocked by PR49864 so you have a dead-lock
and may want to downgrade gcc or avr BE to r177070 to build avr-libc.

Install it.

If I overlooked something Joerg will correct me.

== avrtest ==

There is a text
http://lists.gnu.org/archive/html/avr-gcc-list/2011-06/msg00015.html
and a README:
http://winavr.cvs.sourceforge.net/viewvc/winavr/avrtest/README?view=markup

In the case there are questions: Ask.


That said, this fixes that test case, committed as obvious.


Didn't try it yet. Is that capable of fixing the runtime FAILs?

Johann



r~



Re: [AVR] Fix PR49881

2011-08-02 Thread Richard Henderson
On 08/02/2011 12:01 PM, Georg-Johann Lay wrote:
> == avrtest ==
> 
> There is a text
> http://lists.gnu.org/archive/html/avr-gcc-list/2011-06/msg00015.html
> and a README:
> http://winavr.cvs.sourceforge.net/viewvc/winavr/avrtest/README?view=markup
> 
> In the case there are questions: Ask.

Ah, a totally different simulator than google found.

I don't suppose you've ever looked into fixing up what's
in binutils/sim/avr/ so that it works well enough, and 
gets automatically included into gdb as "target sim"?


r~


Re: [patch tree-optimization]: Avoid !=/== 0/1 comparisons for boolean-typed argument

2011-08-02 Thread Kai Tietz
Sorry, had a pasto in testcase.

Fixed at rev. 166205

2011-08-02  Kai Tietz  

PR middle-end/49947
* gcc.dg/tree-ssa/forwprop-15.c


Tested on x86_64-pc-linux-gnu.  Applied as obvious fix.

Regards,
Kai


Index: gcc.dg/tree-ssa/forwprop-15.c
===
--- gcc.dg/tree-ssa/forwprop-15.c   (revision 177170)
+++ gcc.dg/tree-ssa/forwprop-15.c   (working copy)
@@ -2,7 +2,7 @@
 /* { dg-options "-O2 -fdump-tree-forwprop1" }  */

 _Bool
-foo (_Bool a, _Bool b, _Bool c
+foo (_Bool a, _Bool b, _Bool c)
 {
   _Bool r1 = a == 0 & b != 0;
   _Bool r2 = b != 0 & c == 0;


[lra] one more patch to decrease ARM code size degradation

2011-08-02 Thread Vladimir Makarov
The following patch decreases ARM code size degradation for LRA.  It 
permits achieve practically the same SPECINT2000 code size on ARM as for 
reload (there is still small ARM code size degradation on SPECFP2000).


The patch was successfully bootstrapped on x86-64.

2011-08-02  Vladimir Makarov 

* lra-assigns.c (find_hard_regno_for): Don't do hard register
usage leveling for targets with conditional execution.

Index: lra-assigns.c
===
--- lra-assigns.c   (revision 176950)
+++ lra-assigns.c   (working copy)
@@ -428,7 +428,12 @@ find_hard_regno_for (int regno, int *cos
  if (best_hard_regno < 0 || hard_regno_costs[hard_regno] < 
best_cost

  || (hard_regno_costs[hard_regno] == best_cost
&& (bank < best_bank
- || (bank == best_bank
+ /* Hard register usage leveling actually results
+in bigger code for targets with conditional
+execution like ARM because it reduces chance
+of if-conversion after LRA.  */
+ || (! targetm.have_conditional_execution ()
+ && bank == best_bank
&& best_usage > lra_hard_reg_usage[hard_regno]
{
  best_hard_regno = hard_regno;



  1   2   >