Ccallmacro

NEWS.md

@@ -46,7 +46,7 @@ Build system changes
 
 New library functions
 ---------------------
-
+* The `@ccall` macro has been added added to Base. It is a near drop-in replacement for `ccall` with more Julia-like syntax. It also wraps the new `foreigncall` API for varargs of different types, though it lacks the the capability to specify an LLVM calling convention. ([#32748])
 * New functions `mergewith` and `mergewith!` supersede `merge` and `merge!` with `combine`
   argument.  They don't have the restriction for `combine` to be a `Function` and also
   provide one-argument method that returns a closure.  The old methods of `merge` and

base/c.jl

@@ -503,3 +503,176 @@ end
 macro ccallable(rt, def)
     expand_ccallable(rt, def)
 end
+
+# @ccall implementation
+"""
+    ccall_macro_parse(expression)
+
+`ccall_macro_parse` is an implementation detail of `@ccall
+
+it takes an expression like `:(printf("%d"::Cstring, value::Cuint)::Cvoid)`
+returns: a tuple of `(function_name, return_type, arg_types, args)`
+
+The above input outputs this:
+
+    (:printf, :Cvoid, [:Cstring, :Cuint], ["%d", :value])
+"""
+function ccall_macro_parse(expr::Expr)
+    # setup and check for errors
+    if !Meta.isexpr(expr, :(::))
+        throw(ArgumentError("@ccall needs a function signature with a return type"))
+    end
+    rettype = expr.args[2]
+
+    call = expr.args[1]
+    if !Meta.isexpr(call, :call)
+        throw(ArgumentError("@ccall has to take a function call"))
+    end
+
+    # get the function symbols
+    func = let f = call.args[1]
+        if Meta.isexpr(f, :.)
+            :(($(f.args[2]), $(f.args[1])))
+        elseif Meta.isexpr(f, :$)
+            f
+        elseif f isa Symbol
+            QuoteNode(f)
+        else
+            throw(ArgumentError("@ccall function name must be a symbol, a `.` node (e.g. `libc.printf`) or an interpolated function pointer (with `\$`)"))
+        end
+    end
+
+    # detect varargs
+    varargs = nothing
+    argstart = 2
+    callargs = call.args
+    if length(callargs) >= 2 && Meta.isexpr(callargs[2], :parameters)
+        argstart = 3
+        varargs = callargs[2].args
+    end
+
+    # collect args and types
+    args = []
+    types = []
+
+    function pusharg!(arg)
+        if !Meta.isexpr(arg, :(::))
+            throw(ArgumentError("args in @ccall need type annotations. '$arg' doesn't have one."))
+        end
+        push!(args, arg.args[1])
+        push!(types, arg.args[2])
+    end
+
+    for i in argstart:length(callargs)
+        pusharg!(callargs[i])
+    end
+    # add any varargs if necessary
+    nreq = 0
+    if !isnothing(varargs)
+        if length(args) == 0
+            throw(ArgumentError("C ABI prohibits vararg without one required argument"))
+        end
+        nreq = length(args)
+        for a in varargs
+            pusharg!(a)
+        end
+    end
+
+    return func, rettype, types, args, nreq
+end
+
+
+function ccall_macro_lower(convention, func, rettype, types, args, nreq)
+    lowering = []
+    realargs = []
+    gcroots = []
+
+    # if interpolation was used, ensure  variable is a function pointer at runtime.
+    if Meta.isexpr(func, :$)
+        push!(lowering, Expr(:(=), :func, esc(func.args[1])))
+        name = QuoteNode(func.args[1])
+        func = :func
+        check = quote
+            if !isa(func, Ptr{Cvoid})
+                name = $name
+                throw(ArgumentError("interpolated function `$name` was not a Ptr{Cvoid}, but $(typeof(func))"))
+            end
+        end
+        push!(lowering, check)
+    else
+        func = esc(func)
+    end
+
+    for (i, (arg, type)) in enumerate(zip(args, types))
+        sym = Symbol(string("arg", i, "root"))
+        sym2 = Symbol(string("arg", i, ))
+        earg, etype = esc(arg), esc(type)
+        push!(lowering, :($sym = Base.cconvert($etype, $earg)))
+        push!(lowering, :($sym2 = Base.unsafe_convert($etype, $sym)))
+        push!(realargs, sym2)
+        push!(gcroots, sym)
+    end
+    etypes = Expr(:call, Expr(:core, :svec), types...)
+    exp = Expr(:foreigncall,
+               func,
+               esc(rettype),
+               esc(etypes),
+               nreq,
+               QuoteNode(convention),
+               realargs..., gcroots...)
+    push!(lowering, exp)
+
+    return Expr(:block, lowering...)
+end
+
+"""
+    @ccall library.function_name(argvalue1::argtype1, ...)::returntype
+    @ccall function_name(argvalue1::argtype1, ...)::returntype
+    @ccall \$function_pointer(argvalue1::argtype1, ...)::returntype
+
+Call a function in a C-exported shared library, specified by
+`library.function_name`, where `library` is a string constant or
+literal. The library may be omitted, in which case the `function_name`
+is resolved in the current process. Alternatively, `@ccall` may
+also be used to call a function pointer `\$function_pointer`, such as
+one returned by `dlsym`.
+
+Each `argvalue` to `@ccall` is converted to the corresponding
+`argtype`, by automatic insertion of calls to `unsafe_convert(argtype,
+cconvert(argtype, argvalue))`. (See also the documentation for
+[`unsafe_convert`](@ref Base.unsafe_convert) and [`cconvert`](@ref
+Base.cconvert) for further details.) In most cases, this simply
+results in a call to `convert(argtype, argvalue)`.
+
+
+# Examples
+
+    @ccall strlen(s::Cstring)::Csize_t
+
+This calls the C standard library function:
+
+    size_t strlen(char *)
+
+with a Julia variable named `s`. See also `ccall`.
+
+Varargs are supported with the following convention:
+
+    @ccall sprintf("%s = %d"::Cstring ; "foo"::Cstring, foo::Cint)::Cint
+
+The semicolon is used to separate required arguments (of which there
+must be at least one) from variadic arguments.
+
+Example using an external library:
+
+    # C signature of g_uri_escape_string:
+    # char *g_uri_escape_string(const char *unescaped, const char *reserved_chars_allowed, gboolean allow_utf8);
+
+    const glib = "libglib-2.0"
+    @ccall glib.g_uri_escape_string(my_uri::Cstring, ":/"::Cstring, true::Cint)::Cstring
+
+The string literal could also be used directly before the function
+name, if desired `"libglib-2.0".g_uri_escape_string(...`
+"""
+macro ccall(expr)
+    return ccall_macro_lower(:ccall, ccall_macro_parse(expr)...)
+end

base/exports.jl

@@ -911,6 +911,7 @@ export
 
 # C interface
     @cfunction,
+    @ccall,
     cglobal,
     disable_sigint,
     pointer,

test/ccall.jl

@@ -1574,3 +1574,109 @@ let
     ccall(:memcpy, Ptr{Cvoid}, (Ref{Int}, Ref{Int}, Csize_t), dest, src, 3*sizeof(Int))
     @test dest[] == (7,8,9)
 end
+
+
+# @ccall macro
+using Base: ccall_macro_parse, ccall_macro_lower
+@testset "test basic ccall_macro_parse functionality" begin
+    callexpr = :(
+        libc.printf("%s = %d\n"::Cstring ; name::Cstring, value::Cint)::Cvoid
+    )
+    @test ccall_macro_parse(callexpr) == (
+        :((:printf, libc)),               # function
+        :Cvoid,                           # returntype
+        Any[:Cstring, :Cstring, :Cint],   # argument types
+        Any["%s = %d\n", :name, :value],  # argument symbols
+        1                                 # number of required arguments (for varargs)
+    )
+end
+
+@testset "ensure the base-case of @ccall works, including library name and pointer interpolation" begin
+    call = ccall_macro_lower(:ccall, ccall_macro_parse( :( libstring.func(
+        str::Cstring,
+        num1::Cint,
+        num2::Cint
+    )::Cstring))...)
+    @test call == Base.remove_linenums!(
+        quote
+        arg1root = Base.cconvert($(Expr(:escape, :Cstring)), $(Expr(:escape, :str)))
+        arg1 = Base.unsafe_convert($(Expr(:escape, :Cstring)), arg1root)
+        arg2root = Base.cconvert($(Expr(:escape, :Cint)), $(Expr(:escape, :num1)))
+        arg2 = Base.unsafe_convert($(Expr(:escape, :Cint)), arg2root)
+        arg3root = Base.cconvert($(Expr(:escape, :Cint)), $(Expr(:escape, :num2)))
+        arg3 = Base.unsafe_convert($(Expr(:escape, :Cint)), arg3root)
+        $(Expr(:foreigncall,
+               :($(Expr(:escape, :((:func, libstring))))),
+               :($(Expr(:escape, :Cstring))),
+               :($(Expr(:escape, :(($(Expr(:core, :svec)))(Cstring, Cint, Cint))))),
+               0,
+               :(:ccall),
+               :arg1, :arg2, :arg3, :arg1root, :arg2root, :arg3root))
+        end)
+
+    # pointer interpolation
+    call = ccall_macro_lower(:ccall, ccall_macro_parse(:( $(Expr(:$, :fptr))("bar"::Cstring)::Cvoid ))...)
+    @test Base.remove_linenums!(call) == Base.remove_linenums!(
+    quote
+        func = $(Expr(:escape, :fptr))
+        begin
+            if !(func isa Ptr{Cvoid})
+                name = :fptr
+                throw(ArgumentError("interpolated function `$(name)` was not a Ptr{Cvoid}, but $(typeof(func))"))
+            end
+        end
+        arg1root = Base.cconvert($(Expr(:escape, :Cstring)), $(Expr(:escape, "bar")))
+        arg1 = Base.unsafe_convert($(Expr(:escape, :Cstring)), arg1root)
+        $(Expr(:foreigncall, :func, :($(Expr(:escape, :Cvoid))), :($(Expr(:escape, :(($(Expr(:core, :svec)))(Cstring))))), 0, :(:ccall), :arg1, :arg1root))
+    end)
+
+end
+
+@testset "check error paths" begin
+    # missing return type
+    @test_throws ArgumentError("@ccall needs a function signature with a return type") ccall_macro_parse(:( foo(4.0::Cdouble )))
+    # not a function call
+    @test_throws ArgumentError("@ccall has to take a function call") ccall_macro_parse(:( foo::Type ))
+    # missing type annotations on arguments
+    @test_throws ArgumentError("args in @ccall need type annotations. 'x' doesn't have one.") ccall_macro_parse(:( foo(x)::Cint ))
+    # missing type annotations on varargs arguments
+    @test_throws ArgumentError("args in @ccall need type annotations. 'y' doesn't have one.") ccall_macro_parse(:( foo(x::Cint ; y)::Cint ))
+    # no reqired args on varargs call
+    @test_throws ArgumentError("C ABI prohibits vararg without one required argument") ccall_macro_parse(:( foo(; x::Cint)::Cint ))
+    # not a function pointer
+    @test_throws ArgumentError("interpolated function `PROGRAM_FILE` was not a Ptr{Cvoid}, but String") @ccall $PROGRAM_FILE("foo"::Cstring)::Cvoid
+end
+
+# call some c functions
+@testset "run @ccall with C standard library functions" begin
+    @test @ccall(sqrt(4.0::Cdouble)::Cdouble) == 2.0
+
+    str = "hello"
+    buf = Ptr{UInt8}(Libc.malloc((length(str) + 1) * sizeof(Cchar)))
+    @ccall strcpy(buf::Cstring, str::Cstring)::Cstring
+    @test unsafe_string(buf) == str
+    Libc.free(buf)
+
+    # test pointer interpolation
+    str_identity = @cfunction(identity, Cstring, (Cstring,))
+    foo = @ccall $str_identity("foo"::Cstring)::Cstring
+    @test unsafe_string(foo) == "foo"
+    # test interpolation of an expresison that returns a pointer.
+    foo = @ccall $(@cfunction(identity, Cstring, (Cstring,)))("foo"::Cstring)::Cstring
+    @test unsafe_string(foo) == "foo"
+
+    # test of a vararg foreigncall using @ccall
+    strp = Ref{Ptr{Cchar}}(0)
+    fmt = "hi+%hhd-%hhd-%hhd-%hhd-%hhd-%hhd-%hhd-%hhd-%hhd-%hhd-%hhd-%hhd-%hhd-%hhd-%hhd-%.1f-%.1f-%.1f-%.1f-%.1f-%.1f-%.1f-%.1f-%.1f\n"
+
+    len = @ccall asprintf(
+        strp::Ptr{Ptr{Cchar}},
+        fmt::Cstring,
+        ; # begin varargs
+        0x1::UInt8, 0x2::UInt8, 0x3::UInt8, 0x4::UInt8, 0x5::UInt8, 0x6::UInt8, 0x7::UInt8, 0x8::UInt8, 0x9::UInt8, 0xa::UInt8, 0xb::UInt8, 0xc::UInt8, 0xd::UInt8, 0xe::UInt8, 0xf::UInt8,
+        1.1::Cfloat, 2.2::Cfloat, 3.3::Cfloat, 4.4::Cfloat, 5.5::Cfloat, 6.6::Cfloat, 7.7::Cfloat, 8.8::Cfloat, 9.9::Cfloat,
+    )::Cint
+    str = unsafe_string(strp[], len)
+    @ccall free(strp[]::Cstring)::Cvoid
+    @test str == "hi+1-2-3-4-5-6-7-8-9-10-11-12-13-14-15-1.1-2.2-3.3-4.4-5.5-6.6-7.7-8.8-9.9\n"
+end