diff options
| -rw-r--r-- | gcc/ada/bindgen.adb | 53 | ||||
| -rw-r--r-- | gcc/ada/opt.ads | 8 | ||||
| -rw-r--r-- | gcc/ada/switch-b.adb | 9 |
3 files changed, 34 insertions, 36 deletions
diff --git a/gcc/ada/bindgen.adb b/gcc/ada/bindgen.adb index 4e89918..b942985 100644 --- 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 --- 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 --- 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; |