diff options
| -rw-r--r-- | gcc/ada/bindgen.adb | 64 | ||||
| -rw-r--r-- | gcc/ada/debug.adb | 6 | ||||
| -rw-r--r-- | gcc/ada/opt.ads | 7 | ||||
| -rw-r--r-- | gcc/ada/switch-b.adb | 9 |
4 files changed, 76 insertions, 10 deletions
diff --git a/gcc/ada/bindgen.adb b/gcc/ada/bindgen.adb index d5877c6..1b21230 100644 --- 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 index 475a123..94e729e 100644 --- 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 index 19a8b41..8f903ca 100644 --- 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 index a543ad9..c40cb97 100644 --- 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 |