[multiple changes]

2009-07-23  Gary Dismukes  <dismukes@adacore.com>

	* sem_ch6.adb (Check_Return_Subtype_Indication): Replace type equality
	with test of coverage, to allow specific type objects in extended
	returns of class-wide functions. Remove now-unnecessary special-case
	tests that allowed this in certain cases of expanded extended returns.

2009-07-23  Javier Miranda  <miranda@adacore.com>

	* sinfo.ads,sinfo.adb (Entity/Set_Entity): Attribute available in
	N_Null_Statements (for SCIL nodes).
	(Is_Scil_Node/Set_Is_Scil_Node): New attribute (for SCIL nodes).
	(Scil_Nkind/Set_Scil_Nkind): New attribute (for SCIL nodes).
	(Scil_Related_Node/Set_Scil_Related_Node): New attribute (for SCIL
	nodes).
	(Scil_Target_Prim/Set_Scil_Target_Prim): New attribute (for SCIL nodes).
	* exp_disp.adb (Expand_Dispatching_Call): Add generation of SCIL node
	associated with dispatching call.
	(Get_Scil_Node_Kind): New function that returns the kind of SCIL node.
	(Make_DT, Make_Tags): Add generation of SCIL nodes associated with
	initialization of dispatch tables and initialization of tags.
	(New_Scil_Node): New function that creates a new SCIL node.
	(Build_Init_Procedure): Add generation of SCIL node associated with the
	initialization of tags done in the IP subprogram.

2009-07-23  Ed Schonberg  <schonberg@adacore.com>

	* errout.adb (Error_Msg_NEL): If the entity in the initial message has
	Warnings_Off, do not emit continuation messages.

	* sem_ch10.adb: Set Is_Compilation_Unit on generated child subprogram
	spec.

2009-07-23  Emmanuel Briot  <briot@adacore.com>

	* ali.adb: Minor comment update

2009-07-23  Vasiliy Fofanov  <fofanov@adacore.com>

	* s-win32.ads (HANDLE): Define to be the same size as address type.
	Fix copyright.

2009-07-23  Olivier Hainque  <hainque@adacore.com>

	* g-sse.ads: New file. Root of the SSE facilities trees, with
	general description and common declarations.
	* g-ssvety.ads: New file. Expose user level SSE vector types.
	* impunit.adb (Non_Imp_File_Names_95): Register new units.
	* gcc-interface/Makefile.in (x86 32/64 linux, win32): Add
	EXTRA_GNATRTL_NONTASKING_OBJS entries for SSE units.

2009-07-23  Ben Brosgol  <brosgol@adacore.com>

	* gnat_ugn.texi: Wordsmithing.

From-SVN: r149974

gcc/ada/ChangeLog

+2009-07-23  Gary Dismukes  <dismukes@adacore.com>
+
+	* sem_ch6.adb (Check_Return_Subtype_Indication): Replace type equality
+	with test of coverage, to allow specific type objects in extended
+	returns of class-wide functions. Remove now-unnecessary special-case
+	tests that allowed this in certain cases of expanded extended returns.
+
+2009-07-23  Javier Miranda  <miranda@adacore.com>
+
+	* sinfo.ads,sinfo.adb (Entity/Set_Entity): Attribute available in
+	N_Null_Statements (for SCIL nodes).
+	(Is_Scil_Node/Set_Is_Scil_Node): New attribute (for SCIL nodes).
+	(Scil_Nkind/Set_Scil_Nkind): New attribute (for SCIL nodes).
+	(Scil_Related_Node/Set_Scil_Related_Node): New attribute (for SCIL
+	nodes).
+	(Scil_Target_Prim/Set_Scil_Target_Prim): New attribute (for SCIL nodes).
+	* exp_disp.adb (Expand_Dispatching_Call): Add generation of SCIL node
+	associated with dispatching call.
+	(Get_Scil_Node_Kind): New function that returns the kind of SCIL node.
+	(Make_DT, Make_Tags): Add generation of SCIL nodes associated with
+	initialization of dispatch tables and initialization of tags.
+	(New_Scil_Node): New function that creates a new SCIL node.
+	(Build_Init_Procedure): Add generation of SCIL node associated with the
+	initialization of tags done in the IP subprogram.
+
+2009-07-23  Ed Schonberg  <schonberg@adacore.com>
+
+	* errout.adb (Error_Msg_NEL): If the entity in the initial message has
+	Warnings_Off, do not emit continuation messages.
+
+	* sem_ch10.adb: Set Is_Compilation_Unit on generated child subprogram
+	spec.
+
+2009-07-23  Emmanuel Briot  <briot@adacore.com>
+
+	* ali.adb: Minor comment update
+
+2009-07-23  Vasiliy Fofanov  <fofanov@adacore.com>
+
+	* s-win32.ads (HANDLE): Define to be the same size as address type.
+	Fix copyright.
+
+2009-07-23  Olivier Hainque  <hainque@adacore.com>
+
+	* g-sse.ads: New file. Root of the SSE facilities trees, with
+	general description and common declarations.
+	* g-ssvety.ads: New file. Expose user level SSE vector types.
+	* impunit.adb (Non_Imp_File_Names_95): Register new units.
+	* gcc-interface/Makefile.in (x86 32/64 linux, win32): Add
+	EXTRA_GNATRTL_NONTASKING_OBJS entries for SSE units.
+
+2009-07-23  Ben Brosgol  <brosgol@adacore.com>
+
+	* gnat_ugn.texi: Wordsmithing.
+
 2009-07-23  Arnaud Charlet  <charlet@adacore.com>
 
 	* prj-conf.ads, prj-conf.adb: Switch to GPLv3.

gcc/ada/ali.adb

@@ -2248,7 +2248,9 @@ package body ALI is
                            end;
 
                         --  Interfaces are stored in the list of references,
-                        --  although the parent type itself is stored in XE
+                        --  although the parent type itself is stored in XE.
+                        --  The first interface (when there are only
+                        --  interfaces) is stored in XE.Tref*)
 
                         elsif Ref = Tref_Derived
                           and then Typ = 'R'

gcc/ada/errout.adb

@@ -1100,6 +1100,10 @@ package body Errout is
          --  Suppress if no warnings set for either entity or node
 
          if No_Warnings (N) or else No_Warnings (E) then
+
+            --  Disable as well continuation messages, if any.
+
+            Last_Killed := True;
             return;
          end if;
 

gcc/ada/exp_ch3.adb

@@ -2322,6 +2322,14 @@ package body Exp_Ch3 is
                   New_Reference_To
                     (Node (First_Elmt (Access_Disp_Table (Rec_Type))), Loc)));
 
+            if Generate_SCIL then
+               Prepend_To (Init_Tags_List,
+                 New_Scil_Node
+                   (Nkind        => IP_Tag_Init,
+                    Related_Node => First (Init_Tags_List),
+                    Entity       => Rec_Type));
+            end if;
+
             --  Ada 2005 (AI-251): Initialize the secondary tags components
             --  located at fixed positions (tags whose position depends on
             --  variable size components are initialized later ---see below).

gcc/ada/exp_disp.adb

@@ -643,6 +643,15 @@ package body Exp_Disp is
          Typ := Non_Limited_View (Typ);
       end if;
 
+      if Generate_SCIL then
+         Insert_Action (Call_Node,
+           New_Scil_Node
+             (Nkind        => Dispatching_Call,
+              Related_Node => Call_Node,
+              Entity       => Typ,
+              Target_Prim  => Subp));
+      end if;
+
       if not Is_Limited_Type (Typ) then
          Eq_Prim_Op := Find_Prim_Op (Typ, Name_Op_Eq);
       end if;
@@ -1596,6 +1605,18 @@ package body Exp_Disp is
       end if;
    end Expand_Interface_Thunk;
 
+   ------------------------
+   -- Get_Scil_Node_Kind --
+   ------------------------
+
+   function Get_Scil_Node_Kind (Node : Node_Id) return Scil_Node_Kind is
+   begin
+      pragma Assert (Nkind (Node) = N_Null_Statement
+        and then Is_Scil_Node (Node));
+
+      return Scil_Node_Kind'Val (UI_To_Int (Scil_Nkind (Node)));
+   end Get_Scil_Node_Kind;
+
    ------------
    -- Has_DT --
    ------------
@@ -4221,6 +4242,14 @@ package body Exp_Disp is
                   New_Reference_To
                     (RTE (RE_No_Dispatch_Table_Wrapper), Loc)));
 
+            if Generate_SCIL then
+               Insert_Before (Last (Result),
+                 New_Scil_Node
+                   (Nkind        => Dispatch_Table_Object_Init,
+                    Related_Node => Last (Result),
+                    Entity       => Typ));
+            end if;
+
             Append_To (Result,
               Make_Attribute_Definition_Clause (Loc,
                 Name       => New_Reference_To (DT, Loc),
@@ -4247,6 +4276,14 @@ package body Exp_Disp is
                             (RTE_Record_Component (RE_NDT_Prims_Ptr), Loc)),
                       Attribute_Name => Name_Address))));
 
+            if Generate_SCIL then
+               Insert_Before (Last (Result),
+                 New_Scil_Node
+                   (Nkind        => Dispatch_Table_Tag_Init,
+                    Related_Node => Last (Result),
+                    Entity       => Typ));
+            end if;
+
          --  Generate:
          --    DT : Dispatch_Table_Wrapper (Nb_Prim);
          --    for DT'Alignment use Address'Alignment;
@@ -4276,6 +4313,14 @@ package body Exp_Disp is
                     Constraint => Make_Index_Or_Discriminant_Constraint (Loc,
                                     Constraints => DT_Constr_List))));
 
+            if Generate_SCIL then
+               Insert_Before (Last (Result),
+                 New_Scil_Node
+                   (Nkind        => Dispatch_Table_Object_Init,
+                    Related_Node => Last (Result),
+                    Entity       => Typ));
+            end if;
+
             Append_To (Result,
               Make_Attribute_Definition_Clause (Loc,
                 Name       => New_Reference_To (DT, Loc),
@@ -4302,6 +4347,14 @@ package body Exp_Disp is
                             (RTE_Record_Component (RE_Prims_Ptr), Loc)),
                       Attribute_Name => Name_Address))));
 
+            if Generate_SCIL then
+               Insert_Before (Last (Result),
+                 New_Scil_Node
+                   (Nkind        => Dispatch_Table_Tag_Init,
+                    Related_Node => Last (Result),
+                    Entity       => Typ));
+            end if;
+
             Append_To (Result,
               Make_Object_Declaration (Loc,
                 Defining_Identifier =>
@@ -5070,6 +5123,14 @@ package body Exp_Disp is
                 Expression => Make_Aggregate (Loc,
                   Expressions => DT_Aggr_List)));
 
+            if Generate_SCIL then
+               Insert_Before (Last (Result),
+                 New_Scil_Node
+                   (Nkind        => Dispatch_Table_Object_Init,
+                    Related_Node => Last (Result),
+                    Entity       => Typ));
+            end if;
+
             Append_To (Result,
               Make_Attribute_Definition_Clause (Loc,
                 Name       => New_Reference_To (DT, Loc),
@@ -5376,6 +5437,14 @@ package body Exp_Disp is
                 Expression => Make_Aggregate (Loc,
                   Expressions => DT_Aggr_List)));
 
+            if Generate_SCIL then
+               Insert_Before (Last (Result),
+                 New_Scil_Node
+                   (Nkind        => Dispatch_Table_Object_Init,
+                    Related_Node => Last (Result),
+                    Entity       => Typ));
+            end if;
+
             Append_To (Result,
               Make_Attribute_Definition_Clause (Loc,
                 Name       => New_Reference_To (DT, Loc),
@@ -6066,6 +6135,14 @@ package body Exp_Disp is
                             (RTE_Record_Component (RE_Prims_Ptr), Loc)),
                       Attribute_Name => Name_Address))));
 
+            if Generate_SCIL then
+               Insert_Before (Last (Result),
+                 New_Scil_Node
+                   (Nkind        => Dispatch_Table_Tag_Init,
+                    Related_Node => Last (Result),
+                    Entity       => Typ));
+            end if;
+
             Append_To (Result,
               Make_Object_Declaration (Loc,
                 Defining_Identifier => Predef_Prims_Ptr,
@@ -6100,6 +6177,14 @@ package body Exp_Disp is
                           New_Occurrence_Of
                             (RTE_Record_Component (RE_NDT_Prims_Ptr), Loc)),
                       Attribute_Name => Name_Address))));
+
+            if Generate_SCIL then
+               Insert_Before (Last (Result),
+                 New_Scil_Node
+                   (Nkind        => Dispatch_Table_Tag_Init,
+                    Related_Node => Last (Result),
+                    Entity       => Typ));
+            end if;
          end if;
 
          Set_Is_True_Constant (DT_Ptr);
@@ -6322,6 +6407,29 @@ package body Exp_Disp is
       end if;
    end New_Value;
 
+   -------------------
+   -- New_Scil_Node --
+   -------------------
+
+   function New_Scil_Node
+     (Nkind        : Scil_Node_Kind;
+      Related_Node : Node_Id;
+      Entity       : Entity_Id := Empty;
+      Target_Prim  : Entity_Id := Empty) return Node_Id
+   is
+      New_N : Node_Id;
+
+   begin
+      New_N := New_Node (N_Null_Statement, Sloc (Related_Node));
+      Set_Is_Scil_Node      (New_N);
+      Set_Scil_Nkind        (New_N, UI_From_Int (Scil_Node_Kind'Pos (Nkind)));
+      Set_Scil_Related_Node (New_N, Related_Node);
+      Set_Entity            (New_N, Entity);
+      Set_Scil_Target_Prim  (New_N, Target_Prim);
+
+      return New_N;
+   end New_Scil_Node;
+
    -----------------------------------
    -- Original_View_In_Visible_Part --
    -----------------------------------

gcc/ada/exp_disp.ads

@@ -30,6 +30,17 @@ with Types; use Types;
 
 package Exp_Disp is
 
+   -------------------------------
+   -- SCIL Node Type Definition --
+   -------------------------------
+
+   type Scil_Node_Kind is (
+      Unused,
+      IP_Tag_Init,
+      Dispatching_Call,
+      Dispatch_Table_Object_Init,
+      Dispatch_Table_Tag_Init);
+
    -------------------------------------
    -- Predefined primitive operations --
    -------------------------------------
@@ -215,6 +226,9 @@ package Exp_Disp is
    --  Otherwise they are set to the defining identifier and the subprogram
    --  body of the generated thunk.
 
+   function Get_Scil_Node_Kind (Node : Node_Id) return Scil_Node_Kind;
+   --  Returns the kind of an SCIL node
+
    function Is_Predefined_Dispatching_Operation (E : Entity_Id) return Boolean;
    --  Ada 2005 (AI-251): Determines if E is a predefined primitive operation
 
@@ -309,6 +323,15 @@ package Exp_Disp is
    --  tagged types this routine imports the forward declaration of the tag
    --  entity, that will be declared and exported by Make_DT.
 
+   function New_Scil_Node
+     (Nkind        : Scil_Node_Kind;
+      Related_Node : Node_Id;
+      Entity       : Entity_Id := Empty;
+      Target_Prim  : Entity_Id := Empty) return Node_Id;
+   --  Creates a new Scil node. Related_Node is the AST node associated with
+   --  this Scil node. Entity is the tagged type associated with the Scil node.
+   --  For Dispatching_Call nodes, Target_Prim is the dispatching primitive.
+
    function Register_Primitive
      (Loc     : Source_Ptr;
       Prim    : Entity_Id) return List_Id;

gcc/ada/g-sse.ads

+------------------------------------------------------------------------------
+--                                                                          --
+--                         GNAT COMPILER COMPONENTS                         --
+--                                                                          --
+--                             G N A T . S S E                              --
+--                                                                          --
+--                                 S p e c                                  --
+--                                                                          --
+--             Copyright (C) 2009, 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- --
+-- ware  Foundation;  either version 3,  or (at your option) any later ver- --
+-- sion.  GNAT is distributed in the hope that it will be useful, but WITH- --
+-- OUT ANY WARRANTY;  without even the  implied warranty of MERCHANTABILITY --
+-- or FITNESS FOR A PARTICULAR PURPOSE.                                     --
+--                                                                          --
+-- As a special exception under Section 7 of GPL version 3, you are granted --
+-- additional permissions described in the GCC Runtime Library Exception,   --
+-- version 3.1, as published by the Free Software Foundation.               --
+--                                                                          --
+-- You should have received a copy of the GNU General Public License and    --
+-- a copy of the GCC Runtime Library Exception along with this program;     --
+-- see the files COPYING3 and COPYING.RUNTIME respectively.  If not, see    --
+-- <http://www.gnu.org/licenses/>.                                          --
+--                                                                          --
+-- GNAT was originally developed  by the GNAT team at  New York University. --
+-- Extensive contributions were provided by Ada Core Technologies Inc.      --
+--                                                                          --
+------------------------------------------------------------------------------
+
+--  This unit is the root of a set aimed at offering Ada bindings to a subset
+--  of the Intel(r) Streaming SIMD Extensions with GNAT.  It exposes vector
+--  _component_ types together with general comments on the binding contents.
+
+--  The purpose is to allow access from Ada to the SSE facilities defined in
+--  the Intel(r) compiler manuals, in particular in the Intrinsics Reference
+--  of the C++ Compiler User's Guide, available from http://www.intel.com.
+
+--  As of today, essentially one unit is offered: GNAT.SSE.Vector__Types,
+--  which exposes Ada types corresponding to the reference types (__m128 and
+--  the like) over which GCC builtins will operate.
+
+--  The exposed Ada types are private. Object initializations or value
+--  observations may be performed with unchecked conversions or address
+--  overlays, for example:
+
+--  with Ada.Unchecked_Conversion;
+--  with GNAT.SSE.Vector_Types; use GNAT.SSE; use GNAT.SSE.Vector_Types;
+--
+--  procedure SSE_Base is
+--
+--     --  Core operations
+--
+--     function mm_add_ss (A, B : M128) return M128;
+--     pragma Import (Intrinsic, mm_add_ss, "__builtin_ia32_addss");
+--
+--     --  User views / conversions or overlays
+--
+--     type Vf32_View is array (1 .. 4) of Float;
+--     for Vf32_View'Alignment use VECTOR_ALIGN;
+--
+--     function To_M128 is new Ada.Unchecked_Conversion (Vf32_View, M128);
+--
+--     X, Y, Z : M128;
+--
+--     Vz : Vf32_View;
+--     for Vz'Address use Z'Address;
+--  begin
+--     X := To_M128 ((1.0, 1.0, 2.0, 2.0));
+--     Y := To_M128 ((2.0, 2.0, 1.0, 1.0));
+--     Z := mm_add_ss (X, Y);
+--
+--     if vz /= (3.0, 1.0, 2.0, 2.0) then
+--        raise Program_Error;
+--     end if;
+--  end;
+
+--  Use of Unchecked_Union is very tempting, however hits difficulties with
+--  e.g. implicit front-end expanded equality operators, which typically
+--  feature a subcase comparing the m128 components, not supported by the
+--  middle-end.
+
+package GNAT.SSE is
+   type Float32 is new Float;
+   type Float64 is new Long_Float;
+   type Integer64 is new Long_Long_Integer;
+
+   VECTOR_BYTES : constant := 16;
+   --  Common size of all the SSE vector types, in bytes.
+
+   VECTOR_ALIGN : constant := 16;
+   --  Common alignment of all the SSE vector types, in bytes.
+
+   --  Alignment-wise, the reference document reads:
+   --  << The compiler aligns __m128d and _m128i local and global data to
+   --     16-byte boundaries on the stack. >>
+   --
+   --  We apply that consistently to all the Ada vector types, as GCC does
+   --  for the corresponding C types.
+
+end GNAT.SSE;

gcc/ada/g-ssvety.ads

+------------------------------------------------------------------------------
+--                                                                          --
+--                         GNAT COMPILER COMPONENTS                         --
+--                                                                          --
+--                 G N A T . S S E . V e c t o r _ T y p e s                --
+--                                                                          --
+--                                 S p e c                                  --
+--                                                                          --
+--             Copyright (C) 2009, 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- --
+-- ware  Foundation;  either version 3,  or (at your option) any later ver- --
+-- sion.  GNAT is distributed in the hope that it will be useful, but WITH- --
+-- OUT ANY WARRANTY;  without even the  implied warranty of MERCHANTABILITY --
+-- or FITNESS FOR A PARTICULAR PURPOSE.                                     --
+--                                                                          --
+-- As a special exception under Section 7 of GPL version 3, you are granted --
+-- additional permissions described in the GCC Runtime Library Exception,   --
+-- version 3.1, as published by the Free Software Foundation.               --
+--                                                                          --
+-- You should have received a copy of the GNU General Public License and    --
+-- a copy of the GCC Runtime Library Exception along with this program;     --
+-- see the files COPYING3 and COPYING.RUNTIME respectively.  If not, see    --
+-- <http://www.gnu.org/licenses/>.                                          --
+--                                                                          --
+-- GNAT was originally developed  by the GNAT team at  New York University. --
+-- Extensive contributions were provided by Ada Core Technologies Inc.      --
+--                                                                          --
+------------------------------------------------------------------------------
+
+--  This unit exposes the Ada __m128 like data types to represent the contents
+--  of SSE registers, for use by the SSE intrinsics.
+
+package GNAT.SSE.Vector_Types is
+
+   --  The reference guide states a few usage guidelines for the C types :
+
+   --  << Since these new data types are not basic ANSI C data types, you
+   --     must observe the following usage restrictions:
+   --
+   --     * Use new data types only on either side of an assignment, as a
+   --       return value, or as a parameter. You cannot use it with other
+   --       arithmetic expressions ("+", "-", and so on).
+   --
+   --     * Use new data types as objects in aggregates, such as unions to
+   --       access the byte elements and structures.
+   --
+   --     * Use new data types only with the respective intrinsics described
+   --       in this documentation. >>
+
+   type M128 is private;   --  SSE >= 1
+   type M128d is private;  --  SSE >= 2
+   type M128i is private;  --  SSE >= 2
+
+private
+
+   --  GCC'wise, vector operations operate on objects of vector modes,
+   --  conveyed through vector types obtained by setting an attribute on what
+   --  looks like a component typedef.  For example, in C (xmmintrin.h):
+   --
+   --    typedef float __v4sf __attribute__ ((__vector_size__ (16)));
+
+   --  We can obtain the same low level GCC effect in Ada with
+   --  Machine_Attribute pragmas, as in
+   --
+   --    type Vf is new Float;
+   --    pragma Machine_Attribute (Vf,  "vector_size", 16);
+   --
+   --  which makes Vf a 16bytes long V4SFmode type for GCC. The effect on the
+   --  type layout is not conveyed to the front-end, however, so the latter
+   --  still sees "Vf" as a 4bytes long single float. This leads to numerous
+   --  potential pitfalls if this type is directly exposed user land, so we
+   --  add wrapper records with rep clauses to compensate.
+
+   --  The wrapper records all have a single component of the twisted low
+   --  level type, so they inherit the mode while the rep clauses convey the
+   --  size and alignment information to the front-end.
+
+   ------------
+   --  M128  --
+   ------------
+
+   --  << The __m128 data type can hold four 32-bit floating-point values. >>
+
+   type V4sf is new Float32;
+   pragma Machine_Attribute (V4sf, "vector_size", VECTOR_BYTES);
+
+   type M128 is record
+      Value : V4sf;
+   end record;
+   for M128'Size use VECTOR_BYTES * 8;
+   for M128'Alignment use VECTOR_ALIGN;
+
+   -------------
+   --  M128d  --
+   -------------
+
+   --  << The __m128d data type can hold two 64-bit floating-point values. >>
+
+   type V2df is new Float64;
+   pragma Machine_Attribute (V2df, "vector_size", VECTOR_BYTES);
+
+   type M128d is record
+      Value : V2df;
+   end record;
+   for M128d'Size use VECTOR_BYTES * 8;
+   for M128d'Alignment use VECTOR_ALIGN;
+
+   -------------
+   --  M128i  --
+   -------------
+
+   --  << The __m128i data type can hold sixteen 8-bit, eight 16-bit, four
+   --     32-bit, or two 64-bit integer values. >>
+
+   type V2di is new Integer64;
+   pragma Machine_Attribute (V2di, "vector_size", VECTOR_BYTES);
+
+   type M128i is record
+      Value : V2di;
+   end record;
+   for M128i'Size use VECTOR_BYTES * 8;
+   for M128i'Alignment use VECTOR_ALIGN;
+
+end GNAT.SSE.Vector_Types;

gcc/ada/gcc-interface/Makefile.in

@@ -1052,6 +1052,7 @@ ifeq ($(strip $(filter-out %86 linux%,$(arch) $(osys))),)
     endif
 
     THREADSLIB = -lpthread
+    EXTRA_GNATRTL_NONTASKING_OBJS=g-sse.o g-ssvety.o
     EXTRA_GNATRTL_TASKING_OBJS=s-linux.o
   endif
 
@@ -1591,7 +1592,8 @@ ifeq ($(strip $(filter-out cygwin32% mingw32% pe,$(osys))),)
         system.ads<system-mingw.ads
     endif
 
-    EXTRA_GNATRTL_NONTASKING_OBJS = s-win32.o s-winext.o g-regist.o
+    EXTRA_GNATRTL_NONTASKING_OBJS = \
+	s-win32.o s-winext.o g-regist.o g-sse.o g-ssvety.o
     EXTRA_GNATRTL_TASKING_OBJS = a-exetim.o
 
     MISCLIB = -lws2_32
@@ -2001,6 +2003,7 @@ ifeq ($(strip $(filter-out %x86_64 linux%,$(arch) $(osys))),)
     mlib-tgt-specific.adb<mlib-tgt-specific-linux.adb \
     indepsw.adb<indepsw-gnu.adb
 
+  EXTRA_GNATRTL_NONTASKING_OBJS=g-sse.o g-ssvety.o
   EXTRA_GNATRTL_TASKING_OBJS=s-linux.o
   EH_MECHANISM=-gcc
   THREADSLIB=-lpthread

gcc/ada/impunit.adb

@@ -275,6 +275,8 @@ package body Impunit is
      "g-sptavs",    -- GNAT.Spitbol.Table_Vstring
      "g-string",    -- GNAT.Strings
      "g-strspl",    -- GNAT.String_Split
+     "g-sse   ",    -- GNAT.SSE
+     "g-ssvety",    -- GNAT.SSE.Vector_Types
      "g-table ",    -- GNAT.Table
      "g-tasloc",    -- GNAT.Task_Lock
      "g-thread",    -- GNAT.Threads

gcc/ada/s-win32.ads

@@ -6,7 +6,7 @@
 --                                                                          --
 --                                 S p e c                                  --
 --                                                                          --
---            Copyright (C) 2009, Free Software Foundation, Inc.            --
+--         Copyright (C) 2008-2009, 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- --
@@ -52,7 +52,7 @@ package System.Win32 is
 
    subtype PVOID is Address;
 
-   type HANDLE is new Interfaces.C.long;
+   type HANDLE is new Interfaces.C.ptrdiff_t;
 
    INVALID_HANDLE_VALUE : constant HANDLE := -1;
 

gcc/ada/sem_ch10.adb

@@ -3829,11 +3829,14 @@ package body Sem_Ch10 is
       --  immediately visible.
 
       --  Find entity for compilation unit, and set its private descendant
-      --  status as needed.
+      --  status as needed. Indicate that it is a compilation unit, which is
+      --  redundant in general, but needed if this is a generated child spec
+      --  for a child body without previous spec.
 
       E_Name := Defining_Entity (Lib_Unit);
 
       Set_Is_Child_Unit (E_Name);
+      Set_Is_Compilation_Unit (E_Name);
 
       Set_Is_Private_Descendant (E_Name,
          Is_Private_Descendant (P_Name)

gcc/ada/sem_ch6.adb

@@ -583,15 +583,19 @@ package body Sem_Ch6 is
                Error_Msg_N ("must use anonymous access type", Subtype_Ind);
             end if;
 
-         --  Subtype indication case: check that the types are the same, and
-         --  statically match if appropriate. Also handle record types with
-         --  unknown discriminants for which we have built the underlying
-         --  record view.
-
-         elsif Base_Type (R_Stm_Type) = Base_Type (R_Type)
+         --  Subtype indication case: check that the return object's type is
+         --  covered by the result type, and that the subtypes statically match
+         --  when the result subtype is constrained. Also handle record types
+         --  with unknown discriminants for which we have built the underlying
+         --  record view. Coverage is needed to allow specific-type return
+         --  objects when the result type is class-wide (see AI05-32).
+
+         elsif Covers (Base_Type (R_Type), Base_Type (R_Stm_Type))
            or else (Is_Underlying_Record_View (Base_Type (R_Stm_Type))
-                      and then Underlying_Record_View (Base_Type (R_Stm_Type))
-                                 = Base_Type (R_Type))
+                      and then
+                        Covers
+                          (Base_Type (R_Type),
+                           Underlying_Record_View (Base_Type (R_Stm_Type))))
          then
             --  A null exclusion may be present on the return type, on the
             --  function specification, on the object declaration or on the
@@ -616,31 +620,6 @@ package body Sem_Ch6 is
                end if;
             end if;
 
-         --  If the function's result type doesn't match the return object
-         --  entity's type, then we check for the case where the result type
-         --  is class-wide, and allow the declaration if the type of the object
-         --  definition matches the class-wide type. This prevents rejection
-         --  in the case where the object declaration is initialized by a call
-         --  to a build-in-place function with a specific result type and the
-         --  object entity had its type changed to that specific type. This is
-         --  also allowed in the case where Obj_Decl does not come from source,
-         --  which can occur for an expansion of a simple return statement of
-         --  a build-in-place class-wide function when the result expression
-         --  has a specific type, because a return object with a specific type
-         --  is created. (Note that the ARG believes that return objects should
-         --  be allowed to have a type covered by a class-wide result type in
-         --  any case, so once that relaxation is made (see AI05-32), the above
-         --  check for type compatibility should be changed to test Covers
-         --  rather than equality, and the following special test will no
-         --  longer be needed. ???)
-
-         elsif Is_Class_Wide_Type (R_Type)
-           and then
-             (R_Type = Etype (Object_Definition (Original_Node (Obj_Decl)))
-               or else not Comes_From_Source (Obj_Decl))
-         then
-            null;
-
          elsif Etype (Base_Type (R_Type)) = R_Stm_Type
            and then Is_Null_Extension (Base_Type (R_Type))
          then

gcc/ada/sinfo.adb

@@ -1027,7 +1027,8 @@ package body Sinfo is
       pragma Assert (False
         or else NT (N).Nkind in N_Has_Entity
         or else NT (N).Nkind = N_Freeze_Entity
-        or else NT (N).Nkind = N_Attribute_Definition_Clause);
+        or else NT (N).Nkind = N_Attribute_Definition_Clause
+        or else NT (N).Nkind = N_Null_Statement);
       return Node4 (N);
    end Entity;
 
@@ -1703,6 +1704,14 @@ package body Sinfo is
       return Flag7 (N);
    end Is_Protected_Subprogram_Body;
 
+   function Is_Scil_Node
+      (N : Node_Id) return Boolean is
+   begin
+      pragma Assert (False
+        or else NT (N).Nkind = N_Null_Statement);
+      return Flag4 (N);
+   end Is_Scil_Node;
+
    function Is_Static_Coextension
       (N : Node_Id) return Boolean is
    begin
@@ -2533,6 +2542,30 @@ package body Sinfo is
       return Flag18 (N);
    end Rounded_Result;
 
+   function Scil_Nkind
+      (N : Node_Id) return Uint is
+   begin
+      pragma Assert (False
+        or else NT (N).Nkind = N_Null_Statement);
+      return Uint3 (N);
+   end Scil_Nkind;
+
+   function Scil_Related_Node
+      (N : Node_Id) return Node_Id is
+   begin
+      pragma Assert (False
+        or else NT (N).Nkind = N_Null_Statement);
+      return Node1 (N);
+   end Scil_Related_Node;
+
+   function Scil_Target_Prim
+      (N : Node_Id) return Node_Id is
+   begin
+      pragma Assert (False
+        or else NT (N).Nkind = N_Null_Statement);
+      return Node2 (N);
+   end Scil_Target_Prim;
+
    function Scope
       (N : Node_Id) return Node_Id is
    begin
@@ -3850,7 +3883,8 @@ package body Sinfo is
       pragma Assert (False
         or else NT (N).Nkind in N_Has_Entity
         or else NT (N).Nkind = N_Freeze_Entity
-        or else NT (N).Nkind = N_Attribute_Definition_Clause);
+        or else NT (N).Nkind = N_Attribute_Definition_Clause
+        or else NT (N).Nkind = N_Null_Statement);
       Set_Node4 (N, Val); -- semantic field, no parent set
    end Set_Entity;
 
@@ -4517,6 +4551,14 @@ package body Sinfo is
       Set_Flag7 (N, Val);
    end Set_Is_Protected_Subprogram_Body;
 
+   procedure Set_Is_Scil_Node
+      (N : Node_Id; Val : Boolean := True) is
+   begin
+      pragma Assert (False
+        or else NT (N).Nkind = N_Null_Statement);
+      Set_Flag4 (N, Val);
+   end Set_Is_Scil_Node;
+
    procedure Set_Is_Static_Coextension
       (N : Node_Id; Val : Boolean := True) is
    begin
@@ -5347,6 +5389,30 @@ package body Sinfo is
       Set_Flag18 (N, Val);
    end Set_Rounded_Result;
 
+   procedure Set_Scil_Nkind
+      (N : Node_Id; Val : Uint) is
+   begin
+      pragma Assert (False
+        or else NT (N).Nkind = N_Null_Statement);
+      Set_Uint3 (N, Val);
+   end Set_Scil_Nkind;
+
+   procedure Set_Scil_Related_Node
+      (N : Node_Id; Val : Node_Id) is
+   begin
+      pragma Assert (False
+        or else NT (N).Nkind = N_Null_Statement);
+      Set_Node1 (N, Val);
+   end Set_Scil_Related_Node;
+
+   procedure Set_Scil_Target_Prim
+      (N : Node_Id; Val : Node_Id) is
+   begin
+      pragma Assert (False
+        or else NT (N).Nkind = N_Null_Statement);
+      Set_Node2 (N, Val);
+   end Set_Scil_Target_Prim;
+
    procedure Set_Scope
       (N : Node_Id; Val : Node_Id) is
    begin

gcc/ada/sinfo.ads

@@ -3836,6 +3836,11 @@ package Sinfo is
 
       --  N_Null_Statement
       --  Sloc points to NULL
+      --  Is_Scil_Node (Flag4-Sem)
+      --  Scil_Nkind (Uint3-Sem)
+      --  Scil_Related_Node (Node1-Sem)
+      --  Entity (Node4-Sem)
+      --  Scil_Target_Prim (Node2-Sem)
 
       ----------------
       -- 5.1  Label --
@@ -8052,6 +8057,9 @@ package Sinfo is
    function Is_Protected_Subprogram_Body
      (N : Node_Id) return Boolean;    -- Flag7
 
+   function Is_Scil_Node
+     (N : Node_Id) return Boolean;    -- Flag4
+
    function Is_Static_Coextension
      (N : Node_Id) return Boolean;    -- Flag14
 
@@ -8307,6 +8315,15 @@ package Sinfo is
    function Rounded_Result
      (N : Node_Id) return Boolean;    -- Flag18
 
+   function Scil_Nkind
+      (N : Node_Id) return Uint;      -- Uint3
+
+   function Scil_Related_Node
+     (N : Node_Id) return Node_Id;    -- Node1
+
+   function Scil_Target_Prim
+     (N : Node_Id) return Node_Id;    -- Node2
+
    function Scope
      (N : Node_Id) return Node_Id;    -- Node3
 
@@ -8949,6 +8966,9 @@ package Sinfo is
    procedure Set_Is_Protected_Subprogram_Body
      (N : Node_Id; Val : Boolean := True);    -- Flag7
 
+   procedure Set_Is_Scil_Node
+     (N : Node_Id; Val : Boolean := True);    -- Flag4
+
    procedure Set_Is_Static_Coextension
      (N : Node_Id; Val : Boolean := True);    -- Flag14
 
@@ -9204,6 +9224,15 @@ package Sinfo is
    procedure Set_Rounded_Result
      (N : Node_Id; Val : Boolean := True);    -- Flag18
 
+   procedure Set_Scil_Nkind
+      (N : Node_Id; Val : Uint);              -- Uint3
+
+   procedure Set_Scil_Related_Node
+     (N : Node_Id; Val : Node_Id);            -- Node1
+
+   procedure Set_Scil_Target_Prim
+     (N : Node_Id; Val : Node_Id);            -- Node2
+
    procedure Set_Scope
      (N : Node_Id; Val : Node_Id);            -- Node3
 
@@ -11144,6 +11173,7 @@ package Sinfo is
    pragma Inline (Is_Overloaded);
    pragma Inline (Is_Power_Of_2_For_Shift);
    pragma Inline (Is_Protected_Subprogram_Body);
+   pragma Inline (Is_Scil_Node);
    pragma Inline (Is_Static_Coextension);
    pragma Inline (Is_Static_Expression);
    pragma Inline (Is_Subprogram_Descriptor);
@@ -11229,6 +11259,9 @@ package Sinfo is
    pragma Inline (Reverse_Present);
    pragma Inline (Right_Opnd);
    pragma Inline (Rounded_Result);
+   pragma Inline (Scil_Nkind);
+   pragma Inline (Scil_Related_Node);
+   pragma Inline (Scil_Target_Prim);
    pragma Inline (Scope);
    pragma Inline (Select_Alternatives);
    pragma Inline (Selector_Name);
@@ -11439,6 +11472,7 @@ package Sinfo is
    pragma Inline (Set_Is_Overloaded);
    pragma Inline (Set_Is_Power_Of_2_For_Shift);
    pragma Inline (Set_Is_Protected_Subprogram_Body);
+   pragma Inline (Set_Is_Scil_Node);
    pragma Inline (Set_Has_Self_Reference);
    pragma Inline (Set_Is_Static_Coextension);
    pragma Inline (Set_Is_Static_Expression);
@@ -11524,6 +11558,9 @@ package Sinfo is
    pragma Inline (Set_Reverse_Present);
    pragma Inline (Set_Right_Opnd);
    pragma Inline (Set_Rounded_Result);
+   pragma Inline (Set_Scil_Nkind);
+   pragma Inline (Set_Scil_Related_Node);
+   pragma Inline (Set_Scil_Target_Prim);
    pragma Inline (Set_Scope);
    pragma Inline (Set_Select_Alternatives);
    pragma Inline (Set_Selector_Name);