public inbox for gcc-cvs@sourceware.org help / color / mirror / Atom feed
From: Pierre-Marie de Rodat <pmderodat@gcc.gnu.org> To: gcc-cvs@gcc.gnu.org Subject: [gcc r12-4018] [Ada] Stub CUDA_Device aspect Date: Fri, 1 Oct 2021 06:15:37 +0000 (GMT) [thread overview] Message-ID: <20211001061537.AC1573857C65@sourceware.org> (raw) 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,
reply other threads:[~2021-10-01 6:15 UTC|newest] Thread overview: [no followups] expand[flat|nested] mbox.gz Atom feed
Reply instructions: You may reply publicly to this message via plain-text email using any one of the following methods: * Save the following mbox file, import it into your mail client, and reply-to-all from there: mbox Avoid top-posting and favor interleaved quoting: https://en.wikipedia.org/wiki/Posting_style#Interleaved_style * Reply using the --to, --cc, and --in-reply-to switches of git-send-email(1): git send-email \ --in-reply-to=20211001061537.AC1573857C65@sourceware.org \ --to=pmderodat@gcc.gnu.org \ --cc=gcc-cvs@gcc.gnu.org \ /path/to/YOUR_REPLY https://kernel.org/pub/software/scm/git/docs/git-send-email.html * If your mail client supports setting the In-Reply-To header via mailto: links, try the mailto: linkBe sure your reply has a Subject: header at the top and a blank line before the message body.
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).