OpenE2K/gcc
2
0
Fork 0
Code Issues Pull Requests Projects Releases Wiki Activity

[Ada] Stub CUDA_Device aspect

Browse Source 
gcc/ada/

	* aspects.ads: Add CUDA_Device aspect.
	* gnat_cuda.ads (Add_CUDA_Device_Entity): New subprogram.
	* gnat_cuda.adb:
	(Add_CUDA_Device_Entity): New subprogram.
	(CUDA_Device_Entities_Table): New hashmap for CUDA_Device
	entities.
	(Get_CUDA_Device_Entities): New internal subprogram.
	(Set_CUDA_Device_Entities): New internal subprogram.
	* par-prag.adb (Prag): Handle pragma id Pragma_CUDA_Device.
	* sem_prag.ads (Aspect_Specifying_Pragma): Mark CUDA_Device as
	being both aspect and pragma.
	* sem_prag.adb (Analyze_Pragma): Add CUDA_Device entities to
	list of CUDA_Entities belonging to package N.
	(Sig_Flags): Signal CUDA_Device entities as referenced.
	* snames.ads-tmpl: Create CUDA_Device names and pragmas.
This commit is contained in:
Ghjuvan Lacambre 2021-02-09 09:31:45 +01:00 committed by Pierre-Marie de Rodat
parent 28c49456b2
commit 8279a1125f
7 changed files with 110 additions and 5 deletions
Show Stats Download Patch File Download Diff File Expand all files Collapse all files

4
gcc/ada/aspects.ads
View File

@ -187,6 +187,7 @@ package Aspects is
Aspect_Atomic_Components,
Aspect_Disable_Controlled, -- GNAT
Aspect_Discard_Names,
Aspect_CUDA_Device, -- GNAT
Aspect_CUDA_Global, -- GNAT
Aspect_Exclusive_Functions,
Aspect_Export,
@ -476,6 +477,7 @@ package Aspects is
Aspect_Contract_Cases => False,
Aspect_Convention => True,
Aspect_CPU => False,
Aspect_CUDA_Device => False,
Aspect_CUDA_Global => False,
Aspect_Default_Component_Value => True,
Aspect_Default_Initial_Condition => False,
@ -627,6 +629,7 @@ package Aspects is
Aspect_Contract_Cases => Name_Contract_Cases,
Aspect_Convention => Name_Convention,
Aspect_CPU => Name_CPU,
Aspect_CUDA_Device => Name_CUDA_Device,
Aspect_CUDA_Global => Name_CUDA_Global,
Aspect_Default_Component_Value => Name_Default_Component_Value,
Aspect_Default_Initial_Condition => Name_Default_Initial_Condition,
@ -872,6 +875,7 @@ package Aspects is
Aspect_Attach_Handler => Always_Delay,
Aspect_Constant_Indexing => Always_Delay,
Aspect_CPU => Always_Delay,
Aspect_CUDA_Device => Always_Delay,
Aspect_CUDA_Global => Always_Delay,
Aspect_Default_Iterator => Always_Delay,
Aspect_Default_Storage_Pool => Always_Delay,

68
gcc/ada/gnat_cuda.adb
View File

@ -54,6 +54,18 @@ package body GNAT_CUDA is
function Hash (F : Entity_Id) return Hash_Range;
-- Hash function for hash table
package CUDA_Device_Entities_Table is new
GNAT.HTable.Simple_HTable
(Header_Num => Hash_Range,
Element => Elist_Id,
No_Element => No_Elist,
Key => Entity_Id,
Hash => Hash,
Equal => "=");
-- The keys of this table are package entities whose bodies contain at
-- least one procedure marked with aspect CUDA_Device. The values are
-- Elists of the marked entities.
package CUDA_Kernels_Table is new
GNAT.HTable.Simple_HTable
(Header_Num => Hash_Range,
@ -85,17 +97,45 @@ package body GNAT_CUDA is
-- * A procedure that takes care of calling CUDA functions that register
-- CUDA_Global procedures with the runtime.
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
-- does not contain such entities.
function Get_CUDA_Kernels (Pack_Id : Entity_Id) return Elist_Id;
-- Returns an Elist of all procedures marked with pragma CUDA_Global that
-- are declared within package body Pack_Body. Returns No_Elist if Pack_Id
-- does not contain such procedures.
procedure Set_CUDA_Device_Entities
(Pack_Id : Entity_Id;
E : Elist_Id);
-- Stores E as the list of CUDA_Device entities belonging to the package
-- entity Pack_Id. Pack_Id must not have a list of device entities.
procedure Set_CUDA_Kernels
(Pack_Id : Entity_Id;
Kernels : Elist_Id);
-- Stores Kernels as the list of kernels belonging to the package entity
-- Pack_Id. Pack_Id must not have a list of kernels.
----------------------------
-- Add_CUDA_Device_Entity --
----------------------------
procedure Add_CUDA_Device_Entity
(Pack_Id : Entity_Id;
E : Entity_Id)
is
Device_Entities : Elist_Id := Get_CUDA_Device_Entities (Pack_Id);
begin
if Device_Entities = No_Elist then
Device_Entities := New_Elmt_List;
Set_CUDA_Device_Entities (Pack_Id, Device_Entities);
end if;
Append_Elmt (E, Device_Entities);
end Add_CUDA_Device_Entity;
---------------------
-- Add_CUDA_Kernel --
---------------------
@ -139,6 +179,15 @@ package body GNAT_CUDA is
return Hash_Range (F mod 511);
end Hash;
------------------------------
-- Get_CUDA_Device_Entities --
------------------------------
function Get_CUDA_Device_Entities (Pack_Id : Entity_Id) return Elist_Id is
begin
return CUDA_Device_Entities_Table.Get (Pack_Id);
end Get_CUDA_Device_Entities;
----------------------
-- Get_CUDA_Kernels --
----------------------
@ -605,9 +654,22 @@ package body GNAT_CUDA is
Analyze (New_Stmt);
end Build_And_Insert_CUDA_Initialization;
--------------------
-- Set_CUDA_Nodes --
--------------------
------------------------------
-- Set_CUDA_Device_Entities --
------------------------------
procedure Set_CUDA_Device_Entities
(Pack_Id : Entity_Id;
E : Elist_Id)
is
begin
pragma Assert (Get_CUDA_Device_Entities (Pack_Id) = No_Elist);
CUDA_Device_Entities_Table.Set (Pack_Id, E);
end Set_CUDA_Device_Entities;
----------------------
-- Set_CUDA_Kernels --
----------------------
procedure Set_CUDA_Kernels
(Pack_Id : Entity_Id;

3
gcc/ada/gnat_cuda.ads
View File

@ -77,6 +77,9 @@ with Types; use Types;
package GNAT_CUDA is
procedure Add_CUDA_Device_Entity (Pack_Id : Entity_Id; E : Entity_Id);
-- And E to the list of CUDA_Device entities that belong to Pack_Id
procedure Add_CUDA_Kernel (Pack_Id : Entity_Id; Kernel : Entity_Id);
-- Add Kernel to the list of CUDA_Global nodes that belong to Pack_Id.
-- Kernel is a procedure entity marked with CUDA_Global, Pack_Id is the

1
gcc/ada/par-prag.adb
View File

@ -1338,6 +1338,7 @@ begin
| Pragma_CPP_Virtual
| Pragma_CPP_Vtable
| Pragma_CPU
| Pragma_CUDA_Device
| Pragma_CUDA_Execute
| Pragma_CUDA_Global
| Pragma_C_Pass_By_Copy

36
gcc/ada/sem_prag.adb
View File

@ -14839,9 +14839,40 @@ package body Sem_Prag is
& "effect?j?", N);
end if;
--------------------
-----------------
-- CUDA_Device --
-----------------
when Pragma_CUDA_Device => CUDA_Device : declare
Arg_Node : Node_Id;
Device_Entity : Entity_Id;
begin
GNAT_Pragma;
Check_Arg_Count (1);
Arg_Node := Get_Pragma_Arg (Arg1);
Check_Arg_Is_Library_Level_Local_Name (Arg_Node);
Device_Entity := Entity (Arg_Node);
if Ekind (Device_Entity) in E_Variable
| E_Constant
| E_Procedure
| E_Function
then
Add_CUDA_Device_Entity (Scope (Device_Entity), Device_Entity);
Error_Msg_N ("??& not implemented yet", N);
else
Error_Msg_NE ("& must be constant, variable or subprogram",
N,
Device_Entity);
end if;
end CUDA_Device;
------------------
-- CUDA_Execute --
--------------------
------------------
-- pragma CUDA_Execute (PROCEDURE_CALL_STATEMENT,
-- EXPRESSION,
@ -31248,6 +31279,7 @@ package body Sem_Prag is
Pragma_C_Pass_By_Copy => 0,
Pragma_Comment => -1,
Pragma_Common_Object => 0,
Pragma_CUDA_Device => -1,
Pragma_CUDA_Execute => -1,
Pragma_CUDA_Global => -1,
Pragma_Compile_Time_Error => -1,

1
gcc/ada/sem_prag.ads
View File

@ -49,6 +49,7 @@ package Sem_Prag is
Pragma_Contract_Cases => True,
Pragma_Convention => True,
Pragma_CPU => True,
Pragma_CUDA_Device => True,
Pragma_CUDA_Global => True,
Pragma_Default_Initial_Condition => True,
Pragma_Default_Storage_Pool => True,

2
gcc/ada/snames.ads-tmpl
View File

@ -526,6 +526,7 @@ package Snames is
Name_CPP_Constructor : constant Name_Id := N + $; -- GNAT
Name_CPP_Virtual : constant Name_Id := N + $; -- GNAT
Name_CPP_Vtable : constant Name_Id := N + $; -- GNAT
Name_CUDA_Device : constant Name_Id := N + $; -- GNAT
Name_CUDA_Execute : constant Name_Id := N + $; -- GNAT
Name_CUDA_Global : constant Name_Id := N + $; -- GNAT
@ -1862,6 +1863,7 @@ package Snames is
Pragma_CPP_Constructor,
Pragma_CPP_Virtual,
Pragma_CPP_Vtable,
Pragma_CUDA_Device,
Pragma_CUDA_Execute,
Pragma_CUDA_Global,
Pragma_Deadline_Floor,