[Ada] Improve CUDA host-side and device-side binder support

[Ada] Improve CUDA host-side and device-side binder support

[Marc Poulhiès]

[-- Attachment #1: Type: text/plain, Size: 1719 bytes --]

Use switches (one already existing, one newly added here) to indicate to
the binder that CUDA support code is to be generated for either the
host side or for the device side. Add an invocation of Adainit on the
device side from Adainit on the host side; similarly for Adafinal.

Tested on x86_64-pc-linux-gnu, committed on trunk

gcc/ada/

	* bindgen.adb: When the binder is invoked for the host, it
	declares imported subprograms corresponding to the Adainit and
	Adafinal routines on the device. Declare string constants and
	expression functions for the Ada source names and the link names
	of these routines. Generate these subprogram declarations (and
	accompanying Import pragmas) in Gen_CUDA_Defs. Generate
	CUDA_Execute pragmas to call these subprograms from the host in
	Gen_Adafinal and Gen_CUDA_Init. When the binder is invoked for the
	device, include a CUDA_Global aspect declaration in the
	declarations of Adainit and Adafinal and use the aforementioned
	link names in the Export pragmas generated for those two routines.
	* debug.adb: Update comments about "d_c" and "d_d" switches.
	* opt.ads: Declare new Boolean variable,
	Enable_CUDA_Device_Expansion. This complements the existing
	Enable_CUDA_Expansion variable, which is used to enable host-side
	CUDA expansion. The new variable enables device-side CUDA
	expansion. It is currently never set during compilation; it is
	only set via a binder switch.
	* switch-b.adb
	(scan_debug_switches): Add new use of the "-d_d" binder switch.
	The new switch and the variable Opt.Enabled_CUDA_Device_Expansion
	follow the existing pattern of the "-d_c" switch and the variable
	Opt.Enabled_CUDA_Expansion. Flag error if both "-d_c" and "-d_d"
	are specified.

[-- Attachment #2: patch.diff --]
[-- Type: text/x-diff, Size: 7089 bytes --]

diff --git a/gcc/ada/bindgen.adb b/gcc/ada/bindgen.adb
--- a/gcc/ada/bindgen.adb
+++ b/gcc/ada/bindgen.adb
@@ -114,6 +114,29 @@ package body Bindgen is
    --  For CodePeer, introduce a wrapper subprogram which calls the
    --  user-defined main subprogram.
 
+   --  Names and link_names for CUDA device adainit/adafinal procs.
+
+   Device_Subp_Name_Prefix : constant String := "imported_device_";
+   Device_Link_Name_Prefix : constant String := "__device_";
+
+   function Device_Ada_Final_Link_Name return String is
+     (Device_Link_Name_Prefix & Ada_Final_Name.all);
+
+   function Device_Ada_Final_Subp_Name return String is
+     (Device_Subp_Name_Prefix & Ada_Final_Name.all);
+
+   function Device_Ada_Init_Link_Name return String is
+     (Device_Link_Name_Prefix & Ada_Init_Name.all);
+
+   function Device_Ada_Init_Subp_Name return String is
+     (Device_Subp_Name_Prefix & Ada_Init_Name.all);
+
+   --  Text for aspect specifications (if any) given as part of the
+   --  Adainit and Adafinal spec declarations.
+
+   function Aspect_Text return String is
+     (if Enable_CUDA_Device_Expansion then " with CUDA_Global" else "");
+
    ----------------------------------
    -- Interface_State Pragma Table --
    ----------------------------------
@@ -501,6 +524,12 @@ package body Bindgen is
          WBI ("      System.Standard_Library.Adafinal;");
       end if;
 
+      --  perform device (as opposed to host) finalization
+      if Enable_CUDA_Expansion then
+         WBI ("      pragma CUDA_Execute (" &
+                Device_Ada_Final_Subp_Name & ", 1, 1);");
+      end if;
+
       WBI ("   end " & Ada_Final_Name.all & ";");
       WBI ("");
    end Gen_Adafinal;
@@ -512,7 +541,6 @@ package body Bindgen is
    procedure Gen_Adainit (Elab_Order : Unit_Id_Array) is
       Main_Priority : Int renames ALIs.Table (ALIs.First).Main_Priority;
       Main_CPU      : Int renames ALIs.Table (ALIs.First).Main_CPU;
-
    begin
       --  Declare the access-to-subprogram type used for initialization of
       --  of __gnat_finalize_library_objects. This is declared at library
@@ -1334,6 +1362,13 @@ package body Bindgen is
          end;
       end loop;
 
+      WBI ("   procedure " & Device_Ada_Init_Subp_Name & ";");
+      WBI ("   pragma Import (C, " & Device_Ada_Init_Subp_Name &
+             ", Link_Name => """ & Device_Ada_Init_Link_Name & """);");
+      WBI ("   procedure " & Device_Ada_Final_Subp_Name & ";");
+      WBI ("   pragma Import (C, " & Device_Ada_Final_Subp_Name &
+             ", Link_Name => """ & Device_Ada_Final_Link_Name & """);");
+
       WBI ("");
    end Gen_CUDA_Defs;
 
@@ -1393,6 +1428,10 @@ package body Bindgen is
       end loop;
 
       WBI ("      CUDA_Register_Fat_Binary_End (Fat_Binary_Handle);");
+
+      --  perform device (as opposed to host) elaboration
+      WBI ("      pragma CUDA_Execute (" &
+             Device_Ada_Init_Subp_Name & ", 1, 1);");
    end Gen_CUDA_Init;
 
    --------------------------
@@ -2602,9 +2641,14 @@ package body Bindgen is
       end if;
 
       WBI ("");
-      WBI ("   procedure " & Ada_Init_Name.all & ";");
-      WBI ("   pragma Export (C, " & Ada_Init_Name.all & ", """ &
-           Ada_Init_Name.all & """);");
+      WBI ("   procedure " & Ada_Init_Name.all & Aspect_Text & ";");
+      if Enable_CUDA_Device_Expansion then
+         WBI ("   pragma Export (C, " & Ada_Init_Name.all &
+                ", Link_Name => """ & Device_Ada_Init_Link_Name & """);");
+      else
+         WBI ("   pragma Export (C, " & Ada_Init_Name.all & ", """ &
+              Ada_Init_Name.all & """);");
+      end if;
 
       --  If -a has been specified use pragma Linker_Constructor for the init
       --  procedure and pragma Linker_Destructor for the final procedure.
@@ -2615,9 +2659,15 @@ package body Bindgen is
 
       if not Cumulative_Restrictions.Set (No_Finalization) then
          WBI ("");
-         WBI ("   procedure " & Ada_Final_Name.all & ";");
-         WBI ("   pragma Export (C, " & Ada_Final_Name.all & ", """ &
-              Ada_Final_Name.all & """);");
+         WBI ("   procedure " & Ada_Final_Name.all & Aspect_Text & ";");
+
+         if Enable_CUDA_Device_Expansion then
+            WBI ("   pragma Export (C, " & Ada_Final_Name.all &
+                   ", Link_Name => """ & Device_Ada_Final_Link_Name & """);");
+         else
+            WBI ("   pragma Export (C, " & Ada_Final_Name.all & ", """ &
+                 Ada_Final_Name.all & """);");
+         end if;
 
          if Use_Pragma_Linker_Constructor then
             WBI ("   pragma Linker_Destructor (" & Ada_Final_Name.all & ");");


diff --git a/gcc/ada/debug.adb b/gcc/ada/debug.adb
--- a/gcc/ada/debug.adb
+++ b/gcc/ada/debug.adb
@@ -142,7 +142,7 @@ package body Debug is
    --  d_a  Stop elaboration checks on accept or select statement
    --  d_b  Use designated type model under No_Dynamic_Accessibility_Checks
    --  d_c  CUDA compilation : compile for the host
-   --  d_d
+   --  d_d  CUDA compilation : compile for the device
    --  d_e  Ignore entry calls and requeue statements for elaboration
    --  d_f  Issue info messages related to GNATprove usage
    --  d_g  Disable large static aggregates
@@ -345,8 +345,8 @@ package body Debug is
 
    --  d_a  Ignore the effects of pragma Elaborate_All
    --  d_b  Ignore the effects of pragma Elaborate_Body
-   --  d_c
-   --  d_d
+   --  d_c  CUDA compilation : compile/bind for the host
+   --  d_d  CUDA compilation : compile/bind for the device
    --  d_e  Ignore the effects of pragma Elaborate
    --  d_f
    --  d_g


diff --git a/gcc/ada/opt.ads b/gcc/ada/opt.ads
--- a/gcc/ada/opt.ads
+++ b/gcc/ada/opt.ads
@@ -544,6 +544,13 @@ package Opt is
    --  Set to True to enable CUDA host expansion:
    --    - Removal of CUDA_Global and CUDA_Device symbols
    --    - Generation of kernel registration code in packages
+   --    - Binder invokes device elaboration/finalization code
+
+   Enable_CUDA_Device_Expansion : Boolean := False;
+   --  GNATBIND
+   --  Set to True to enable CUDA device (as opposed to host) expansion:
+   --    - Binder generates elaboration/finalization code that can be
+   --      invoked from corresponding binder-generated host-side code.
 
    Error_Msg_Line_Length : Nat := 0;
    --  GNAT


diff --git a/gcc/ada/switch-b.adb b/gcc/ada/switch-b.adb
--- a/gcc/ada/switch-b.adb
+++ b/gcc/ada/switch-b.adb
@@ -158,9 +158,18 @@ package body Switch.B is
 
                elsif Underscore then
                   Set_Underscored_Debug_Flag (C);
+
                   if Debug_Flag_Underscore_C then
                      Enable_CUDA_Expansion := True;
                   end if;
+                  if Debug_Flag_Underscore_D then
+                     Enable_CUDA_Device_Expansion := True;
+                  end if;
+                  if Enable_CUDA_Expansion and Enable_CUDA_Device_Expansion
+                  then
+                     Bad_Switch (Switch_Chars);
+                  end if;
+
                   Underscore := False;
 
                --    letter

[Ada] Improve CUDA host-side and device-side binder support

[Marc Poulhiès]

[-- Attachment #1: Type: text/plain, Size: 456 bytes --]

On the host-side, the binder now generates CUDA_Execute pragmas to
invoke initialization and finalization on the device-side. The
front end's expansion of these pragmas includes references to
entities declared in package CUDA.Internal. Generate a with-clause so
that unit will be available.

Tested on x86_64-pc-linux-gnu, committed on trunk

gcc/ada/

	* bindgen.adb: When the binder is invoked for the host, generate a
	"with CUDA.Internal;" with clause.

[-- Attachment #2: patch.diff --]
[-- Type: text/x-diff, Size: 455 bytes --]

diff --git a/gcc/ada/bindgen.adb b/gcc/ada/bindgen.adb
--- a/gcc/ada/bindgen.adb
+++ b/gcc/ada/bindgen.adb
@@ -2552,6 +2552,9 @@ package body Bindgen is
       if Enable_CUDA_Expansion then
          WBI ("with Interfaces.C;");
          WBI ("with Interfaces.C.Strings;");
+
+         --  with of CUDA.Internal needed for CUDA_Execute pragma expansion
+         WBI ("with CUDA.Internal;");
       end if;
 
       Resolve_Binder_Options (Elab_Order);