'E' | -- external
'G' | -- invocation graph
'I' | -- interrupt
+ 'K' | -- CUDA kernels
'L' | -- linker option
'M' | -- main program
'N' | -- notes
-- Still available:
- 'B' | 'F' | 'H' | 'J' | 'K' | 'O' | 'Q' => False);
+ 'B' | 'F' | 'H' | 'J' | 'O' | 'Q' => False);
------------------------------
-- Add_Invocation_Construct --
ALIs.Table (Id) := (
Afile => F,
Compile_Errors => False,
+ First_CUDA_Kernel => CUDA_Kernels.Last + 1,
First_Interrupt_State => Interrupt_States.Last + 1,
First_Sdep => No_Sdep_Id,
First_Specific_Dispatching => Specific_Dispatching.Last + 1,
First_Unit => No_Unit_Id,
GNATprove_Mode => False,
Invocation_Graph_Encoding => No_Encoding,
+ Last_CUDA_Kernel => CUDA_Kernels.Last,
Last_Interrupt_State => Interrupt_States.Last,
Last_Sdep => No_Sdep_Id,
Last_Specific_Dispatching => Specific_Dispatching.Last,
C := Getc;
end loop A_Loop;
+ -- Acquire 'K' lines if present
+
+ Check_Unknown_Line;
+
+ while C = 'K' loop
+ if Ignore ('K') then
+ Skip_Line;
+
+ else
+ Skip_Space;
+ CUDA_Kernels.Append ((Kernel_Name => Get_Name));
+ ALIs.Table (Id).Last_CUDA_Kernel := CUDA_Kernels.Last;
+ Skip_Eol;
+ end if;
+
+ C := Getc;
+ end loop;
+
-- Acquire P line
Check_Unknown_Line;
type ALI_Id is range 0 .. 99_999_999;
-- Id values used for ALIs table entries
+ type CUDA_Kernel_Id is range 0 .. 99_999_999;
+ -- Id values used for CUDA_Kernel table entries
+
type Unit_Id is range 0 .. 99_999_999;
-- Id values used for Unit table entries
Restrictions : Restrictions_Info;
-- Restrictions information reconstructed from R lines
+ First_CUDA_Kernel : CUDA_Kernel_Id;
+ Last_CUDA_Kernel : CUDA_Kernel_Id'Base;
+ -- These point to the first and last entries in the CUDA_Kernels table
+ -- for this unit. If there are no entries, First_CUDA_Kernel =
+ -- Last_CUDA_Kernel + 1.
+
First_Interrupt_State : Interrupt_State_Id;
Last_Interrupt_State : Interrupt_State_Id'Base;
-- These point to the first and last entries in the interrupt state
Table_Increment => 200,
Table_Name => "ALIs");
+ ---------------------------
+ -- CUDA Kernels Table --
+ ---------------------------
+
+ -- An entry is made in this table for each K (CUDA Kernel) line
+ -- encountered in the input ALI file. The First/Last_CUDA_Kernel_Id
+ -- fields of the ALI file entry show the range of entries defined
+ -- within a particular ALI file.
+
+ type CUDA_Kernel_Record is record
+ Kernel_Name : Name_Id;
+ end record;
+
+ package CUDA_Kernels is new Table.Table (
+ Table_Component_Type => CUDA_Kernel_Record,
+ Table_Index_Type => CUDA_Kernel_Id'Base,
+ Table_Low_Bound => CUDA_Kernel_Id'First,
+ Table_Initial => 100,
+ Table_Increment => 200,
+ Table_Name => "Cuda_Kernels");
+
----------------
-- Unit Table --
----------------
procedure Gen_CodePeer_Wrapper;
-- For CodePeer, generate wrapper which calls user-defined main subprogram
+ procedure Gen_CUDA_Init;
+ -- When CUDA registration code is needed.
+
procedure Gen_Elab_Calls (Elab_Order : Unit_Id_Array);
-- Generate sequence of elaboration calls
Bind_Env_String_Built := True;
end Gen_Bind_Env_String;
+ -------------------
+ -- Gen_CUDA_Init --
+ -------------------
+
+ procedure Gen_CUDA_Init is
+ Unit_Name : constant String :=
+ Get_Name_String (Units.Table (First_Unit_Entry).Uname);
+ Unit : constant String :=
+ Unit_Name (Unit_Name'First .. Unit_Name'Last - 2);
+ begin
+ if not Enable_CUDA_Expansion then
+ return;
+ end if;
+
+ WBI ("");
+ WBI (" ");
+
+ WBI (" function CUDA_Register_Function");
+ WBI (" (Fat_Binary_Handle : System.Address;");
+ WBI (" Func : System.Address;");
+ WBI (" Kernel_Name : Interfaces.C.Strings.chars_ptr;");
+ WBI (" Kernel_Name_2 : Interfaces.C.Strings.chars_ptr;");
+ WBI (" Minus_One : Integer;");
+ WBI (" Nullptr1 : System.Address;");
+ WBI (" Nullptr2 : System.Address;");
+ WBI (" Nullptr3 : System.Address;");
+ WBI (" Nullptr4 : System.Address;");
+ WBI (" Nullptr5 : System.Address) return Boolean;");
+ WBI (" pragma Import");
+ WBI (" (Convention => C,");
+ WBI (" Entity => CUDA_Register_Function,");
+ WBI (" External_Name => ""__cudaRegisterFunction"");");
+ WBI ("");
+ WBI (" function CUDA_Register_Fat_Binary");
+ WBI (" (Fat_Binary : System.Address)");
+ WBI (" return System.Address;");
+ WBI (" pragma Import");
+ WBI (" (Convention => C,");
+ WBI (" Entity => CUDA_Register_Fat_Binary,");
+ WBI (" External_Name => ""__cudaRegisterFatBinary"");");
+ WBI ("");
+ WBI (" function CUDA_Register_Fat_Binary_End");
+ WBI (" (Fat_Binary : System.Address) return Boolean;");
+ WBI (" pragma Import");
+ WBI (" (Convention => C,");
+ WBI (" Entity => CUDA_Register_Fat_Binary_End,");
+ WBI (" External_Name => ""__cudaRegisterFatBinaryEnd"");");
+ WBI ("");
+ WBI (" type Fatbin_Wrapper is record");
+ WBI (" Magic : Interfaces.C.int;");
+ WBI (" Version : Interfaces.C.int;");
+ WBI (" Data : System.Address;");
+ WBI (" Filename_Or_Fatbins : System.Address;");
+ WBI (" end record;");
+ WBI ("");
+ WBI (" Fat_Binary : System.Address;");
+ WBI (" pragma Import");
+ WBI (" (Convention => C,");
+ WBI (" Entity => Fat_Binary,");
+ WBI (" External_Name => ""_binary_" & Unit & "_fatbin_start"");");
+ WBI ("");
+ WBI (" Wrapper : Fatbin_Wrapper :=");
+ WBI (" (16#466243b1#,");
+ WBI (" 1,");
+ WBI (" Fat_Binary'Address,");
+ WBI (" System.Null_Address);");
+ WBI ("");
+ WBI (" Fat_Binary_Handle : System.Address :=");
+ WBI (" CUDA_Register_Fat_Binary (Wrapper'Address);");
+ WBI ("");
+
+ for K in CUDA_Kernels.First .. CUDA_Kernels.Last loop
+ declare
+ K_String : constant String := CUDA_Kernel_Id'Image (K);
+ N : constant String :=
+ K_String (K_String'First + 1 .. K_String'Last);
+ Kernel_Symbol : constant String := "Kernel_" & N;
+ -- K_Symbol is a unique identifier used to derive all symbol names
+ -- related to kernel K.
+
+ Kernel_Addr : constant String := Kernel_Symbol & "_Addr";
+ -- Kernel_Addr is the name of the symbol representing the address
+ -- of the host-side procedure of the kernel. The address is
+ -- pragma-imported and then used while registering the kernel with
+ -- the CUDA runtime.
+ Kernel_String : constant String := Kernel_Symbol & "_String";
+ -- Kernel_String is the name of the C-string containing the name
+ -- of the kernel. It is used for registering the kernel with the
+ -- CUDA runtime.
+ Kernel_Name : constant String :=
+ Get_Name_String (CUDA_Kernels.Table (K).Kernel_Name);
+ -- Kernel_Name is the name of the kernel, after package expansion.
+
+ begin
+ -- Import host-side kernel address.
+ WBI (" " & Kernel_Addr & " : constant System.Address;");
+ WBI (" pragma Import");
+ WBI (" (Convention => C,");
+ WBI (" Entity => " & Kernel_Addr & ",");
+ WBI (" External_Name => """ & Kernel_Name & """);");
+ WBI ("");
+
+ -- Generate C-string containing name of kernel.
+ WBI
+ (" " & Kernel_String & " : Interfaces.C.Strings.Chars_Ptr :=");
+ WBI (" Interfaces.C.Strings.New_Char_Array ("""
+ & Kernel_Name
+ & """);");
+ WBI ("");
+
+ -- Generate call to CUDA runtime to register function.
+ WBI (" CUDA_Register" & N & " : Boolean :=");
+ WBI (" CUDA_Register_Function (");
+ WBI (" Fat_Binary_Handle, ");
+ WBI (" " & Kernel_Addr & ",");
+ WBI (" " & Kernel_String & ",");
+ WBI (" " & Kernel_String & ",");
+ WBI (" -1,");
+ WBI (" System.Null_Address,");
+ WBI (" System.Null_Address,");
+ WBI (" System.Null_Address,");
+ WBI (" System.Null_Address,");
+ WBI (" System.Null_Address);");
+ WBI ("");
+ end;
+ end loop;
+
+ WBI (" CUDA_End : Boolean := ");
+ WBI (" CUDA_Register_Fat_Binary_End(Fat_Binary_Handle);");
+ end Gen_CUDA_Init;
+
--------------------------
-- Gen_CodePeer_Wrapper --
--------------------------
WBI ("with System.Secondary_Stack;");
end if;
+ if Enable_CUDA_Expansion then
+ WBI ("with Interfaces.C;");
+ WBI ("with Interfaces.C.Strings;");
+ end if;
+
Resolve_Binder_Options (Elab_Order);
-- Generate standard with's
Get_Main_Name & """);");
end if;
+ Gen_CUDA_Init;
+
-- Generate version numbers for units, only if needed. Be very safe on
-- the condition.
-- 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.
-- - Empty content of CUDA_Global procedures.
-- - Remove declarations of CUDA_Device 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.
+
end GNAT_CUDA;
with Einfo; use Einfo;
with Einfo.Entities; use Einfo.Entities;
with Einfo.Utils; use Einfo.Utils;
+with Elists; use Elists;
with Errout; use Errout;
with Fname; use Fname;
with Fname.UF; use Fname.UF;
with Lib.Xref; use Lib.Xref;
with Nlists; use Nlists;
with Gnatvsn; use Gnatvsn;
+with GNAT_CUDA; use GNAT_CUDA;
with Opt; use Opt;
with Osint; use Osint;
with Osint.C; use Osint.C;
-- Collect with lines for entries in the context clause of the given
-- compilation unit, Cunit.
+ procedure Output_CUDA_Symbols (Unit_Num : Unit_Number_Type);
+ -- Output CUDA symbols, so that the rest of the toolchain may know what
+ -- symbols need registering with the CUDA runtime.
+
procedure Write_Unit_Information (Unit_Num : Unit_Number_Type);
-- Write out the library information for one unit for which code is
-- generated (includes unit line and with lines).
end loop;
end Collect_Withs;
+ -------------------------
+ -- Output_CUDA_Symbols --
+ -------------------------
+
+ procedure Output_CUDA_Symbols (Unit_Num : Unit_Number_Type) is
+ Unit_Id : constant Node_Id := Unit (Cunit (Unit_Num));
+ Spec_Id : Node_Id;
+ Kernels : Elist_Id;
+ Kernel_Elm : Elmt_Id;
+ Kernel : Entity_Id;
+ begin
+ if not Enable_CUDA_Expansion then
+ return;
+ end if;
+ Spec_Id := (if Nkind (Unit_Id) = N_Package_Body
+ then Corresponding_Spec (Unit_Id)
+ else Defining_Unit_Name (Specification (Unit_Id)));
+ Kernels := Get_CUDA_Kernels (Spec_Id);
+ if No (Kernels) then
+ return;
+ end if;
+
+ Kernel_Elm := First_Elmt (Kernels);
+ while Present (Kernel_Elm) loop
+ Kernel := Node (Kernel_Elm);
+
+ Write_Info_Initiate ('K');
+ Write_Info_Char (' ');
+ Write_Info_Name (Chars (Kernel));
+ Write_Info_Terminate;
+ Next_Elmt (Kernel_Elm);
+ end loop;
+
+ end Output_CUDA_Symbols;
+
----------------------------
-- Write_Unit_Information --
----------------------------
Write_Info_Terminate;
end loop;
+ -- Output CUDA Kernel lines
+
+ for Unit in Units.First .. Last_Unit loop
+ if Present (Cunit (Unit)) then
+ Output_CUDA_Symbols (Unit);
+ end if;
+ end loop;
+
-- Output parameters ('P') line
Write_Info_Initiate ('P');
-- WARNING: There is a matching C declaration of this variable in fe.h
+ Enable_CUDA_Expansion : Boolean := False;
+ -- GNAT, GNATBIND
+ -- Set to True to enable CUDA host expansion:
+ -- - Removal of CUDA_Global and CUDA_Device symbols
+ -- - Generation of kernel registration code in packages
+
Error_Msg_Line_Length : Nat := 0;
-- GNAT
-- Records the error message line length limit. If this is set to zero,
elsif Underscore then
Set_Underscored_Debug_Flag (C);
+ if Debug_Flag_Underscore_C then
+ Enable_CUDA_Expansion := True;
+ end if;
Underscore := False;
-- letter
elsif Underscore then
Set_Underscored_Debug_Flag (C);
Store_Compilation_Switch ("-gnatd_" & C);
+ if Debug_Flag_Underscore_C then
+ Enable_CUDA_Expansion := True;
+ end if;
-- Normal flag
projects / platform / upstream / gcc.git / commitdiff