[Ada] CUDA: discover runtime types instead of hard-coding

gcc/ada/

	* exp_prag.adb (Get_Launch_Kernel_Arg_Type): New function.
	(Build_Shared_Memory_Declaration): Use
	Get_Launch_Kernel_Arg_Type.
	(Build_Stream_Declaration): Use Get_Launch_Kernel_Arg_Type.
	* rtsfind.ads: Remove RO_IC_Unsigned_Long_Long.
This commit is contained in:
Ghjuvan Lacambre 2020-08-25 12:16:24 +02:00 committed by Pierre-Marie de Rodat
parent d4194d74fa
commit f0c57fcd0a
2 changed files with 21 additions and 4 deletions

View File

@ -748,6 +748,10 @@ package body Exp_Prag is
-- type of which is Integer, the value of which is Init_Val if present -- type of which is Integer, the value of which is Init_Val if present
-- and 0 otherwise. -- and 0 otherwise.
function Get_Launch_Kernel_Arg_Type (N : Positive) return Entity_Id;
-- Returns the type of the Nth argument of the Launch_Kernel CUDA
-- runtime function.
function To_Addresses (Elmts : Elist_Id) return List_Id; function To_Addresses (Elmts : Elist_Id) return List_Id;
-- Returns a new list containing each element of Elmts wrapped in an -- Returns a new list containing each element of Elmts wrapped in an
-- 'address attribute reference. When passed No_Elist, returns an empty -- 'address attribute reference. When passed No_Elist, returns an empty
@ -910,7 +914,7 @@ package body Exp_Prag is
(Decl_Id => Decl_Id, (Decl_Id => Decl_Id,
Init_Val => Init_Val, Init_Val => Init_Val,
Typ => Typ =>
New_Occurrence_Of (RTE (RO_IC_Unsigned_Long_Long), Loc), New_Occurrence_Of (Get_Launch_Kernel_Arg_Type (5), Loc),
Default_Val => Make_Integer_Literal (Loc, 0)); Default_Val => Make_Integer_Literal (Loc, 0));
end Build_Shared_Memory_Declaration; end Build_Shared_Memory_Declaration;
@ -948,10 +952,25 @@ package body Exp_Prag is
return Build_Simple_Declaration_With_Default return Build_Simple_Declaration_With_Default
(Decl_Id => Decl_Id, (Decl_Id => Decl_Id,
Init_Val => Init_Val, Init_Val => Init_Val,
Typ => New_Occurrence_Of (RTE (RE_Stream_T), Loc), Typ =>
New_Occurrence_Of (Get_Launch_Kernel_Arg_Type (6), Loc),
Default_Val => Make_Null (Loc)); Default_Val => Make_Null (Loc));
end Build_Stream_Declaration; end Build_Stream_Declaration;
--------------------------------
-- Get_Launch_Kernel_Arg_Type --
--------------------------------
function Get_Launch_Kernel_Arg_Type (N : Positive) return Entity_Id is
Argument : Entity_Id := First_Entity (RTE (RE_Launch_Kernel));
begin
for J in 2 .. N loop
Argument := Next_Entity (Argument);
end loop;
return Etype (Argument);
end Get_Launch_Kernel_Arg_Type;
------------------ ------------------
-- To_Addresses -- -- To_Addresses --
------------------ ------------------

View File

@ -731,7 +731,6 @@ package Rtsfind is
RE_Unsigned_128, -- Interfaces RE_Unsigned_128, -- Interfaces
RO_IC_Unsigned, -- Interfaces.C RO_IC_Unsigned, -- Interfaces.C
RO_IC_Unsigned_Long_Long, -- Interfaces.C
RE_Chars_Ptr, -- Interfaces.C.Strings RE_Chars_Ptr, -- Interfaces.C.Strings
RE_New_Char_Array, -- Interfaces.C.Strings RE_New_Char_Array, -- Interfaces.C.Strings
@ -2380,7 +2379,6 @@ package Rtsfind is
RE_Unsigned_128 => Interfaces, RE_Unsigned_128 => Interfaces,
RO_IC_Unsigned => Interfaces_C, RO_IC_Unsigned => Interfaces_C,
RO_IC_Unsigned_Long_Long => Interfaces_C,
RE_Chars_Ptr => Interfaces_C_Strings, RE_Chars_Ptr => Interfaces_C_Strings,
RE_New_Char_Array => Interfaces_C_Strings, RE_New_Char_Array => Interfaces_C_Strings,