ada: Rework CUDA host-side invocation of device-side elaboration code

When the binder is invoked with a "-d_c" switch, add an argument to that
switch which is the library name on the device side; so "-d_c" becomes
"-d_c=some_library_name". This does not effect the case where "-d_c" is
specified as a switch for compilation (as opposed to binding). Use this
new piece of information in the code generated by the binder to invoke
elaboration code on the device side from the host side.

gcc/ada/

	* opt.ads: Declare new string pointer variable, CUDA_Device_Library_Name.
	Modify comments for existing Boolean variable Enable_CUDA_Device_Expansion.
	* switch-b.adb: When "-d_c" switch is encountered, check that the next
	character is an "'='; use the remaining characters to initialize
	Opt.CUDA_Device_Library_Name.
	* bindgen.adb: Remove (for now) most support for host-side invocation of
	device-side finalization. Make use of the new CUDA_Device_Library_Name
	in determining the string used to refer (on the host side) to the
	device-side initialization procedure. Declare the placeholder routine
	that is named in the CUDA_Execute pragma (and the CUDA_Register_Function
	call) as an exported null procedure, rather than as an imported procedure.
	It is not clear whether it is really necessary to specify the link-name
	for this should-never-be-called subprogram on the host side, but for now it
	shouldn't hurt to do so.

diff --git a/gcc/ada/bindgen.adb b/gcc/ada/bindgen.adb
index 4e89918..b942985 100644 (file)
--- a/gcc/ada/bindgen.adb
+++ b/gcc/ada/bindgen.adb
@@ -114,27 +114,25 @@ package body Bindgen is
    --  For CodePeer, introduce a wrapper subprogram which calls the
    --  user-defined main subprogram.
 
-   --  Names for local C-String variables
+   --  Name for local C-String variable
 
    Adainit_String_Obj_Name  : constant String := "Adainit_Name_C_String";
-   Adafinal_String_Obj_Name : constant String := "Adafinal_Name_C_String";
 
-   --  Names and link_names for CUDA device adainit/adafinal procs.
+   --  Name and link_name for CUDA device initialization procedure
 
-   Device_Subp_Name_Prefix : constant String := "imported_device_";
+   Device_Ada_Init_Subp_Name : constant String := "Device_Initialization";
    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_Link_Name (Suffix : String) return String is
+     (Device_Link_Name_Prefix &
+       (if CUDA_Device_Library_Name = null
+        then "ada" -- is this an error path?
+        else CUDA_Device_Library_Name.all) & Suffix);
 
-   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);
+   function Device_Ada_Init_Link_Name return String
+     is (Device_Link_Name (Suffix => "init"));
+   function Device_Ada_Final_Link_Name return String
+     is (Device_Link_Name (Suffix => "final"));
 
    ----------------------------------
    -- Interface_State Pragma Table --
@@ -523,12 +521,6 @@ 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;
@@ -1362,17 +1354,17 @@ package body Bindgen is
       end loop;
 
       WBI ("   procedure " & Device_Ada_Init_Subp_Name & ";");
-      WBI ("   pragma Import (C, " & Device_Ada_Init_Subp_Name &
+      WBI ("   pragma Export (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 & """);");
 
-      --  C-string declarations for adainit and adafinal
+      --  It would be nice to declare a real body that raises P_E, but
+      --  generating a subprogram body at the right point is harder
+      --  than generating a null procedure here.
+      WBI ("   procedure " & Device_Ada_Init_Subp_Name & " is null;");
+
+      --  C-string declaration for adainit
       WBI ("   " & Adainit_String_Obj_Name
             & " : Interfaces.C.Strings.Chars_Ptr;");
-      WBI ("   " & Adafinal_String_Obj_Name
-            & " : Interfaces.C.Strings.Chars_Ptr;");
       WBI ("");
 
       WBI ("");
@@ -1455,15 +1447,11 @@ package body Bindgen is
          end;
       end loop;
 
-      --  Register device-side Adainit and Adafinal
+      --  Register device-side Adainit
       Gen_CUDA_Register_Function_Call
         (Kernel_Name   => Device_Ada_Init_Link_Name,
          Kernel_String => Adainit_String_Obj_Name,
          Kernel_Proc   => Device_Ada_Init_Subp_Name);
-      Gen_CUDA_Register_Function_Call
-        (Kernel_Name   => Device_Ada_Final_Link_Name,
-         Kernel_String => Adafinal_String_Obj_Name,
-         Kernel_Proc   => Device_Ada_Final_Subp_Name);
 
       WBI ("      CUDA_Register_Fat_Binary_End (Fat_Binary_Handle);");
 
@@ -2702,7 +2690,6 @@ package body Bindgen is
       if not Cumulative_Restrictions.Set (No_Finalization) then
          WBI ("");
          WBI ("   procedure " & Ada_Final_Name.all & ";");
-
          if Enable_CUDA_Device_Expansion then
             WBI ("   pragma Export (C, " & Ada_Final_Name.all &
                    ", Link_Name => """ & Device_Ada_Final_Link_Name & """);");

diff --git a/gcc/ada/opt.ads b/gcc/ada/opt.ads
index 9eb792e..6f3ced2 100644 (file)
--- a/gcc/ada/opt.ads
+++ b/gcc/ada/opt.ads
@@ -395,6 +395,10 @@ package Opt is
    --  Set to True (-C switch) to indicate that the compiler will be invoked
    --  with a mapping file (-gnatem compiler switch).
 
+   CUDA_Device_Library_Name : String_Ptr := null;
+   --  GNATBIND
+   --  Non-null only if Enable_CUDA_Expansion is True.
+
    subtype Debug_Level_Value is Nat range 0 .. 3;
    Debugger_Level : Debug_Level_Value := 0;
    --  GNAT, GNATBIND
@@ -549,9 +553,7 @@ package Opt is
 
    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.
+   --  Set to True to enable CUDA device (as opposed to host) expansion.
 
    Error_Msg_Line_Length : Nat := 0;
    --  GNAT

diff --git a/gcc/ada/switch-b.adb b/gcc/ada/switch-b.adb
index c40cb97..7a732ae 100644 (file)
--- a/gcc/ada/switch-b.adb
+++ b/gcc/ada/switch-b.adb
@@ -168,6 +168,15 @@ package body Switch.B is
                   if Enable_CUDA_Expansion and Enable_CUDA_Device_Expansion
                   then
                      Bad_Switch (Switch_Chars);
+                  elsif C = 'c' then
+                     --  specify device library name
+                     if Ptr >= Max or else Switch_Chars (Ptr + 1) /= '=' then
+                        Bad_Switch (Switch_Chars);
+                     else
+                        CUDA_Device_Library_Name :=
+                           new String'(Switch_Chars (Ptr + 2 .. Max));
+                        Ptr := Max;
+                     end if;
                   end if;
 
                   Underscore := False;