Commit 4b956d8b by Arnaud Charlet

[multiple changes]

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

	* g-ssinty.ads: New unit. GNAT.SSE.Internal_Types. Factorize
	low level internal type definitions for distinct higher level
	binding development activities (user type definitions and
	operations).
	* gnat_rm.texi: Document it.
	* g-ssvety.ads: Use it.
	* gcc-interface/Makefile.in: (x86 32/64 linux, cygwin32 sections): Add
	g-ssinty.o to EXTRA_GNATRTL_NONTASKING_OBJS.
	* gcc-interface/utils.c (gnat_internal_attribute_table): Add entry
	for the "may_alias" attribute.

2009-07-23  Thomas Quinot  <quinot@adacore.com>

	* scos.ads: Minor typo fix
	* gcc-interface/decl.c (validate_alignment): For the case of an
	implicit array base type, look for alignment clause on first subtype.
	Code clean up.

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

	* sem.adb (Walk_Library_Units): Handle properly the case where a unit
	in the context depends on the spec of the main unit, by delaying
	processing of the main unit body until all other units have been
	processed.

From-SVN: r149993
parent f8c6086b
2009-07-23 Olivier Hainque <hainque@adacore.com>
* g-ssinty.ads: New unit. GNAT.SSE.Internal_Types. Factorize
low level internal type definitions for distinct higher level
binding development activities (user type definitions and
operations).
* gnat_rm.texi: Document it.
* g-ssvety.ads: Use it.
* gcc-interface/Makefile.in: (x86 32/64 linux, cygwin32 sections): Add
g-ssinty.o to EXTRA_GNATRTL_NONTASKING_OBJS.
* gcc-interface/utils.c (gnat_internal_attribute_table): Add entry
for the "may_alias" attribute.
2009-07-23 Thomas Quinot <quinot@adacore.com>
* scos.ads: Minor typo fix
* gcc-interface/decl.c (validate_alignment): For the case of an
implicit array base type, look for alignment clause on first subtype.
Code clean up.
2009-07-23 Ed Schonberg <schonberg@adacore.com>
* sem.adb (Walk_Library_Units): Handle properly the case where a unit
in the context depends on the spec of the main unit, by delaying
processing of the main unit body until all other units have been
processed.
2009-07-23 Arnaud Charlet <charlet@adacore.com> 2009-07-23 Arnaud Charlet <charlet@adacore.com>
* a-convec.adb: Add comments about suspicious/subtle code. * a-convec.adb: Add comments about suspicious/subtle code.
......
------------------------------------------------------------------------------
-- --
-- GNAT COMPILER COMPONENTS --
-- --
-- G N A T . S S E . I N T E R N A L _ 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 low level types to interface with the GCC vector
-- builtins directly. These are useful for the development of higher level
-- bindings to the reference Intel intrinsic operations.
-- See GNAT.SSE for the list of targets where this facility is supported.
package GNAT.SSE.Internal_Types is
type v4sf is private;
type v2df is private;
type v2di is private;
private
-- GCC'wise, vector operations operate on objects of vector modes,
-- conveyed through vector types obtained in C by setting an attribute on
-- what looks like a component typedef. For example, in xmmintrin.h:
--
-- typedef float __v4sf __attribute__ ((__vector_size__ (16)));
-- Applying a 'vector_size' machine attribute in Ada, as in
--
-- type Vf is new Float;
-- pragma Machine_Attribute (Vf, "vector_size", 16);
--
-- makes Vf a 16bytes long V4SFmode GCC type but the effect on the type
-- layout is not conveyed to the front-end. The latter still sees "Vf"
-- as a 4bytes long single float, with numerous potential pitfalls.
-- We devised a 'vector_type' alternate machine attribute, which applies
-- to array types of the proper size and alignment from the front-end
-- perspective:
type v4sf is array (1 .. 4) of GNAT.SSE.Float32;
for v4sf'Alignment use GNAT.SSE.VECTOR_ALIGN;
pragma Machine_Attribute (v4sf, "vector_type");
type v2di is array (1 .. 2) of GNAT.SSE.Integer64;
for v2di'Alignment use GNAT.SSE.VECTOR_ALIGN;
pragma Machine_Attribute (v2di, "vector_type");
type v2df is array (1 .. 2) of GNAT.SSE.Float64;
for v2df'Alignment use GNAT.SSE.VECTOR_ALIGN;
pragma Machine_Attribute (v2df, "vector_type");
end GNAT.SSE.Internal_Types;
...@@ -30,7 +30,9 @@ ...@@ -30,7 +30,9 @@
------------------------------------------------------------------------------ ------------------------------------------------------------------------------
-- This unit exposes the Ada __m128 like data types to represent the contents -- This unit exposes the Ada __m128 like data types to represent the contents
-- of SSE registers, for use by the SSE intrinsics. -- of SSE registers, for use by bindings to the SSE intrinsic operations.
-- See GNAT.SSE for the list of targets where this facility is supported.
package GNAT.SSE.Vector_Types is package GNAT.SSE.Vector_Types is
...@@ -49,32 +51,23 @@ package GNAT.SSE.Vector_Types is ...@@ -49,32 +51,23 @@ package GNAT.SSE.Vector_Types is
-- * Use new data types only with the respective intrinsics described -- * Use new data types only with the respective intrinsics described
-- in this documentation. >> -- in this documentation. >>
type M128 is private; -- SSE >= 1 type m128 is private; -- SSE >= 1
type M128d is private; -- SSE >= 2 type m128d is private; -- SSE >= 2
type M128i is private; -- SSE >= 2 type m128i is private; -- SSE >= 2
private 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 -- Each of the m128 types maps to a specific vector_type with
-- Machine_Attribute pragmas, as in -- an extra "may_alias" attribute as in GCC's definitions for C,
-- for instance in xmmintrin.h:
-- --
-- type Vf is new Float; -- /* The Intel API is flexible enough that we must allow aliasing
-- pragma Machine_Attribute (Vf, "vector_size", 16); -- with other vector types, and their scalar components. */
-- typedef float __m128
-- __attribute__ ((__vector_size__ (16), __may_alias__));
-- --
-- which makes Vf a 16bytes long V4SFmode type for GCC. The effect on the -- /* Internal data types for implementing the intrinsics. */
-- type layout is not conveyed to the front-end, however, so the latter -- typedef float __v4sf __attribute__ ((__vector_size__ (16)));
-- 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 -- -- M128 --
...@@ -82,44 +75,32 @@ private ...@@ -82,44 +75,32 @@ private
-- << The __m128 data type can hold four 32-bit floating-point values. >> -- << The __m128 data type can hold four 32-bit floating-point values. >>
type V4sf is new Float32; type m128 is array (1 .. 4) of Float32;
pragma Machine_Attribute (V4sf, "vector_size", VECTOR_BYTES); for m128'Alignment use VECTOR_ALIGN;
pragma Machine_Attribute (m128, "vector_type");
type M128 is record pragma Machine_Attribute (m128, "may_alias");
Value : V4sf;
end record;
for M128'Size use VECTOR_BYTES * 8;
for M128'Alignment use VECTOR_ALIGN;
------------- -------------
-- M128d -- -- m128d --
------------- -------------
-- << The __m128d data type can hold two 64-bit floating-point values. >> -- << The __m128d data type can hold two 64-bit floating-point values. >>
type V2df is new Float64; type m128d is array (1 .. 2) of Float64;
pragma Machine_Attribute (V2df, "vector_size", VECTOR_BYTES); for m128d'Alignment use VECTOR_ALIGN;
pragma Machine_Attribute (m128d, "vector_type");
type M128d is record pragma Machine_Attribute (m128d, "may_alias");
Value : V2df;
end record;
for M128d'Size use VECTOR_BYTES * 8;
for M128d'Alignment use VECTOR_ALIGN;
------------- -------------
-- M128i -- -- m128i --
------------- -------------
-- << The __m128i data type can hold sixteen 8-bit, eight 16-bit, four -- << The __m128i data type can hold sixteen 8-bit, eight 16-bit, four
-- 32-bit, or two 64-bit integer values. >> -- 32-bit, or two 64-bit integer values. >>
type V2di is new Integer64; type m128i is array (1 .. 2) of Integer64;
pragma Machine_Attribute (V2di, "vector_size", VECTOR_BYTES); for m128i'Alignment use VECTOR_ALIGN;
pragma Machine_Attribute (m128i, "vector_type");
type M128i is record pragma Machine_Attribute (m128i, "may_alias");
Value : V2di;
end record;
for M128i'Size use VECTOR_BYTES * 8;
for M128i'Alignment use VECTOR_ALIGN;
end GNAT.SSE.Vector_Types; end GNAT.SSE.Vector_Types;
...@@ -1052,7 +1052,7 @@ ifeq ($(strip $(filter-out %86 linux%,$(arch) $(osys))),) ...@@ -1052,7 +1052,7 @@ ifeq ($(strip $(filter-out %86 linux%,$(arch) $(osys))),)
endif endif
THREADSLIB = -lpthread THREADSLIB = -lpthread
EXTRA_GNATRTL_NONTASKING_OBJS=g-sse.o g-ssvety.o EXTRA_GNATRTL_NONTASKING_OBJS=g-sse.o g-ssvety.o g-ssinty.o
EXTRA_GNATRTL_TASKING_OBJS=s-linux.o EXTRA_GNATRTL_TASKING_OBJS=s-linux.o
endif endif
...@@ -1593,7 +1593,7 @@ ifeq ($(strip $(filter-out cygwin32% mingw32% pe,$(osys))),) ...@@ -1593,7 +1593,7 @@ ifeq ($(strip $(filter-out cygwin32% mingw32% pe,$(osys))),)
endif endif
EXTRA_GNATRTL_NONTASKING_OBJS = \ EXTRA_GNATRTL_NONTASKING_OBJS = \
s-win32.o s-winext.o g-regist.o g-sse.o g-ssvety.o s-win32.o s-winext.o g-regist.o g-sse.o g-ssvety.o g-ssinty.o
EXTRA_GNATRTL_TASKING_OBJS = a-exetim.o EXTRA_GNATRTL_TASKING_OBJS = a-exetim.o
MISCLIB = -lws2_32 MISCLIB = -lws2_32
...@@ -2003,7 +2003,7 @@ ifeq ($(strip $(filter-out %x86_64 linux%,$(arch) $(osys))),) ...@@ -2003,7 +2003,7 @@ ifeq ($(strip $(filter-out %x86_64 linux%,$(arch) $(osys))),)
mlib-tgt-specific.adb<mlib-tgt-specific-linux.adb \ mlib-tgt-specific.adb<mlib-tgt-specific-linux.adb \
indepsw.adb<indepsw-gnu.adb indepsw.adb<indepsw-gnu.adb
EXTRA_GNATRTL_NONTASKING_OBJS=g-sse.o g-ssvety.o EXTRA_GNATRTL_NONTASKING_OBJS=g-sse.o g-ssvety.o g-ssinty.o
EXTRA_GNATRTL_TASKING_OBJS=s-linux.o EXTRA_GNATRTL_TASKING_OBJS=s-linux.o
EH_MECHANISM=-gcc EH_MECHANISM=-gcc
THREADSLIB=-lpthread THREADSLIB=-lpthread
......
...@@ -122,6 +122,7 @@ const struct attribute_spec gnat_internal_attribute_table[] = ...@@ -122,6 +122,7 @@ const struct attribute_spec gnat_internal_attribute_table[] =
{ "type generic", 0, 0, false, true, true, handle_type_generic_attribute }, { "type generic", 0, 0, false, true, true, handle_type_generic_attribute },
{ "vector_size", 1, 1, false, true, false, handle_vector_size_attribute }, { "vector_size", 1, 1, false, true, false, handle_vector_size_attribute },
{ "may_alias", 0, 0, false, true, false, NULL },
/* ??? format and format_arg are heavy and not supported, which actually /* ??? format and format_arg are heavy and not supported, which actually
prevents support for stdio builtins, which we however declare as part prevents support for stdio builtins, which we however declare as part
......
...@@ -382,6 +382,7 @@ The GNAT Library ...@@ -382,6 +382,7 @@ The GNAT Library
* GNAT.Spitbol.Table_Integer (g-sptain.ads):: * GNAT.Spitbol.Table_Integer (g-sptain.ads)::
* GNAT.Spitbol.Table_VString (g-sptavs.ads):: * GNAT.Spitbol.Table_VString (g-sptavs.ads)::
* GNAT.SSE (g-sse.ads):: * GNAT.SSE (g-sse.ads)::
* GNAT.SSE.Internal_Types (g-ssinty.ads)::
* GNAT.SSE.Vector_Types (g-ssvety.ads):: * GNAT.SSE.Vector_Types (g-ssvety.ads)::
* GNAT.Strings (g-string.ads):: * GNAT.Strings (g-string.ads)::
* GNAT.String_Split (g-strspl.ads):: * GNAT.String_Split (g-strspl.ads)::
...@@ -13571,6 +13572,7 @@ of GNAT, and will generate a warning message. ...@@ -13571,6 +13572,7 @@ of GNAT, and will generate a warning message.
* GNAT.Spitbol.Table_Integer (g-sptain.ads):: * GNAT.Spitbol.Table_Integer (g-sptain.ads)::
* GNAT.Spitbol.Table_VString (g-sptavs.ads):: * GNAT.Spitbol.Table_VString (g-sptavs.ads)::
* GNAT.SSE (g-sse.ads):: * GNAT.SSE (g-sse.ads)::
* GNAT.SSE.Internal_Types (g-ssinty.ads)::
* GNAT.SSE.Vector_Types (g-ssvety.ads):: * GNAT.SSE.Vector_Types (g-ssvety.ads)::
* GNAT.Strings (g-string.ads):: * GNAT.Strings (g-string.ads)::
* GNAT.String_Split (g-strspl.ads):: * GNAT.String_Split (g-strspl.ads)::
...@@ -14641,6 +14643,15 @@ the Intel(r) Streaming SIMD Extensions with GNAT on the x86 family of ...@@ -14641,6 +14643,15 @@ the Intel(r) Streaming SIMD Extensions with GNAT on the x86 family of
targets. It exposes vector component types together with a general targets. It exposes vector component types together with a general
introduction to the binding contents and use. introduction to the binding contents and use.
@node GNAT.SSE.Internal_Types (g-ssinty.ads)
@section @code{GNAT.SSE.Internal_Types} (@file{g-ssinty.ads})
@cindex @code{GNAT.SSE.Internal_Types} (@file{g-ssinty.ads})
@noindent
Low level GCC vector types for direct use of the vector related
builtins, required for the development of higher level bindings to SSE
intrinsic operations.
@node GNAT.SSE.Vector_Types (g-ssvety.ads) @node GNAT.SSE.Vector_Types (g-ssvety.ads)
@section @code{GNAT.SSE.Vector_Types} (@file{g-ssvety.ads}) @section @code{GNAT.SSE.Vector_Types} (@file{g-ssvety.ads})
@cindex @code{GNAT.SSE.Vector_Types} (@file{g-ssvety.ads}) @cindex @code{GNAT.SSE.Vector_Types} (@file{g-ssvety.ads})
......
...@@ -103,7 +103,7 @@ package SCOs is ...@@ -103,7 +103,7 @@ package SCOs is
-- Statement lines -- Statement lines
-- These lines correspond to a sequence of one or more statements which -- These lines correspond to a sequence of one or more statements which
-- are always exeecuted in sequence, The first statement may be an entry -- are always executed in sequence, The first statement may be an entry
-- point (e.g. statement after a label), and the last statement may be -- point (e.g. statement after a label), and the last statement may be
-- an exit point (e.g. an exit statement), but no other entry or exit -- an exit point (e.g. an exit statement), but no other entry or exit
-- points may occur within the sequence of statements. The idea is that -- points may occur within the sequence of statements. The idea is that
......
...@@ -107,7 +107,6 @@ package body Sem is ...@@ -107,7 +107,6 @@ package body Sem is
procedure Analyze (N : Node_Id) is procedure Analyze (N : Node_Id) is
begin begin
Debug_A_Entry ("analyzing ", N); Debug_A_Entry ("analyzing ", N);
-- Immediate return if already analyzed -- Immediate return if already analyzed
if Analyzed (N) then if Analyzed (N) then
...@@ -1510,6 +1509,12 @@ package body Sem is ...@@ -1510,6 +1509,12 @@ package body Sem is
-- after we have fully processed X, and is used only for debugging -- after we have fully processed X, and is used only for debugging
-- printouts and assertions. -- printouts and assertions.
Do_Main : Boolean := False;
-- Flag to delay processing the main body until after all other units.
-- This is needed because the spec of the main unit may appear in the
-- context of some other unit. We do not want this to force processing
-- of the main body before all other units have been processed.
procedure Do_Action (CU : Node_Id; Item : Node_Id); procedure Do_Action (CU : Node_Id; Item : Node_Id);
-- Calls Action, with some validity checks -- Calls Action, with some validity checks
...@@ -1712,7 +1717,8 @@ package body Sem is ...@@ -1712,7 +1717,8 @@ package body Sem is
if not Nkind_In (Item, N_Package_Body, N_Subprogram_Body) if not Nkind_In (Item, N_Package_Body, N_Subprogram_Body)
or else Acts_As_Spec (CU) or else Acts_As_Spec (CU)
or else CU = Cunit (Main_Unit) or else (CU = Cunit (Main_Unit) and then Do_Main)
then then
Do_Action (CU, Item); Do_Action (CU, Item);
...@@ -1733,14 +1739,47 @@ package body Sem is ...@@ -1733,14 +1739,47 @@ package body Sem is
-- be possible to restrict the list to those bodies that are used -- be possible to restrict the list to those bodies that are used
-- in the main unit. Possible optimization ??? -- in the main unit. Possible optimization ???
-- Such bodies can also appear in a circular dependency list, where
-- spec A depends on spec B and the body of B depends on spec A.
-- This is not an elaboration issue, but body B must be excluded
-- from the processing.
if Nkind (Item) = N_Package_Declaration then if Nkind (Item) = N_Package_Declaration then
declare declare
Body_Unit : constant Node_Id := Library_Unit (CU); Body_Unit : constant Node_Id := Library_Unit (CU);
function Circular_Dependence (B : Node_Id) return Boolean;
-- Check whether this body depends on a spec that is pending,
-- that is to say has been seen but not processed yet.
function Circular_Dependence (B : Node_Id) return Boolean is
Item : Node_Id;
UN : Unit_Number_Type;
begin
Item := First (Context_Items (B));
while Present (Item) loop
if Nkind (Item) = N_With_Clause then
UN := Get_Cunit_Unit_Number (Library_Unit (Item));
if Seen (UN)
and then not Done (UN)
then
return True;
end if;
end if;
Next (Item);
end loop;
return False;
end Circular_Dependence;
begin begin
if Present (Body_Unit) if Present (Body_Unit)
and then Body_Unit /= Cunit (Main_Unit) and then Body_Unit /= Cunit (Main_Unit)
and then Unit_Num /= Get_Source_Unit (System_Aux_Id) and then Unit_Num /= Get_Source_Unit (System_Aux_Id)
and then not Circular_Dependence (Body_Unit)
then then
Do_Unit_And_Dependents (Body_Unit, Unit (Body_Unit)); Do_Unit_And_Dependents (Body_Unit, Unit (Body_Unit));
Do_Action (Body_Unit, Unit (Body_Unit)); Do_Action (Body_Unit, Unit (Body_Unit));
...@@ -1801,16 +1840,13 @@ package body Sem is ...@@ -1801,16 +1840,13 @@ package body Sem is
case Nkind (N) is case Nkind (N) is
-- If it's a body, then ignore it, unless it's the main unit -- If it's a body, ignore it. Bodies appear in the list only
-- Otherwise bodies appear in the list because of inlining or -- because of inlining/instantiations, and they are processed
-- instantiations, and they are processed immediately after -- immediately after the corresponding specs.
-- the corresponding specs. -- The main unit is processed separately after all other units.
when N_Package_Body | N_Subprogram_Body => when N_Package_Body | N_Subprogram_Body =>
null;
if CU = Cunit (Main_Unit) then
Do_Unit_And_Dependents (CU, N);
end if;
-- It's a spec, so just do it -- It's a spec, so just do it
...@@ -1822,6 +1858,11 @@ package body Sem is ...@@ -1822,6 +1858,11 @@ package body Sem is
Next_Elmt (Cur); Next_Elmt (Cur);
end loop; end loop;
if not Done (Main_Unit) then
Do_Main := True;
Do_Unit_And_Dependents (Cunit (Main_Unit), Unit (Cunit (Main_Unit)));
end if;
if Debug_Unit_Walk then if Debug_Unit_Walk then
if Done /= (Done'Range => True) then if Done /= (Done'Range => True) then
Write_Eol; Write_Eol;
......
Markdown is supported
0% or
You are about to add 0 people to the discussion. Proceed with caution.
Finish editing this message first!
Please register or to comment