[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.

diff --git a/gcc/ada/exp_prag.adb b/gcc/ada/exp_prag.adb
index d616fb6..ca1b084 100644 (file)
--- 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 (file)
--- 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 (file)
--- 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);