@@ -682,12 +682,16 @@ package body Exp_Prag is
Init_Val : Node_Id) return Node_Id;
-- Build an object declaration of the form
--
- -- Decl_Id : CUDA.Vectory_Types.Dim3 := Val;
+ -- Decl_Id : CUDA.Internal.Dim3 := Val;
--
-- Val depends on the nature of Init_Val, as follows:
--
- -- * If Init_Val is already of type CUDA.Vector_Types.Dim3, then
- -- Init_Val is used.
+ -- * If Init_Val is of type CUDA.Vector_Types.Dim3, then Val has the
+ -- following form:
+ --
+ -- (Interfaces.C.Unsigned (Val.X),
+ -- Interfaces.C.Unsigned (Val.Y),
+ -- Interfaces.C.Unsigned (Val.Z))
--
-- * If Init_Val is a single Integer, Val has the following form:
--
@@ -729,8 +733,8 @@ package body Exp_Prag is
(Decl_Id : Entity_Id;
Init_Val : Node_Id) return Node_Id;
-- Builds a declaration the Defining_Identifier of which is Decl_Id, the
- -- type of which is CUDA.Driver_Types.Stream_T and the value of which is
- -- Init_Val if present or null if not.
+ -- type of which is inferred from CUDA.Internal.Launch_Kernel and the
+ -- value of which is Init_Val if present or null if not.
function Build_Simple_Declaration_With_Default
(Decl_Id : Entity_Id;
@@ -748,9 +752,10 @@ package body Exp_Prag is
-- type of which is Integer, the value of which is Init_Val if present
-- and 0 otherwise.
- function Get_Launch_Kernel_Arg_Type (N : Positive) return Entity_Id;
- -- Returns the type of the Nth argument of the Launch_Kernel CUDA
- -- runtime function.
+ function Get_Nth_Arg_Type
+ (Subprogram : Entity_Id;
+ N : Positive) return Entity_Id;
+ -- Returns the type of the Nth argument of Subprogram.
function To_Addresses (Elmts : Elist_Id) return List_Id;
-- Returns a new list containing each element of Elmts wrapped in an
@@ -792,57 +797,81 @@ package body Exp_Prag is
(Decl_Id : Entity_Id;
Init_Val : Node_Id) return Node_Id
is
- Grid_Dim_X : Node_Id;
- Grid_Dim_Y : Node_Id;
- Grid_Dim_Z : Node_Id;
- Init_Value : Node_Id;
+ -- Expressions for each component of the returned Dim3
+ Dim_X : Node_Id;
+ Dim_Y : Node_Id;
+ Dim_Z : Node_Id;
+
+ -- Type of CUDA.Internal.Dim3 - inferred from
+ -- RE_Push_Call_Configuration to avoid needing changes in GNAT when
+ -- the CUDA bindings change (this happens frequently).
+ Internal_Dim3 : constant Entity_Id :=
+ Get_Nth_Arg_Type (RTE (RE_Push_Call_Configuration), 1);
+
+ -- Entities for each component of external and internal Dim3
+ First_Component : Entity_Id := First_Entity (RTE (RE_Dim3));
+ Second_Component : Entity_Id := Next_Entity (First_Component);
+ Third_Component : Entity_Id := Next_Entity (Second_Component);
begin
+
+ -- Sem_prag.adb ensured that Init_Val is either a Dim3, an
+ -- aggregate of three Any_Integers or Any_Integer.
+
+ -- If Init_Val is a Dim3, use each of its components.
+
if Etype (Init_Val) = RTE (RE_Dim3) then
- Init_Value := Init_Val;
+ Dim_X := Make_Selected_Component (Loc,
+ Prefix => New_Occurrence_Of (Entity (Init_Val), Loc),
+ Selector_Name => New_Occurrence_Of (First_Component, Loc));
+
+ Dim_Y := Make_Selected_Component (Loc,
+ Prefix => New_Occurrence_Of (Entity (Init_Val), Loc),
+ Selector_Name => New_Occurrence_Of (Second_Component, Loc));
+
+ Dim_Z := Make_Selected_Component (Loc,
+ Prefix => New_Occurrence_Of (Entity (Init_Val), Loc),
+ Selector_Name => New_Occurrence_Of (Third_Component, Loc));
else
-- If Init_Val is an aggregate, use each of its arguments
if Nkind (Init_Val) = N_Aggregate then
- Grid_Dim_X := First (Expressions (Init_Val));
- Grid_Dim_Y := Next (Grid_Dim_X);
- Grid_Dim_Z := Next (Grid_Dim_Y);
+ Dim_X := First (Expressions (Init_Val));
+ Dim_Y := Next (Dim_X);
+ Dim_Z := Next (Dim_Y);
-- Otherwise, we know it is an integer and the rest defaults to 1.
else
- Grid_Dim_X := Init_Val;
- Grid_Dim_Y := Make_Integer_Literal (Loc, 1);
- Grid_Dim_Z := Make_Integer_Literal (Loc, 1);
+ Dim_X := Init_Val;
+ Dim_Y := Make_Integer_Literal (Loc, 1);
+ Dim_Z := Make_Integer_Literal (Loc, 1);
end if;
-
- -- Then cast every value to Interfaces.C.Unsigned and build an
- -- aggregate we can use to initialize the Dim3.
-
- Init_Value :=
- Make_Aggregate (Loc,
- Expressions => New_List (
- Make_Type_Conversion (Loc,
- Subtype_Mark =>
- New_Occurrence_Of (RTE (RO_IC_Unsigned), Loc),
- Expression => New_Copy_Tree (Grid_Dim_X)),
-
- Make_Type_Conversion (Loc,
- Subtype_Mark =>
- New_Occurrence_Of (RTE (RO_IC_Unsigned), Loc),
- Expression => New_Copy_Tree (Grid_Dim_Y)),
-
- Make_Type_Conversion (Loc,
- Subtype_Mark =>
- New_Occurrence_Of (RTE (RO_IC_Unsigned), Loc),
- Expression => New_Copy_Tree (Grid_Dim_Z))));
end if;
- -- Finally return the declaration
+ First_Component := First_Entity (Internal_Dim3);
+ Second_Component := Next_Entity (First_Component);
+ Third_Component := Next_Entity (Second_Component);
+
+ -- Finally return the CUDA.Internal.Dim3 declaration with an
+ -- aggregate initialization expression.
return Make_Object_Declaration (Loc,
Defining_Identifier => Decl_Id,
- Object_Definition => New_Occurrence_Of (RTE (RE_Dim3), Loc),
- Expression => Init_Value);
+ Object_Definition => New_Occurrence_Of (Internal_Dim3, Loc),
+ Expression => Make_Aggregate (Loc,
+ Expressions => New_List (
+ Make_Type_Conversion (Loc,
+ Subtype_Mark =>
+ New_Occurrence_Of (Etype (First_Component), Loc),
+ Expression => New_Copy_Tree (Dim_X)),
+ Make_Type_Conversion (Loc,
+ Subtype_Mark =>
+ New_Occurrence_Of (Etype (Second_Component), Loc),
+ Expression => New_Copy_Tree (Dim_Y)),
+ Make_Type_Conversion (Loc,
+ Subtype_Mark =>
+ New_Occurrence_Of (Etype (Third_Component), Loc),
+ Expression => New_Copy_Tree (Dim_Z)))));
end Build_Dim3_Declaration;
-----------------------------------
@@ -914,7 +943,8 @@ package body Exp_Prag is
(Decl_Id => Decl_Id,
Init_Val => Init_Val,
Typ =>
- New_Occurrence_Of (Get_Launch_Kernel_Arg_Type (5), Loc),
+ New_Occurrence_Of
+ (Get_Nth_Arg_Type (RTE (RE_Launch_Kernel), 5), Loc),
Default_Val => Make_Integer_Literal (Loc, 0));
end Build_Shared_Memory_Declaration;
@@ -953,23 +983,27 @@ package body Exp_Prag is
(Decl_Id => Decl_Id,
Init_Val => Init_Val,
Typ =>
- New_Occurrence_Of (Get_Launch_Kernel_Arg_Type (6), Loc),
+ New_Occurrence_Of
+ (Get_Nth_Arg_Type (RTE (RE_Launch_Kernel), 6), Loc),
Default_Val => Make_Null (Loc));
end Build_Stream_Declaration;
- --------------------------------
- -- Get_Launch_Kernel_Arg_Type --
- --------------------------------
+ ----------------------
+ -- Get_Nth_Arg_Type --
+ ----------------------
- function Get_Launch_Kernel_Arg_Type (N : Positive) return Entity_Id is
- Argument : Entity_Id := First_Entity (RTE (RE_Launch_Kernel));
+ function Get_Nth_Arg_Type
+ (Subprogram : Entity_Id;
+ N : Positive) return Entity_Id
+ is
+ Argument : Entity_Id := First_Entity (Subprogram);
begin
for J in 2 .. N loop
Argument := Next_Entity (Argument);
end loop;
return Etype (Argument);
- end Get_Launch_Kernel_Arg_Type;
+ end Get_Nth_Arg_Type;
------------------
-- To_Addresses --
@@ -1005,13 +1039,30 @@ package body Exp_Prag is
Shared_Memory : constant Node_Id := Get_Pragma_Arg (Arg_N (N, 4));
CUDA_Stream : constant Node_Id := Get_Pragma_Arg (Arg_N (N, 5));
- -- Entities of objects that capture the value of pragma arguments
-
+ -- Entities of objects that will be overwritten by calls to cuda runtime
Grids_Id : constant Entity_Id := Make_Temporary (Loc, 'C');
Blocks_Id : constant Entity_Id := Make_Temporary (Loc, 'C');
Memory_Id : constant Entity_Id := Make_Temporary (Loc, 'C');
Stream_Id : constant Entity_Id := Make_Temporary (Loc, 'C');
+ -- Entities of objects that capture the value of pragma arguments
+ Temp_Grid : constant Entity_Id := Make_Temporary (Loc, 'C');
+ Temp_Block : constant Entity_Id := Make_Temporary (Loc, 'C');
+
+ -- Declarations for temporary block and grids. These needs to be stored
+ -- in temporary declarations as the expressions will need to be
+ -- referenced multiple times but could have side effects.
+ Temp_Grid_Decl : constant Node_Id := Make_Object_Declaration (Loc,
+ Defining_Identifier => Temp_Grid,
+ Object_Definition =>
+ New_Occurrence_Of (Etype (Grid_Dimensions), Loc),
+ Expression => Grid_Dimensions);
+ Temp_Block_Decl : constant Node_Id := Make_Object_Declaration (Loc,
+ Defining_Identifier => Temp_Block,
+ Object_Definition =>
+ New_Occurrence_Of (Etype (Block_Dimensions), Loc),
+ Expression => Block_Dimensions);
+
-- List holding the entities of the copies of Procedure_Call's
-- arguments.
@@ -1035,14 +1086,25 @@ package body Exp_Prag is
-- Start of processing for CUDA_Execute
begin
+ -- Append temporary declarations
+
+ Append_To (Blk_Decls, Temp_Grid_Decl);
+ Analyze (Temp_Grid_Decl);
+
+ Append_To (Blk_Decls, Temp_Block_Decl);
+ Analyze (Temp_Block_Decl);
+
-- Build parameter declarations for CUDA API calls
Append_To
- (Blk_Decls, Build_Dim3_Declaration (Grids_Id, Grid_Dimensions));
+ (Blk_Decls,
+ Build_Dim3_Declaration
+ (Grids_Id, New_Occurrence_Of (Temp_Grid, Loc)));
Append_To
(Blk_Decls,
- Build_Dim3_Declaration (Blocks_Id, Block_Dimensions));
+ Build_Dim3_Declaration
+ (Blocks_Id, New_Occurrence_Of (Temp_Block, Loc)));
Append_To
(Blk_Decls,
@@ -709,14 +709,13 @@ package Rtsfind is
RE_Stream_T, -- CUDA.Driver_Types
RE_Fatbin_Wrapper, -- CUDA.Internal
- RE_Push_Call_Configuration, -- CUDA.Internal
+ RE_Launch_Kernel, -- CUDA.Internal
RE_Pop_Call_Configuration, -- CUDA.Internal
+ RE_Push_Call_Configuration, -- CUDA.Internal
RE_Register_Fat_Binary, -- CUDA.Internal
RE_Register_Fat_Binary_End, -- CUDA.Internal
RE_Register_Function, -- CUDA.Internal
- RE_Launch_Kernel, -- CUDA.Runtime_Api
-
RE_Dim3, -- CUDA.Vector_Types
RE_Integer_8, -- Interfaces
@@ -2357,14 +2356,13 @@ package Rtsfind is
RE_Stream_T => CUDA_Driver_Types,
RE_Fatbin_Wrapper => CUDA_Internal,
- RE_Push_Call_Configuration => CUDA_Internal,
+ RE_Launch_Kernel => CUDA_Internal,
RE_Pop_Call_Configuration => CUDA_Internal,
+ RE_Push_Call_Configuration => CUDA_Internal,
RE_Register_Fat_Binary => CUDA_Internal,
RE_Register_Fat_Binary_End => CUDA_Internal,
RE_Register_Function => CUDA_Internal,
- RE_Launch_Kernel => CUDA_Runtime_Api,
-
RE_Dim3 => CUDA_Vector_Types,
RE_Integer_8 => Interfaces,