public inbox for gcc-cvs@sourceware.org
help / color / mirror / Atom feed
* [gcc r12-4018] [Ada] Stub CUDA_Device aspect
@ 2021-10-01 6:15 Pierre-Marie de Rodat
0 siblings, 0 replies; only message in thread
From: Pierre-Marie de Rodat @ 2021-10-01 6:15 UTC (permalink / raw)
To: gcc-cvs
https://gcc.gnu.org/g:8279a1125f51b1184289bd406b37f6c31c1b17f5
commit r12-4018-g8279a1125f51b1184289bd406b37f6c31c1b17f5
Author: Ghjuvan Lacambre <lacambre@adacore.com>
Date: Tue Feb 9 09:31:45 2021 +0100
[Ada] Stub CUDA_Device aspect
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.
Diff:
---
gcc/ada/aspects.ads | 4 +++
gcc/ada/gnat_cuda.adb | 68 ++++++++++++++++++++++++++++++++++++++++++++++---
gcc/ada/gnat_cuda.ads | 3 +++
gcc/ada/par-prag.adb | 1 +
gcc/ada/sem_prag.adb | 36 ++++++++++++++++++++++++--
gcc/ada/sem_prag.ads | 1 +
gcc/ada/snames.ads-tmpl | 2 ++
7 files changed, 110 insertions(+), 5 deletions(-)
diff --git a/gcc/ada/aspects.ads b/gcc/ada/aspects.ads
index 7d0c7030db8..11e0aebfeeb 100644
--- a/gcc/ada/aspects.ads
+++ b/gcc/ada/aspects.ads
@@ -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,
diff --git a/gcc/ada/gnat_cuda.adb b/gcc/ada/gnat_cuda.adb
index 6273a5dd5c6..9d4caa698bc 100644
--- a/gcc/ada/gnat_cuda.adb
+++ b/gcc/ada/gnat_cuda.adb
@@ -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;
diff --git a/gcc/ada/gnat_cuda.ads b/gcc/ada/gnat_cuda.ads
index d35bc8aca25..fc84bda3e8c 100644
--- a/gcc/ada/gnat_cuda.ads
+++ b/gcc/ada/gnat_cuda.ads
@@ -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
diff --git a/gcc/ada/par-prag.adb b/gcc/ada/par-prag.adb
index 06c7d877fe2..e1258e020f3 100644
--- a/gcc/ada/par-prag.adb
+++ b/gcc/ada/par-prag.adb
@@ -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
diff --git a/gcc/ada/sem_prag.adb b/gcc/ada/sem_prag.adb
index 7386ecc1b93..c985e36d929 100644
--- a/gcc/ada/sem_prag.adb
+++ b/gcc/ada/sem_prag.adb
@@ -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,
diff --git a/gcc/ada/sem_prag.ads b/gcc/ada/sem_prag.ads
index 3d7b00ca557..fed24fdff19 100644
--- a/gcc/ada/sem_prag.ads
+++ b/gcc/ada/sem_prag.ads
@@ -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,
diff --git a/gcc/ada/snames.ads-tmpl b/gcc/ada/snames.ads-tmpl
index a6cf5a0fb89..400adb03bae 100644
--- a/gcc/ada/snames.ads-tmpl
+++ b/gcc/ada/snames.ads-tmpl
@@ -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,
^ permalink raw reply [flat|nested] only message in thread
only message in thread, other threads:[~2021-10-01 6:15 UTC | newest]
Thread overview: (only message) (download: mbox.gz / follow: Atom feed)
-- links below jump to the message on this page --
2021-10-01 6:15 [gcc r12-4018] [Ada] Stub CUDA_Device aspect Pierre-Marie de Rodat
This is a public inbox, see mirroring instructions
for how to clone and mirror all data and code used for this inbox;
as well as URLs for read-only IMAP folder(s) and NNTP newsgroup(s).