From mboxrd@z Thu Jan 1 00:00:00 1970 Return-Path: Received: by sourceware.org (Postfix, from userid 1914) id AC1573857C65; Fri, 1 Oct 2021 06:15:37 +0000 (GMT) DKIM-Filter: OpenDKIM Filter v2.11.0 sourceware.org AC1573857C65 MIME-Version: 1.0 Content-Transfer-Encoding: 7bit Content-Type: text/plain; charset="utf-8" From: Pierre-Marie de Rodat To: gcc-cvs@gcc.gnu.org Subject: [gcc r12-4018] [Ada] Stub CUDA_Device aspect X-Act-Checkin: gcc X-Git-Author: Ghjuvan Lacambre X-Git-Refname: refs/heads/master X-Git-Oldrev: 28c49456b29e6311bd729aed5adac3af045ff739 X-Git-Newrev: 8279a1125f51b1184289bd406b37f6c31c1b17f5 Message-Id: <20211001061537.AC1573857C65@sourceware.org> Date: Fri, 1 Oct 2021 06:15:37 +0000 (GMT) X-BeenThere: gcc-cvs@gcc.gnu.org X-Mailman-Version: 2.1.29 Precedence: list List-Id: Gcc-cvs mailing list List-Unsubscribe: , List-Archive: List-Help: List-Subscribe: , X-List-Received-Date: Fri, 01 Oct 2021 06:15:37 -0000 https://gcc.gnu.org/g:8279a1125f51b1184289bd406b37f6c31c1b17f5 commit r12-4018-g8279a1125f51b1184289bd406b37f6c31c1b17f5 Author: Ghjuvan Lacambre 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,