cuda/api/cuda.wrp

import ada.wrappers;
import ada.transformations;

wrap wrap_ada_specs ();

match DefiningName ()
wrap w_DefiningName (normalize_ada_name (it));

match DefiningName (x"cuda(?<n>.*)")
wrap w_DefiningName (normalize_ada_name (n));

match DefiningName (x"u?(?<n>.*)_h")
wrap w_DefiningName ("CUDA." & normalize_ada_name (n));

match DefiningName (x"cuda_(?<n>.*)_h")
wrap w_DefiningName ("CUDA." & normalize_ada_name (n));

match DefiningName (x"^cudaArray(.*)")
wrap w_DefiningName ("CUDA_Array\1");

match DefiningName ("cudaExtent") and parent (TypeDecl ())
wrap w_DefiningName ("Extent_T");

match DefiningName (x"^cudaMemoryType$") and parent (TypeDecl ())
wrap w_DefiningName ("Memory_Type_T");

match DefiningName ("cudaAccessPolicyWindow") and parent (TypeDecl ())
wrap w_DefiningName ("Access_Policy_Window_T");

match ParamSpec()
   and f_type_expr ("Interfaces.C.Strings.chars_ptr")
wrap chars_into_string ();

match SubpDecl()
    and child (f_subp_kind ("function"))
    and p_subp_decl_spec.p_returns ("Interfaces.C.Strings.chars_ptr")
wrap chars_into_string ();

match ObjectDecl(child (DefiningName (x"^cuda(Error.*)$")))
wrap error_code_into_exception ("CUDA", "Exception_Registry", "\1");

match NumberDecl (child (d: DefiningName ("^cudaSurfaceType.*$"))) do
    match d ("^cuda(SurfaceType.*)(1D|2D|3D)(.+)$") do
        wrap constant_into_enumeration (
            "Surface_Type",
            normalize_ada_name ("\1") & "_\2_" & normalize_ada_name ("\3"));
    elsmatch d ("^cuda(SurfaceType.*)(1D|2D|3D)$") do
        wrap constant_into_enumeration (
            "Surface_Type",
            normalize_ada_name ("\1") & "_\2");
    elsmatch d ("^cuda(SurfaceType.*)$") do
        wrap constant_into_enumeration (
            "Surface_Type",
            normalize_ada_name ("\1"));
    end;
end;

match SubpDecl ()
   and child (f_subp_kind ("function"))
   and p_subp_decl_spec ().p_returns ().filter (x"driver_types_h.cudaError_t")
   and not p_defining_name ().filter (x"cudaPeekAtLastError|cudaGetLastError")
wrap return_into_exception ("CUDA", "Exception_Registry");

match ParamSpec (x"access .*")
   and not parent (SubpDecl (p_defining_name ().filter (x"atomic")))
wrap access_into_out ();

match ParamSpec (not prev (ParamSpec ()) and x"access .*")
   and parent (SubpDecl (p_defining_name ().filter (x".*Get.*")))
wrap access_into_return ();

match ParamSpec(x"(device|Device).*:.*int.*") do
    match ParamSpec (x"access .*") do
        match ParamSpec (not prev (ParamSpec ())) do
            wrap access_into_return ("Device_T");
        else
            wrap access_into_out ("Device_T");
        end;
    else
        wrap into_explicit_conversion ("Device_T");
    end;
end;

match ParamSpec (x"event.*:.*System.Address")
wrap address_into_return ("CUDA.Driver_Types.Event_T");

match ParamSpec(x"pStream.*:.*System.Address")
wrap address_into_return ("CUDA.Driver_Types.Stream_T");

match ParamSpec (x"devPtr") and parent (SubpDecl (x"cudaMalloc"))
wrap address_into_return ("System.Address");

match ParamSpec (x"ptr") and parent (SubpDecl (x"cudaMallocHost"))
wrap address_into_return ("System.Address");

match ParamSpec (not prev (ParamSpec ())) and parent (SubpDecl (x"cudaEventElapsedTime"))
wrap access_into_return ();

match PackageDecl (p_defining_name ().filter (x"cuda_runtime_api_h"))
weave w_PackageDecl (
    spec_content => @ & i"""
        type Device_T is new Integer;

        function Grid_Dim return CUDA.Vector_Types.Dim3 with Inline;
        function Block_Idx return CUDA.Vector_Types.Uint3 with Inline;
        function Block_Dim return CUDA.Vector_Types.Dim3  with Inline;
        function Thread_Idx return CUDA.Vector_Types.Uint3 with Inline;
        function Warp_Size return Interfaces.C.Int with Inline;""",

    body_content => @ & i"""
        function Grid_Dim return CUDA.Vector_Types.Dim3 is
            function Nctaid_X return Interfaces.C.unsigned
               with Inline, Import, Convention => C, External_Name => "*llvm.nvvm.read.ptx.sreg.nctaid.x";
            function Nctaid_Y return Interfaces.C.unsigned
               with Inline, Import, Convention => C, External_Name => "*llvm.nvvm.read.ptx.sreg.nctaid.y";
            function Nctaid_Z return Interfaces.C.unsigned
               with Inline, Import, Convention => C, External_Name => "*llvm.nvvm.read.ptx.sreg.nctaid.z";
        begin
            return (Nctaid_X, Nctaid_Y, Nctaid_Z);
        end Grid_Dim;

        function Block_Idx return CUDA.Vector_Types.Uint3 is
            function Ctaid_X return Interfaces.C.unsigned
                with Inline, Import, Convention => C, External_Name => "*llvm.nvvm.read.ptx.sreg.ctaid.x";
            function Ctaid_Y return Interfaces.C.unsigned
                with Inline, Import, Convention => C, External_Name => "*llvm.nvvm.read.ptx.sreg.ctaid.y";
            function Ctaid_Z return Interfaces.C.unsigned
                with Inline, Import, Convention => C, External_Name => "*llvm.nvvm.read.ptx.sreg.ctaid.z";
        begin
            return (Ctaid_X, Ctaid_Y, Ctaid_Z);
        end Block_Idx;

        function Block_Dim return CUDA.Vector_Types.Dim3 is
            function Ntid_X return Interfaces.C.unsigned
                with Inline, Import, Convention => C, External_Name => "*llvm.nvvm.read.ptx.sreg.ntid.x";
            function Ntid_Y return Interfaces.C.unsigned
                with Inline, Import, Convention => C, External_Name => "*llvm.nvvm.read.ptx.sreg.ntid.y";
            function Ntid_Z return Interfaces.C.unsigned
                with Inline, Import, Convention => C, External_Name => "*llvm.nvvm.read.ptx.sreg.ntid.z";
        begin
            return (Ntid_X, Ntid_Y, Ntid_Z);
        end Block_Dim;

        function Thread_Idx return CUDA.Vector_Types.Uint3 is
            function Tid_X return Interfaces.C.unsigned
                with Inline, Import, Convention => C, External_Name => "*llvm.nvvm.read.ptx.sreg.tid.x";
            function Tid_Y return Interfaces.C.unsigned
                with Inline, Import, Convention => C, External_Name => "*llvm.nvvm.read.ptx.sreg.tid.y";
            function Tid_Z return Interfaces.C.unsigned
                with Inline, Import, Convention => C, External_Name => "*llvm.nvvm.read.ptx.sreg.tid.z";
        begin
            return (Tid_X, Tid_Y, Tid_Z);
        end Thread_Idx;

        function Warp_Size return Interfaces.C.Int is
            function warpsize return Interfaces.C.Int
                with Inline, Import, Convention => C, External_Name => "*llvm.nvvm.read.ptx.sreg.warpsize";
        begin
            return warpsize;
        end Warp_Size;"""
);