[Ada] Empty CUDA_Global procedures when compiling for host

gcc/ada/

	* gnat_cuda.adb (Empty_CUDA_Global_Subprograms): New procedure.
	(Expand_CUDA_Package): Call Empty_CUDA_Global_Subprograms.
This commit is contained in:
Ghjuvan Lacambre 2021-08-16 15:28:09 +02:00 committed by Pierre-Marie de Rodat
parent e02c8dffe3
commit 29ada0e5a2

View file

@ -25,20 +25,22 @@
-- This package defines CUDA-specific datastructures and functions.
with Debug; use Debug;
with Elists; use Elists;
with Namet; use Namet;
with Nlists; use Nlists;
with Nmake; use Nmake;
with Rtsfind; use Rtsfind;
with Sinfo; use Sinfo;
with Sinfo.Nodes; use Sinfo.Nodes;
with Stringt; use Stringt;
with Tbuild; use Tbuild;
with Uintp; use Uintp;
with Sem; use Sem;
with Sem_Util; use Sem_Util;
with Snames; use Snames;
with Atree; use Atree;
with Debug; use Debug;
with Elists; use Elists;
with Namet; use Namet;
with Nlists; use Nlists;
with Nmake; use Nmake;
with Rtsfind; use Rtsfind;
with Sinfo; use Sinfo;
with Sinfo.Nodes; use Sinfo.Nodes;
with Stringt; use Stringt;
with Tbuild; use Tbuild;
with Uintp; use Uintp;
with Sem; use Sem;
with Sem_Aux; use Sem_Aux;
with Sem_Util; use Sem_Util;
with Snames; use Snames;
with GNAT.HTable;
@ -97,6 +99,17 @@ package body GNAT_CUDA is
-- * A procedure that takes care of calling CUDA functions that register
-- CUDA_Global procedures with the runtime.
procedure Empty_CUDA_Global_Subprograms (Pack_Id : Entity_Id);
-- For all subprograms marked CUDA_Global in Pack_Id, remove declarations
-- and replace statements with a single null statement.
-- This is required because CUDA_Global subprograms could be referring to
-- device-only symbols, which would result in unknown symbols at link time
-- if kept around.
-- We choose to empty CUDA_Global subprograms rather than completely
-- removing them from the package because registering CUDA_Global
-- subprograms with the CUDA runtime on the host requires knowing the
-- subprogram's host-side address.
function Get_CUDA_Device_Entities (Pack_Id : Entity_Id) return Elist_Id;
-- Returns an Elist of all entities marked with pragma CUDA_Device that
-- are declared within package body Pack_Body. Returns No_Elist if Pack_Id
@ -153,6 +166,50 @@ package body GNAT_CUDA is
Append_Elmt (Kernel, Kernels);
end Add_CUDA_Kernel;
-----------------------------------
-- Empty_CUDA_Global_Subprograms --
-----------------------------------
procedure Empty_CUDA_Global_Subprograms (Pack_Id : Entity_Id) is
Spec_Id : constant Node_Id := Corresponding_Spec (Pack_Id);
Kernels : constant Elist_Id := Get_CUDA_Kernels (Spec_Id);
Kernel_Elm : Elmt_Id;
Kernel : Entity_Id;
Kernel_Body : Node_Id;
Null_Body : Entity_Id;
Loc : Source_Ptr;
begin
-- It is an error to empty CUDA_Global subprograms when not compiling
-- for the host.
pragma Assert (Debug_Flag_Underscore_C);
if No (Kernels) then
return;
end if;
Kernel_Elm := First_Elmt (Kernels);
while Present (Kernel_Elm) loop
Kernel := Node (Kernel_Elm);
Kernel_Body := Subprogram_Body (Kernel);
Loc := Sloc (Kernel_Body);
Null_Body := Make_Subprogram_Body (Loc,
Specification => Subprogram_Specification (Kernel),
Declarations => New_List,
Handled_Statement_Sequence =>
Make_Handled_Sequence_Of_Statements (Loc,
Statements => New_List (Make_Null_Statement (Loc))));
Rewrite (Kernel_Body, Null_Body);
Next_Elmt (Kernel_Elm);
end loop;
end Empty_CUDA_Global_Subprograms;
-------------------------
-- Expand_CUDA_Package --
-------------------------
procedure Expand_CUDA_Package (N : Node_Id) is
begin
@ -162,6 +219,13 @@ package body GNAT_CUDA is
return;
end if;
-- Remove the content (both declarations and statements) of CUDA_Global
-- procedures. This is required because CUDA_Global functions could be
-- referencing entities available only on the device, which would result
-- in unknown symbol errors at link time.
Empty_CUDA_Global_Subprograms (N);
-- If procedures marked with CUDA_Global have been defined within N,
-- we need to register them with the CUDA runtime at program startup.
-- This requires multiple declarations and function calls which need