------------------------------------------------------------------------------ -- -- -- GNAT COMPILER COMPONENTS -- -- -- -- C U D A -- -- -- -- B o d y -- -- -- -- Copyright (C) 2010-2022, Free Software Foundation, Inc. -- -- -- -- GNAT is free software; you can redistribute it and/or modify it under -- -- terms of the GNU General Public License as published by the Free Soft- -- -- ware Foundation; either version 3, or (at your option) any later ver- -- -- sion. GNAT is distributed in the hope that it will be useful, but WITH- -- -- OUT ANY WARRANTY; without even the implied warranty of MERCHANTABILITY -- -- or FITNESS FOR A PARTICULAR PURPOSE. See the GNU General Public License -- -- for more details. You should have received a copy of the GNU General -- -- Public License distributed with GNAT; see file COPYING3. If not, go to -- -- http://www.gnu.org/licenses for a complete copy of the license. -- -- -- -- GNAT was originally developed by the GNAT team at New York University. -- -- Extensive contributions were provided by Ada Core Technologies Inc. -- -- -- ------------------------------------------------------------------------------ -- This package defines CUDA-specific datastructures and functions. 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; package body GNAT_CUDA is -------------------------------------- -- Hash Table for CUDA_Global nodes -- -------------------------------------- type Hash_Range is range 0 .. 510; -- Size of hash table headers 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, 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_Global. The values are -- Elists of the marked procedures. procedure Build_And_Insert_CUDA_Initialization (N : Node_Id); -- Builds declarations necessary for CUDA initialization and inserts them -- in N, the package body that contains CUDA_Global nodes. These -- declarations are: -- -- * A symbol to hold the pointer P to the CUDA fat binary. -- -- * A type definition T for a wrapper that contains the pointer to the -- CUDA fat binary. -- -- * An object of the aforementioned type to hold the aforementioned -- pointer. -- -- * For each CUDA_Global procedure in the package, a declaration of a C -- string containing the function's name. -- -- * A procedure that takes care of calling CUDA functions that register -- CUDA_Global procedures with the runtime. procedure Empty_CUDA_Global_Subprograms (Pack_Id : Entity_Id); -- For all subprograms marked CUDA_Global in Pack_Id, remove declarations -- and replace statements with a single null statement. -- This is required because CUDA_Global subprograms could be referring to -- device-only symbols, which would result in unknown symbols at link time -- if kept around. -- We choose to empty CUDA_Global subprograms rather than completely -- removing them from the package because registering CUDA_Global -- subprograms with the CUDA runtime on the host requires knowing the -- subprogram's host-side address. 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 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); -- 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 -- --------------------- procedure Add_CUDA_Kernel (Pack_Id : Entity_Id; Kernel : Entity_Id) is Kernels : Elist_Id := Get_CUDA_Kernels (Pack_Id); begin if Kernels = No_Elist then Kernels := New_Elmt_List; Set_CUDA_Kernels (Pack_Id, Kernels); end if; Append_Elmt (Kernel, Kernels); end Add_CUDA_Kernel; ----------------------------------- -- Empty_CUDA_Global_Subprograms -- ----------------------------------- procedure Empty_CUDA_Global_Subprograms (Pack_Id : Entity_Id) is Spec_Id : constant Node_Id := Corresponding_Spec (Pack_Id); Kernels : constant Elist_Id := Get_CUDA_Kernels (Spec_Id); Kernel_Elm : Elmt_Id; Kernel : Entity_Id; Kernel_Body : Node_Id; Null_Body : Entity_Id; Loc : Source_Ptr; begin -- It is an error to empty CUDA_Global subprograms when not compiling -- for the host. pragma Assert (Debug_Flag_Underscore_C); if No (Kernels) then return; end if; Kernel_Elm := First_Elmt (Kernels); while Present (Kernel_Elm) loop Kernel := Node (Kernel_Elm); Kernel_Body := Subprogram_Body (Kernel); Loc := Sloc (Kernel_Body); Null_Body := Make_Subprogram_Body (Loc, Specification => Subprogram_Specification (Kernel), Declarations => New_List, Handled_Statement_Sequence => Make_Handled_Sequence_Of_Statements (Loc, Statements => New_List (Make_Null_Statement (Loc)))); Rewrite (Kernel_Body, Null_Body); Next_Elmt (Kernel_Elm); end loop; end Empty_CUDA_Global_Subprograms; ------------------------- -- Expand_CUDA_Package -- ------------------------- procedure Expand_CUDA_Package (N : Node_Id) is begin -- If not compiling for the host, do not do anything. if not Debug_Flag_Underscore_C then return; end if; -- Remove the content (both declarations and statements) of CUDA_Global -- procedures. This is required because CUDA_Global functions could be -- referencing entities available only on the device, which would result -- in unknown symbol errors at link time. 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 -- to be appended to N's declarations. Build_And_Insert_CUDA_Initialization (N); end Expand_CUDA_Package; ---------- -- Hash -- ---------- function Hash (F : Entity_Id) return Hash_Range is begin 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 -- ---------------------- function Get_CUDA_Kernels (Pack_Id : Entity_Id) return Elist_Id is begin return CUDA_Kernels_Table.Get (Pack_Id); end Get_CUDA_Kernels; ------------------------------------------ -- Build_And_Insert_CUDA_Initialization -- ------------------------------------------ procedure Build_And_Insert_CUDA_Initialization (N : Node_Id) is -- For the following kernel declaration: -- -- package body is -- procedure (X : Integer) with CUDA_Global; -- end package; -- -- Insert the following declarations: -- -- Fat_Binary : System.Address; -- pragma Import -- (Convention => C, -- Entity => Fat_Binary, -- External_Name => "_binary__fatbin_start"); -- -- Wrapper : Fatbin_Wrapper := -- (16#466243b1#, 1, Fat_Binary'Address, System.Null_Address); -- -- Proc_Symbol_Name : Interfaces.C.Strings.Chars_Ptr := -- Interfaces.C.Strings.New_Char_Array(""); -- -- Fat_Binary_Handle : System.Address := -- CUDA.Internal.Register_Fat_Binary (Wrapper'Address); -- -- procedure Initialize_CUDA_Kernel is -- begin -- CUDA.Internal.Register_Function -- (Fat_Binary_Handle, -- 'Address, -- Proc_Symbol_Name, -- Proc_Symbol_Name, -- -1, -- System.Null_Address, -- System.Null_Address, -- System.Null_Address, -- System.Null_Address, -- System.Null_Address); -- CUDA.Internal.Register_Fat_Binary_End (Fat_Binary_Handle); -- end Initialize_CUDA_Kernel; -- -- Proc_Symbol_Name is the name of the procedure marked with -- CUDA_Global. The CUDA runtime uses this in order to be able to find -- kernels in the fat binary, so it has to match the name of the -- procedure symbol compiled by GNAT_LLVM. When looking at the code -- generated by NVCC, it seems that the CUDA runtime also needs the name -- of the procedure symbol of the host. Fortuantely, the procedures are -- named the same way whether they are compiled for the host or the -- device, so we use Vector_Add_Name to specify the name of the symbol -- for both the host and the device. The meaning of the rest of the -- arguments is unknown. function Build_CUDA_Init_Proc (Init_Id : Entity_Id; CUDA_Kernels : Elist_Id; Handle_Id : Entity_Id; Pack_Decls : List_Id) return Node_Id; -- Create the declaration of Init_Id, the function that binds each -- kernel present in CUDA_Kernels with the fat binary Handle_Id and then -- tells the CUDA runtime that no new function will be bound to the fat -- binary. function Build_Fat_Binary_Declaration (Bin_Id : Entity_Id) return Node_Id; -- Create a declaration for Bin_Id, the entity that represents the fat -- binary, i.e.: -- -- Bin_Id : System.Address; function Build_Fat_Binary_Handle_Declaration (Handle_Id : Entity_Id; Wrapper_Id : Entity_Id) return Node_Id; -- Create the declaration of Handle_Id, a System.Address that will -- receive the results of passing the address of Wrapper_Id to -- CUDA.Register_Fat_Binary, i.e.: -- -- Handle_Id : System.Address := -- CUDA.Register_Fat_Binary (Wrapper_Id'Address) function Build_Fat_Binary_Wrapper_Declaration (Wrapper_Id : Entity_Id; Bin_Id : Entity_Id) return Node_Id; -- Create the declaration of the fat binary wrapper Wrapper_Id, which -- holds magic numbers and Bin_Id'Address, i.e.: -- -- Wrapper_Id : System.Address := -- (16#466243b1#, 1, Bin_Id'Address, System.Null_Address); function Build_Import_Pragma (Bin_Id : Entity_Id; Pack_Body : Node_Id) return Node_Id; -- Create a pragma that will bind the fat binary Bin_Id to its external -- symbol. N is the package body Bin_Id belongs to, i.e.: -- -- pragma Import -- (Convention => C, -- Entity => Bin_Id, -- External_Name => "_binary__fatbin_start"); function Build_Kernel_Name_Declaration (Kernel : Entity_Id) return Node_Id; -- Create the declaration of a C string that contains the name of -- Kernel's symbol, i.e.: -- -- Kernel : Interfaces.C.Strings.Chars_Ptr := -- Interfaces.C.Strings.New_Char_Array(""); function Build_Register_Procedure_Call (Loc : Source_Ptr; Bin : Entity_Id; Kernel : Entity_Id; Kernel_Name : Entity_Id) return Node_Id; -- Return a call to CUDA.Internal.Register_Function that binds Kernel -- (the entity of a procedure) to the symbol described by the C string -- Kernel_Name in the fat binary Bin, using Loc as location. -------------------------- -- Build_CUDA_Init_Proc -- -------------------------- function Build_CUDA_Init_Proc (Init_Id : Entity_Id; CUDA_Kernels : Elist_Id; Handle_Id : Entity_Id; Pack_Decls : List_Id) return Node_Id is Loc : constant Source_Ptr := Sloc (Init_Id); Stmts : constant List_Id := New_List; -- List of statements that will be used by the cuda initialization -- function. New_Stmt : Node_Id; -- Temporary variable to hold the various newly-created nodes Kernel_Elmt : Elmt_Id; Kernel_Id : Entity_Id; begin -- For each CUDA_Global function, declare a C string that holds -- its symbol's name (i.e. packagename __ functionname). -- Also create a function call to CUDA.Internal.Register_Function -- that takes the declared C string, a pointer to the function and -- the fat binary handle. Kernel_Elmt := First_Elmt (CUDA_Kernels); while Present (Kernel_Elmt) loop Kernel_Id := Node (Kernel_Elmt); New_Stmt := Build_Kernel_Name_Declaration (Kernel_Id); Append (New_Stmt, Pack_Decls); Analyze (New_Stmt); Append_To (Stmts, Build_Register_Procedure_Call (Loc, Bin => Handle_Id, Kernel => Kernel_Id, Kernel_Name => Defining_Entity (New_Stmt))); Next_Elmt (Kernel_Elmt); end loop; -- Finish the CUDA initialization function: add a call to -- register_fat_binary_end, to let the CUDA runtime know that we -- won't be registering any other symbol with the current fat binary. Append_To (Stmts, Make_Procedure_Call_Statement (Loc, Name => New_Occurrence_Of (RTE (RE_Register_Fat_Binary_End), Loc), Parameter_Associations => New_List (New_Occurrence_Of (Handle_Id, Loc)))); -- Now that we have all the declarations and calls we need, we can -- build and and return the initialization procedure. return Make_Subprogram_Body (Loc, Specification => Make_Procedure_Specification (Loc, Init_Id), Declarations => New_List, Handled_Statement_Sequence => Make_Handled_Sequence_Of_Statements (Loc, Stmts)); end Build_CUDA_Init_Proc; ---------------------------------- -- Build_Fat_Binary_Declaration -- ---------------------------------- function Build_Fat_Binary_Declaration (Bin_Id : Entity_Id) return Node_Id is begin return Make_Object_Declaration (Sloc (Bin_Id), Defining_Identifier => Bin_Id, Object_Definition => New_Occurrence_Of (RTE (RE_Address), Sloc (Bin_Id))); end Build_Fat_Binary_Declaration; ----------------------------------------- -- Build_Fat_Binary_Handle_Declaration -- ----------------------------------------- function Build_Fat_Binary_Handle_Declaration (Handle_Id : Entity_Id; Wrapper_Id : Entity_Id) return Node_Id is Loc : constant Source_Ptr := Sloc (Handle_Id); begin -- Generate: -- Handle_Id : System.Address := -- CUDA.Register_Fat_Binary (Wrapper_Id'Address); return Make_Object_Declaration (Loc, Defining_Identifier => Handle_Id, Object_Definition => New_Occurrence_Of (RTE (RE_Address), Loc), Expression => Make_Function_Call (Loc, Name => New_Occurrence_Of (RTE (RE_Register_Fat_Binary), Loc), Parameter_Associations => New_List ( Make_Attribute_Reference (Loc, Prefix => New_Occurrence_Of (Wrapper_Id, Loc), Attribute_Name => Name_Address)))); end Build_Fat_Binary_Handle_Declaration; ------------------------------------------ -- Build_Fat_Binary_Wrapper_Declaration -- ------------------------------------------ function Build_Fat_Binary_Wrapper_Declaration (Wrapper_Id : Entity_Id; Bin_Id : Entity_Id) return Node_Id is Loc : constant Source_Ptr := Sloc (Wrapper_Id); begin return Make_Object_Declaration (Loc, Defining_Identifier => Wrapper_Id, Object_Definition => New_Occurrence_Of (RTE (RE_Fatbin_Wrapper), Loc), Expression => Make_Aggregate (Loc, Expressions => New_List ( Make_Integer_Literal (Loc, UI_From_Int (16#466243b1#)), Make_Integer_Literal (Loc, Uint_1), Make_Attribute_Reference (Loc, Prefix => New_Occurrence_Of (Bin_Id, Loc), Attribute_Name => Name_Address), New_Occurrence_Of (RTE (RE_Null_Address), Loc)))); end Build_Fat_Binary_Wrapper_Declaration; ------------------------- -- Build_Import_Pragma -- ------------------------- function Build_Import_Pragma (Bin_Id : Entity_Id; Pack_Body : Node_Id) return Node_Id is Loc : constant Source_Ptr := Sloc (Bin_Id); External_Symbol : String_Id; begin Start_String; Store_String_Chars ("_binary_" & Get_Name_String (Chars (Defining_Unit_Name (Pack_Body))) & "_fatbin_start"); External_Symbol := End_String; return Make_Pragma (Loc, Pragma_Identifier => Make_Identifier (Loc, Name_Import), Pragma_Argument_Associations => New_List ( Make_Pragma_Argument_Association (Loc, Chars => Name_Convention, Expression => Make_Identifier (Loc, Name_C)), Make_Pragma_Argument_Association (Loc, Chars => Name_Entity, Expression => New_Occurrence_Of (Bin_Id, Loc)), Make_Pragma_Argument_Association (Loc, Chars => Name_External_Name, Expression => Make_String_Literal (Loc, External_Symbol)))); end Build_Import_Pragma; ------------------------------------- -- Build_Kernel_Name_Declaration -- ------------------------------------- function Build_Kernel_Name_Declaration (Kernel : Entity_Id) return Node_Id is Loc : constant Source_Ptr := Sloc (Kernel); Package_Name : constant String := Get_Name_String (Chars (Scope (Kernel))); Symbol_Name : constant String := Get_Name_String (Chars (Kernel)); Kernel_Name : String_Id; begin Start_String; Store_String_Chars (Package_Name & "__" & Symbol_Name); Kernel_Name := End_String; return Make_Object_Declaration (Loc, Defining_Identifier => Make_Temporary (Loc, 'C'), Object_Definition => New_Occurrence_Of (RTE (RE_Chars_Ptr), Loc), Expression => Make_Function_Call (Loc, Name => New_Occurrence_Of (RTE (RE_New_Char_Array), Loc), Parameter_Associations => New_List ( Make_String_Literal (Loc, Kernel_Name)))); end Build_Kernel_Name_Declaration; ----------------------------------- -- Build_Register_Procedure_Call -- ----------------------------------- function Build_Register_Procedure_Call (Loc : Source_Ptr; Bin : Entity_Id; Kernel : Entity_Id; Kernel_Name : Entity_Id) return Node_Id is Args : constant List_Id := New_List; begin -- First argument: the handle of the fat binary Append (New_Occurrence_Of (Bin, Loc), Args); -- Second argument: the host address of the function that is marked -- with CUDA_Global. Append_To (Args, Make_Attribute_Reference (Loc, Prefix => New_Occurrence_Of (Kernel, Loc), Attribute_Name => Name_Address)); -- Third argument, the name of the function on the host Append (New_Occurrence_Of (Kernel_Name, Loc), Args); -- Fourth argument, the name of the function on the device Append (New_Occurrence_Of (Kernel_Name, Loc), Args); -- Fith argument: -1. Meaning unknown - this has been copied from -- LLVM. Append (Make_Integer_Literal (Loc, Uint_Minus_1), Args); -- Args 6, 7, 8, 9, 10: Null pointers. Again, meaning unknown for Arg_Count in 6 .. 10 loop Append_To (Args, New_Occurrence_Of (RTE (RE_Null_Address), Loc)); end loop; -- Build the call to CUDARegisterFunction, passing the argument list -- we just built. return Make_Procedure_Call_Statement (Loc, Name => New_Occurrence_Of (RTE (RE_Register_Function), Loc), Parameter_Associations => Args); end Build_Register_Procedure_Call; -- Local declarations Loc : constant Source_Ptr := Sloc (N); Spec_Id : constant Node_Id := Corresponding_Spec (N); -- The specification of the package we're adding a cuda init func to Pack_Decls : constant List_Id := Declarations (N); CUDA_Node_List : constant Elist_Id := Get_CUDA_Kernels (Spec_Id); -- CUDA nodes that belong to the package CUDA_Init_Func : Entity_Id; -- Entity of the cuda init func Fat_Binary : Entity_Id; -- Entity of the fat binary of N. Bound to said fat binary by a pragma Fat_Binary_Handle : Entity_Id; -- Entity of the result of passing the fat binary wrapper to -- CUDA.Register_Fat_Binary. Fat_Binary_Wrapper : Entity_Id; -- Entity of a record that holds a bunch of magic numbers and a -- reference to Fat_Binary. New_Stmt : Node_Id; -- Node to store newly-created declarations -- Start of processing for Build_And_Insert_CUDA_Initialization begin if CUDA_Node_List = No_Elist then return; end if; Fat_Binary := Make_Temporary (Loc, 'C'); New_Stmt := Build_Fat_Binary_Declaration (Fat_Binary); Append_To (Pack_Decls, New_Stmt); Analyze (New_Stmt); New_Stmt := Build_Import_Pragma (Fat_Binary, N); Append_To (Pack_Decls, New_Stmt); Analyze (New_Stmt); Fat_Binary_Wrapper := Make_Temporary (Loc, 'C'); New_Stmt := Build_Fat_Binary_Wrapper_Declaration (Wrapper_Id => Fat_Binary_Wrapper, Bin_Id => Fat_Binary); Append_To (Pack_Decls, New_Stmt); Analyze (New_Stmt); Fat_Binary_Handle := Make_Temporary (Loc, 'C'); New_Stmt := Build_Fat_Binary_Handle_Declaration (Fat_Binary_Handle, Fat_Binary_Wrapper); Append_To (Pack_Decls, New_Stmt); Analyze (New_Stmt); CUDA_Init_Func := Make_Temporary (Loc, 'C'); New_Stmt := Build_CUDA_Init_Proc (Init_Id => CUDA_Init_Func, CUDA_Kernels => CUDA_Node_List, Handle_Id => Fat_Binary_Handle, Pack_Decls => Pack_Decls); Append_To (Pack_Decls, New_Stmt); Analyze (New_Stmt); New_Stmt := Make_Procedure_Call_Statement (Loc, Name => New_Occurrence_Of (CUDA_Init_Func, Loc)); Append_To (Pack_Decls, New_Stmt); 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 -- ------------------------------ 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; Kernels : Elist_Id) is begin pragma Assert (Get_CUDA_Kernels (Pack_Id) = No_Elist); CUDA_Kernels_Table.Set (Pack_Id, Kernels); end Set_CUDA_Kernels; end GNAT_CUDA;