From aa40952cda882dd9e6a116247281aeeac0d38baa Mon Sep 17 00:00:00 2001 From: Ghjuvan Lacambre Date: Tue, 17 Aug 2021 10:37:02 +0200 Subject: [PATCH] [Ada] Implement CUDA_Device gcc/ada/ * gnat_cuda.adb (Remove_CUDA_Device_Entities): New function. (Expand_CUDA_Package): Call Remove_CUDA_Device_Entities. * gnat_cuda.ads (Expand_CUDA_Package): Expand documentation. * sem_prag.adb (Analyze_Pragma): Remove warning about CUDA_Device not being implemented. --- gcc/ada/gnat_cuda.adb | 94 ++++++++++++++++++++++++++++++++++++++++++--------- gcc/ada/gnat_cuda.ads | 7 ++-- gcc/ada/sem_prag.adb | 9 ++--- 3 files changed, 88 insertions(+), 22 deletions(-) diff --git a/gcc/ada/gnat_cuda.adb b/gcc/ada/gnat_cuda.adb index fe080ae..a1739be 100644 --- a/gcc/ada/gnat_cuda.adb +++ b/gcc/ada/gnat_cuda.adb @@ -25,22 +25,25 @@ -- This package defines CUDA-specific datastructures and functions. -with Atree; use Atree; -with Debug; use Debug; -with Elists; use Elists; -with Namet; use Namet; -with Nlists; use Nlists; -with Nmake; use Nmake; -with Rtsfind; use Rtsfind; -with Sinfo; use Sinfo; -with Sinfo.Nodes; use Sinfo.Nodes; -with Stringt; use Stringt; -with Tbuild; use Tbuild; -with Uintp; use Uintp; -with Sem; use Sem; -with Sem_Aux; use Sem_Aux; -with Sem_Util; use Sem_Util; -with Snames; use Snames; +with Atree; use Atree; +with Debug; use Debug; +with Einfo.Entities; use Einfo.Entities; +with Einfo.Utils; use Einfo.Utils; +with Elists; use Elists; +with Errout; use Errout; +with Namet; use Namet; +with Nlists; use Nlists; +with Nmake; use Nmake; +with Rtsfind; use Rtsfind; +with Sem; use Sem; +with Sem_Aux; use Sem_Aux; +with Sem_Util; use Sem_Util; +with Sinfo.Nodes; use Sinfo.Nodes; +with Sinfo; use Sinfo; +with Snames; use Snames; +with Stringt; use Stringt; +with Tbuild; use Tbuild; +with Uintp; use Uintp; with GNAT.HTable; @@ -120,6 +123,10 @@ package body GNAT_CUDA is -- are declared within package body Pack_Body. Returns No_Elist if Pack_Id -- does not contain such procedures. + procedure Remove_CUDA_Device_Entities (Pack_Id : Entity_Id); + -- Removes all entities marked with the CUDA_Device pragma from package + -- Pack_Id. Must only be called when compiling for the host. + procedure Set_CUDA_Device_Entities (Pack_Id : Entity_Id; E : Elist_Id); @@ -226,6 +233,13 @@ package body GNAT_CUDA is Empty_CUDA_Global_Subprograms (N); + -- Remove CUDA_Device entities (except if they are also CUDA_Host), as + -- they can only be referenced from the device and might reference + -- device-only symbols. + + Remove_CUDA_Device_Entities + (Package_Specification (Corresponding_Spec (N))); + -- If procedures marked with CUDA_Global have been defined within N, -- we need to register them with the CUDA runtime at program startup. -- This requires multiple declarations and function calls which need @@ -718,6 +732,54 @@ package body GNAT_CUDA is Analyze (New_Stmt); end Build_And_Insert_CUDA_Initialization; + --------------------------------- + -- Remove_CUDA_Device_Entities -- + --------------------------------- + + procedure Remove_CUDA_Device_Entities (Pack_Id : Entity_Id) is + Device_Entities : constant Elist_Id := + Get_CUDA_Device_Entities (Pack_Id); + Device_Elmt : Elmt_Id; + Device_Entity : Entity_Id; + Bod : Node_Id; + begin + pragma Assert (Debug_Flag_Underscore_C); + + if Device_Entities = No_Elist then + return; + end if; + + Device_Elmt := First_Elmt (Device_Entities); + while Present (Device_Elmt) loop + Device_Entity := Node (Device_Elmt); + Next_Elmt (Device_Elmt); + + case Ekind (Device_Entity) is + when E_Function | E_Procedure => + Bod := Subprogram_Body (Device_Entity); + + if Nkind (Parent (Bod)) = N_Subunit + and then Present (Corresponding_Stub (Parent (Bod))) + then + Error_Msg_N + ("Cuda_Device not suported on separate subprograms", + Corresponding_Stub (Parent (Bod))); + else + Remove (Bod); + Remove (Subprogram_Spec (Device_Entity)); + end if; + + when E_Variable | E_Constant => + Remove (Declaration_Node (Device_Entity)); + + when others => + pragma Assert (False); + end case; + + Remove_Entity_And_Homonym (Device_Entity); + end loop; + end Remove_CUDA_Device_Entities; + ------------------------------ -- Set_CUDA_Device_Entities -- ------------------------------ diff --git a/gcc/ada/gnat_cuda.ads b/gcc/ada/gnat_cuda.ads index fc84bda..390f5de 100644 --- a/gcc/ada/gnat_cuda.ads +++ b/gcc/ada/gnat_cuda.ads @@ -86,7 +86,10 @@ package GNAT_CUDA is -- entity of its parent package body. procedure Expand_CUDA_Package (N : Node_Id); - -- When compiling for the host, generate code to register kernels with the - -- CUDA runtime and post-process kernels. + -- When compiling for the host: + -- - Generate code to register kernels with the CUDA runtime and + -- post-process kernels. + -- - Empty content of CUDA_Global procedures. + -- - Remove declarations of CUDA_Device entities. end GNAT_CUDA; diff --git a/gcc/ada/sem_prag.adb b/gcc/ada/sem_prag.adb index c985e36..43bf577 100644 --- a/gcc/ada/sem_prag.adb +++ b/gcc/ada/sem_prag.adb @@ -14849,9 +14849,9 @@ package body Sem_Prag is begin GNAT_Pragma; Check_Arg_Count (1); - Arg_Node := Get_Pragma_Arg (Arg1); + Check_Arg_Is_Library_Level_Local_Name (Arg1); - Check_Arg_Is_Library_Level_Local_Name (Arg_Node); + Arg_Node := Get_Pragma_Arg (Arg1); Device_Entity := Entity (Arg_Node); if Ekind (Device_Entity) in E_Variable @@ -14859,8 +14859,9 @@ package body Sem_Prag is | E_Procedure | E_Function then - Add_CUDA_Device_Entity (Scope (Device_Entity), Device_Entity); - Error_Msg_N ("??& not implemented yet", N); + Add_CUDA_Device_Entity + (Package_Specification_Of_Scope (Scope (Device_Entity)), + Device_Entity); else Error_Msg_NE ("& must be constant, variable or subprogram", -- 2.7.4