From d56fbda96a7c34ad897b9cc871242047fe19393c Mon Sep 17 00:00:00 2001 From: Piotr Trojanek Date: Wed, 23 Dec 2020 11:35:19 +0100 Subject: [PATCH] [Ada] Code and style cleanups for CUDA gcc/ada/ * exp_prag.adb (Expand_Pragma_CUDA_Execute): Refill comments; remove periods after single-line comments; use procedural variant of Next_Entity. * gnat_cuda.adb: Refill comments; remove periods after single-line comments; replace calls to UI_From_Int with constants; change iteration bounds so they match the comments. * sem_prag.adb (Analyze_Pragma): Add checks for malformed pragma CUDA_Kernel aggregate; simplify processing of pragma CUDA_Global with Check_Arg_Count; sync comment with code for CUDA_Global. --- gcc/ada/exp_prag.adb | 33 ++++++++++++++++----------------- gcc/ada/gnat_cuda.adb | 41 ++++++++++++++++++++--------------------- gcc/ada/sem_prag.adb | 11 ++++++----- 3 files changed, 42 insertions(+), 43 deletions(-) diff --git a/gcc/ada/exp_prag.adb b/gcc/ada/exp_prag.adb index d616fb6..ca1b084 100644 --- a/gcc/ada/exp_prag.adb +++ b/gcc/ada/exp_prag.adb @@ -771,7 +771,7 @@ package body Exp_Prag is function Get_Nth_Arg_Type (Subprogram : Entity_Id; N : Positive) return Entity_Id; - -- Returns the type of the Nth argument of Subprogram. + -- 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 @@ -821,9 +821,9 @@ package body Exp_Prag is Init_Val : Node_Id) return Node_Id is -- Expressions for each component of the returned Dim3 - Dim_X : Node_Id; - Dim_Y : Node_Id; - Dim_Z : Node_Id; + 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 @@ -835,12 +835,13 @@ package body Exp_Prag is 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. + -- 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 Init_Val is a Dim3, use each of its components if Etype (Init_Val) = RTE (RE_Dim3) then Dim_X := Make_Selected_Component (Loc, @@ -862,7 +863,7 @@ package body Exp_Prag is Dim_Y := Next (Dim_X); Dim_Z := Next (Dim_Y); - -- Otherwise, we know it is an integer and the rest defaults to 1. + -- Otherwise, we know it is an integer and the rest defaults to 1 else Dim_X := Init_Val; @@ -1011,14 +1012,13 @@ package body Exp_Prag is Default_Val => Make_Null (Loc)); end Build_Stream_Declaration; - ------------------------ - -- Etype_Or_Dim3 -- - ------------------------ + ------------------- + -- Etype_Or_Dim3 -- + ------------------- function Etype_Or_Dim3 (N : Node_Id) return Node_Id is begin - if Nkind (N) = N_Aggregate and then Is_Composite_Type (Etype (N)) - then + if Nkind (N) = N_Aggregate and then Is_Composite_Type (Etype (N)) then return New_Occurrence_Of (RTE (RE_Dim3), Sloc (N)); end if; @@ -1036,7 +1036,7 @@ package body Exp_Prag is Argument : Entity_Id := First_Entity (Subprogram); begin for J in 2 .. N loop - Argument := Next_Entity (Argument); + Next_Entity (Argument); end loop; return Etype (Argument); @@ -1098,8 +1098,7 @@ package body Exp_Prag is Object_Definition => Etype_Or_Dim3 (Block_Dimensions), Expression => Block_Dimensions); - -- List holding the entities of the copies of Procedure_Call's - -- arguments. + -- List holding the entities of the copies of Procedure_Call's arguments Kernel_Arg_Copies : constant Elist_Id := New_Elmt_List; @@ -1114,7 +1113,7 @@ package body Exp_Prag is Pop_Call : Node_Id; Push_Call : Node_Id; - -- Declaration of all temporaries required for CUDA API Calls. + -- Declaration of all temporaries required for CUDA API Calls Blk_Decls : constant List_Id := New_List; diff --git a/gcc/ada/gnat_cuda.adb b/gcc/ada/gnat_cuda.adb index 39a55e6..6670bb8 100644 --- a/gcc/ada/gnat_cuda.adb +++ b/gcc/ada/gnat_cuda.adb @@ -68,8 +68,8 @@ package body GNAT_CUDA is function Get_CUDA_Kernels (Pack_Id : Entity_Id) return Elist_Id; -- Returns an Elist of all procedures marked with pragma CUDA_Global that - -- are declared within package body Pack_Body. Returns No_Elist if - -- Pack_Id does not contain such procedures. + -- are declared within package body Pack_Body. Returns No_Elist if Pack_Id + -- does not contain such procedures. procedure Set_CUDA_Kernels (Pack_Id : Entity_Id; @@ -249,7 +249,7 @@ package body GNAT_CUDA is -- function. New_Stmt : Node_Id; - -- Temporary variable to hold the various newly-created nodes. + -- Temporary variable to hold the various newly-created nodes Kernel_Elmt : Elmt_Id; Kernel_Id : Entity_Id; @@ -266,8 +266,7 @@ package body GNAT_CUDA is while Present (Kernel_Elmt) loop Kernel_Id := Node (Kernel_Elmt); - New_Stmt := - Build_Kernel_Name_Declaration (Kernel_Id); + New_Stmt := Build_Kernel_Name_Declaration (Kernel_Id); Append (New_Stmt, Pack_Decls); Analyze (New_Stmt); @@ -366,7 +365,7 @@ package body GNAT_CUDA is Make_Aggregate (Loc, Expressions => New_List ( Make_Integer_Literal (Loc, UI_From_Int (16#466243b1#)), - Make_Integer_Literal (Loc, UI_From_Int (1)), + Make_Integer_Literal (Loc, Uint_1), Make_Attribute_Reference (Loc, Prefix => New_Occurrence_Of (Bin_Id, Loc), Attribute_Name => Name_Address), @@ -452,39 +451,39 @@ package body GNAT_CUDA is is Args : constant List_Id := New_List; begin - -- First argument: the handle of the fat binary. + -- First argument: the handle of the fat binary Append (New_Occurrence_Of (Bin, Loc), Args); - -- Second argument: the host address of the function that is - -- marked with CUDA_Global. + -- Second argument: the host address of the function that is marked + -- with CUDA_Global. Append_To (Args, Make_Attribute_Reference (Loc, Prefix => New_Occurrence_Of (Kernel, Loc), Attribute_Name => Name_Address)); - -- Third argument, the name of the function on the host. + -- Third argument, the name of the function on the host Append (New_Occurrence_Of (Kernel_Name, Loc), Args); - -- Fourth argument, the name of the function on the device. + -- Fourth argument, the name of the function on the device Append (New_Occurrence_Of (Kernel_Name, Loc), Args); -- Fith argument: -1. Meaning unknown - this has been copied from -- LLVM. - Append (Make_Integer_Literal (Loc, UI_From_Int (-1)), Args); + Append (Make_Integer_Literal (Loc, Uint_Minus_1), Args); - -- Args 6, 7, 8, 9, 10: Null pointers. Again, meaning unknown. + -- Args 6, 7, 8, 9, 10: Null pointers. Again, meaning unknown - for Arg_Count in 1 .. 5 loop + for Arg_Count in 6 .. 10 loop Append_To (Args, New_Occurrence_Of (RTE (RE_Null_Address), Loc)); end loop; - -- Build the call to CUDARegisterFunction, passing the argument - -- list we just built. + -- Build the call to CUDARegisterFunction, passing the argument list + -- we just built. return Make_Procedure_Call_Statement (Loc, @@ -498,21 +497,21 @@ package body GNAT_CUDA is Loc : constant Source_Ptr := Sloc (N); Spec_Id : constant Node_Id := Corresponding_Spec (N); - -- The specification of the package we're adding a cuda init func to. + -- The specification of the package we're adding a cuda init func to Pack_Decls : constant List_Id := Declarations (N); CUDA_Node_List : constant Elist_Id := Get_CUDA_Kernels (Spec_Id); - -- CUDA nodes that belong to the package. + -- CUDA nodes that belong to the package CUDA_Init_Func : Entity_Id; - -- Entity of the cuda init func. + -- Entity of the cuda init func Fat_Binary : Entity_Id; - -- Entity of the fat binary of N. Bound to said fat binary by a pragma. + -- Entity of the fat binary of N. Bound to said fat binary by a pragma Fat_Binary_Handle : Entity_Id; - -- Entity of the result of passing the fat binary wrapper to. + -- Entity of the result of passing the fat binary wrapper to -- CUDA.Register_Fat_Binary. Fat_Binary_Wrapper : Entity_Id; diff --git a/gcc/ada/sem_prag.adb b/gcc/ada/sem_prag.adb index a1d645e..7647b6d 100644 --- a/gcc/ada/sem_prag.adb +++ b/gcc/ada/sem_prag.adb @@ -14725,6 +14725,8 @@ package body Sem_Prag is end if; if Nkind (N) = N_Aggregate + and then not Null_Record_Present (N) + and then No (Component_Associations (N)) and then List_Length (Expressions (N)) = 3 then Expr := First (Expressions (N)); @@ -14746,7 +14748,7 @@ package body Sem_Prag is Shared_Memory : Node_Id; Stream : Node_Id; - -- Start of processing for CUDA_Execute + -- Start of processing for CUDA_Execute begin GNAT_Pragma; @@ -14755,7 +14757,7 @@ package body Sem_Prag is Analyze_And_Resolve (Kernel_Call); if Nkind (Kernel_Call) /= N_Function_Call - or else Etype (Kernel_Call) /= Standard_Void_Type + or else Etype (Kernel_Call) /= Standard_Void_Type then -- In `pragma CUDA_Execute (Kernel_Call (...), ...)`, -- GNAT sees Kernel_Call as an N_Function_Call since @@ -14796,7 +14798,7 @@ package body Sem_Prag is -- CUDA_Global -- ----------------- - -- pragma CUDA_Global (IDENTIFIER); + -- pragma CUDA_Global ([Entity =>] IDENTIFIER); when Pragma_CUDA_Global => CUDA_Global : declare Arg_Node : Node_Id; @@ -14804,8 +14806,7 @@ package body Sem_Prag is Pack_Id : Entity_Id; begin GNAT_Pragma; - Check_At_Least_N_Arguments (1); - Check_At_Most_N_Arguments (1); + Check_Arg_Count (1); Check_Optional_Identifier (Arg1, Name_Entity); Check_Arg_Is_Local_Name (Arg1); -- 2.7.4