1/* Part of SWI-Prolog 2 3 Author: Jan Wielemaker 4 E-mail: J.Wielemaker@vu.nl 5 WWW: http://www.swi-prolog.org 6 Copyright (c) 2018-2023, VU University Amsterdam 7 SWI-Prolog Solutions b.v. 8 All rights reserved. 9 10 Redistribution and use in source and binary forms, with or without 11 modification, are permitted provided that the following conditions 12 are met: 13 14 1. Redistributions of source code must retain the above copyright 15 notice, this list of conditions and the following disclaimer. 16 17 2. Redistributions in binary form must reproduce the above copyright 18 notice, this list of conditions and the following disclaimer in 19 the documentation and/or other materials provided with the 20 distribution. 21 22 THIS SOFTWARE IS PROVIDED BY THE COPYRIGHT HOLDERS AND CONTRIBUTORS 23 "AS IS" AND ANY EXPRESS OR IMPLIED WARRANTIES, INCLUDING, BUT NOT 24 LIMITED TO, THE IMPLIED WARRANTIES OF MERCHANTABILITY AND FITNESS 25 FOR A PARTICULAR PURPOSE ARE DISCLAIMED. IN NO EVENT SHALL THE 26 COPYRIGHT OWNER OR CONTRIBUTORS BE LIABLE FOR ANY DIRECT, INDIRECT, 27 INCIDENTAL, SPECIAL, EXEMPLARY, OR CONSEQUENTIAL DAMAGES (INCLUDING, 28 BUT NOT LIMITED TO, PROCUREMENT OF SUBSTITUTE GOODS OR SERVICES; 29 LOSS OF USE, DATA, OR PROFITS; OR BUSINESS INTERRUPTION) HOWEVER 30 CAUSED AND ON ANY THEORY OF LIABILITY, WHETHER IN CONTRACT, STRICT 31 LIABILITY, OR TORT (INCLUDING NEGLIGENCE OR OTHERWISE) ARISING IN 32 ANY WAY OUT OF THE USE OF THIS SOFTWARE, EVEN IF ADVISED OF THE 33 POSSIBILITY OF SUCH DAMAGE. 34*/ 35 36:- module(ffi, 37 [ c_import/3, % +Header, +Flags, +Functions 38 39 % Memory access predicates 40 c_calloc/4, % -Ptr, +Type, +Size, +Count 41 c_free/1, % +Ptr 42 c_disown/1, % +Ptr 43 c_typeof/2, % +Ptr, -Type 44 c_load/4, % +Ptr, +Offset, +Type, -Value 45 c_store/4, % +Ptr, +Offset, +Type, +Value 46 c_offset/6, % +Ptr0, +Off, +Type, +Size, +Count, -Ptr 47 c_sizeof/2, % +Type, -Bytes 48 c_alignof/2, % +Type, -Bytes 49 c_address/2, % +Ptr, -AsInt 50 c_dim/3, % +Ptr, -Count, -ElemSize 51 52 c_alloc/2, % -Ptr, +Type 53 c_load/2, % +Location, -Value 54 c_store/2, % +Location, +Value 55 c_cast/3, % +Type, +PtrIn, -PtrOut 56 c_nil/1, % -Ptr 57 c_is_nil/1, % @Ptr 58 59 c_struct/2, % +Name, +Fields 60 c_union/2, % +Name, +Fields 61 62 c_current_enum/3, % :Id, ?Enum, ?Value 63 c_current_struct/1, % :Name 64 c_current_struct/3, % :Name, -Size, -Alignment 65 c_current_struct_field/4, % :Name, ?Field, ?Offset, ?Type 66 c_current_union/1, % :Name 67 c_current_union/3, % :Name, -Size, -Alignment 68 c_current_union_field/3, % :Name, ?Field, ?Type 69 c_current_typedef/2, % :Name, -Type 70 71 c_expand_type/2, % :TypeIn, -TypeOut 72 c_type_size_align/3, % :Type, -Size, -Alignment 73 74 c_struct_dict/2, % ?Ptr, ?Dict 75 76 c_array_to_list/2, % +Ptr, -List 77 c_array_to_list/3, % +Ptr, +Count, -List 78 c_array_from_list/2, % -Ptr, +List 79 c_array_from_list/3, % -Ptr, +Count, +List 80 c_array_from_compound/2, % -Ptr, +Compound 81 c_array_from_compound/3, % -Ptr, +Count, +Compound 82 c_array_to_compound/3, % +Ptr, +Name, -Compound 83 c_array_to_compound/4, % +Ptr, +Count, +Name, -Compound 84 85 86 c_enum_in/3, % :Id, +Enum, -Int 87 c_enum_out/3, % :Id, +Enum, +Int 88 89 c_alloc_string/3, % -Ptr, +Data, +Encoding 90 c_load_string/4, % +Ptr, -Data, +Type, +Encoding 91 c_load_string/5, % +Ptr, +Len, -Data, +Type, +Encoding 92 93 c_errno/1, % -Integer 94 95 op(200, fy, *), % for pointer type declarations 96 op(100, xfx, ~), % Type~FreeFunc 97 op(20, yf, []) 98 ]). 99:- use_module(library(lists)). 100:- use_module(library(debug)). 101:- use_module(library(error)). 102:- use_module(library(apply)). 103:- use_module(library(process)). 104 105:- use_module(cdecls). 106:- use_module(clocations).
111:- meta_predicate 112 c_alloc(,), 113 c_cast(,,), 114 c_load(, ), 115 c_store(, ), 116 c_current_enum(,,), 117 c_enum_in(,,), 118 c_enum_out(,,), 119 c_current_struct(), 120 c_current_struct(,,), 121 c_current_struct_field(,,,), 122 c_current_union(), 123 c_current_union(,,), 124 c_current_union_field(,,), 125 c_current_typedef(,), 126 c_struct_dict(,), 127 c_array_to_list(,), 128 c_array_to_list(,,), 129 c_array_from_list(,), 130 c_array_from_list(,,), 131 c_array_from_compound(,), 132 c_array_from_compound(,,), 133 c_array_to_compound(,,), 134 c_array_to_compound(,,,), 135 c_expand_type(,), 136 type_size(,), 137 c_type_size_align(,,), 138 c_type_size_align(,,, ). 139 140 141:- use_foreign_library(foreign(ffi4pl)). 142 143:- multifile 144 user:file_search_path/2, 145 system:term_expansion/2, 146 user:exception/3, 147 c_function/3. 148 149 150 /******************************* 151 * LIBRARIES * 152 *******************************/
159:- dynamic c_library_cache/2. 160:- volatile c_library_cache/2. 161 162c_library(Base, FHandle, _Options) :- 163 c_library_cache(Base, FHandle0), 164 !, 165 FHandle = FHandle0. 166c_library(Base, FHandle, Options) :- 167 with_mutex(ffi, c_library_sync(Base, FHandle, Options)). 168 169c_library_sync(Base, FHandle, _Options) :- 170 c_library_cache(Base, FHandle0), 171 !, 172 FHandle = FHandle0. 173c_library_sync(Base, FHandle, Options) :- 174 !, 175 c_lib_path(Base, Path, Options), 176 convlist(rtld, Options, Flags), 177 ffi_library_create(Path, FHandle, Flags), 178 assertz(c_library_cache(Base, FHandle)). 179 180rtld(rtld(Flag), Flag). 181 182 183 /******************************* 184 * IMPORT * 185 *******************************/
192c_import(Header, Flags, Functions) :- 193 throw(error(context_error(nodirective, 194 c_import(Header, Flags, Functions)), _)). 195 196systemterm_expansion((:- c_import(Header0, Flags0, Functions0)), 197 Clauses) :- 198 c_macro_expand(c_import(Header0, Flags0, Functions0), 199 c_import(Header, Flags1, Functions)), 200 \+ current_prolog_flag(xref, true), 201 prolog_load_context(module, M), 202 phrase(c_functions_needed(Functions), FunctionNames), 203 add_constants(M, Header, HeaderConst), 204 expand_flags(Flags1, Flags), 205 partition(is_lib_flag, Flags, LibFlags, InclFlags), 206 c99_types(HeaderConst, InclFlags, FunctionNames, Types, Constants), 207 ( debugging(ffi(types)) 208 -> print_term(Types, []) 209 ; true 210 ), 211 phrase(( c_constants(Constants), 212 c_import(Functions, LibFlags, FunctionNames, Types)), 213 Clauses).
pkg_config(uchardet, '--cflags', '--libs')220expand_flags(Flags0, Flags) :- 221 must_be(ground, Flags0), 222 maplist(expand_flag, Flags0, Flags1), 223 ( Flags0 == Flags1 224 -> Flags = Flags0 225 ; flatten(Flags1, Flags), 226 debug(ffi(flags), 'Final flags: ~p', [Flags]) 227 ). 228 229expand_flag(Flag, Flags) :- 230 compound(Flag), 231 compound_name_arguments(Flag, Name, Args), 232 pkg_config(Name), 233 !, 234 setup_call_cleanup( 235 process_create(path('pkg-config'), Args, 236 [ stdout(pipe(Out)) ]), 237 read_string(Out, _, String), 238 close(Out)), 239 split_string(String, " \r\t\t", " \r\n\t", FlagStrings), 240 maplist(atom_string, Flags, FlagStrings). 241expand_flag(Flag, Flag). 242 243pkg_config(pkg_config). 244pkg_config('pkg-config').
253c_functions_needed([]) --> []. 254c_functions_needed([H|T]) --> c_function_needed(H), c_functions_needed(T). 255 256c_function_needed([Spec]) --> 257 !, 258 c_function_needed(Spec, optional). 259c_function_needed(Spec) --> 260 c_function_needed(Spec, required). 261 262c_function_needed(Spec as _, Optional) --> 263 !, 264 c_function_needed(Spec, Optional). 265c_function_needed(Spec, Optional) --> 266 { compound_name_arguments(Spec, Name, Args) }, 267 needed(Name, Optional), 268 free_needed(Args, Optional). 269 270free_needed([], _) --> []. 271free_needed([H|T], Optional) --> free_arg(H, Optional), free_needed(T, Optional). 272 273free_arg(_Type~Free, Optional) --> 274 !, 275 needed(Free, Optional). 276free_arg(*(_Type,Free), Optional) --> % deprecated 277 !, 278 needed(Free, Optional). 279free_arg([Ret], Optional) --> 280 !, 281 free_arg(Ret, Optional). 282free_arg(-Output, Optional) --> 283 !, 284 free_arg(Output, Optional). 285free_arg(_, _) --> 286 []. 287 288needed(Name, optional) --> 289 [[Name]]. 290needed(Name, required) --> 291 [Name].
298c_import(Functions, Flags, FunctionNames, Types) --> 299 decls(Types), 300 compile_types(Types, Types), 301 wrap_functions(Functions, Types), 302 libs(Flags, FunctionNames). 303 304decls(_) --> 305 [ (:- discontiguous(('$c_lib'/3, 306 '$c_struct'/3, 307 '$c_struct_field'/4, 308 '$c_union'/3, 309 '$c_union_field'/4, 310 '$c_enum'/3, 311 '$c_typedef'/2 312 ))), 313 (:- dynamic '$c_symbol_cache'/2, 314 '$c_lib'/3 315 ) 316 ]. 317 318compile_types([], _) --> []. 319compile_types([struct(Name,Fields)|T], Types) --> !, 320 compile_struct(Name, Fields, Types), 321 compile_types(T, Types). 322compile_types([union(Name,Fields)|T], Types) --> !, 323 compile_union(Name, Fields, Types), 324 compile_types(T, Types). 325compile_types([enum(Name, Values)|T], Types) --> !, 326 compile_enum(Name, Values), 327 compile_types(T, Types). 328compile_types([typedef(Name, Type)|T], Types) --> !, 329 compile_typedef(Name, Type), 330 compile_types(T, Types). 331compile_types([_|T], Types) --> !, 332 compile_types(T, Types). 333 334wrap_functions([], _) --> []. 335wrap_functions([H|T], Types) --> 336 { optional(H, Func, Optional) 337 }, 338 wrap_function(Func, Optional, Types), 339 wrap_functions(T, Types). 340 341optional([Func], Func, optional) :- !. 342optional(Func, Func, required). 343 344wrap_function(Signature as PName, _Optional, Types) --> 345 !, 346 ( { compound_name_arguments(Signature, FName, SigArgs), 347 memberchk(function(FName, CRet0, Params), Types) 348 } 349 -> ( { signature_arity(SigArgs, Arity), 350 matching_signature(FName, SigArgs, CRet0, CRet, 351 Params, SigParams, Types), 352 include(is_closure, SigParams, Closures), 353 length(Closures, NClosures), 354 PArity is Arity - NClosures, 355 functor(PHead, PName, PArity), 356 CSignature =.. [FName|SigParams], 357 prolog_load_context(module, M) 358 } 359 -> [ ffi:c_function(M:PHead, Params, CRet), 360 (:- dynamic(PName/PArity)), 361 (PHead :- ffi:define(M:PHead, CSignature)) 362 ] 363 ; [] % Ignore non-matching signature 364 ) 365 ; [] % Already warned by c99_types 366 ). 367wrap_function(Signature, Optional, Types) --> 368 { compound_name_arity(Signature, Name, _) 369 }, 370 wrap_function(Signature as Name, Optional, Types). 371 372signature_arity(SigArgs, Arity) :- 373 append(Pre, [[void]], SigArgs), 374 !, 375 length(Pre, Arity). 376signature_arity(SigArgs, Arity) :- 377 length(SigArgs, Arity). 378 379 380is_closure(+closure(_)). 381is_closure(+c_callback(_)).
int may be mapped to C ulong if
the C function accepts a type that (eventually) aliases to an
unsigned long.395matching_signature(Name, SigArgs, CRet0, CRet, Params, SigParams, Types) :- 396 append(RealArgs, [[PlRet]], SigArgs), % specified return 397 !, 398 ( matching_param_length(RealArgs, Params, PlArgs, VArgs, CParams) 399 -> maplist(compatible_argument(Name, Types), 400 PlArgs, CParams, SigRealParams) 401 ; print_message(error, ffi(nonmatching_params(Name, SigArgs, Params))), 402 fail 403 ), 404 ( PlRet == void 405 -> append(SigRealParams, VArgs, SigParams), 406 CRet = void 407 ; CRet0 == void 408 -> print_message(error, ffi(void_function(Name, PlRet))), 409 fail 410 ; compatible_return(Name, PlRet, CRet0, RetParam, Types), 411 CRet = CRet0, 412 append([SigRealParams, VArgs, [[RetParam]]], SigParams) 413 ). 414matching_signature(Name, SigArgs, CRet, CRet, Params, SigParams, Types) :- 415 ( matching_param_length(SigArgs, Params, PlArgs, VArgs, CParams) 416 -> maplist(compatible_argument(Name, Types), 417 PlArgs, CParams, SigParams0), 418 append(SigParams0, VArgs, SigParams) 419 ; print_message(error, ffi(nonmatching_params(Name, SigArgs, Params))), 420 fail 421 ), 422 ( CRet == void 423 -> true 424 ; print_message(warning, ffi(nonvoid_function(Name, CRet))) 425 ).
437matching_param_length(PlParms, CParams, ReqPlParams, VarPlParams, ReqCParams) :- 438 append(ReqCParams, ['...'], CParams), 439 !, 440 length(ReqCParams, CArgc), 441 length(ReqPlParams, CArgc), 442 append(ReqPlParams, VarPlParams0, PlParms), 443 maplist(variadic_param, VarPlParams0, VarPlParams). 444matching_param_length(PlParms, CParams, PlParms, [], CParams) :- 445 same_length(PlParms, CParams). 446 447variadic_param(-Type, -Type) :- !. 448variadic_param(*(Type), *Type) :- !. 449variadic_param(Type0, Type) :- 450 default_promotion(Type0, Type), !. 451variadic_param(Type, Type). 452 453default_promotion(char, int). 454default_promotion(schar, int). 455default_promotion(uchar, uint). 456default_promotion('_Bool', uint). 457default_promotion(short, int). 458default_promotion(ushort, int). 459default_promotion(float, double).
464compatible_argument(_Func, Types, PlArg, CArg, Param) :- 465 compatible_arg(PlArg, CArg, Param, Types), 466 !. 467compatible_argument(_Func, Types, PlArg, CArg, PlArg) :- 468 compatible_arg(PlArg, CArg, Types), 469 !. 470compatible_argument(Func, _, PlArg, CArg, PlArg) :- 471 print_message(error, ffi(incompatible_argument(Func, PlArg, CArg))). 472 473% compatible_arg/4 474compatible_arg(PlArg, _ArgName-CArg, Param, Types) :- 475 !, 476 compatible_arg(PlArg, CArg, Param, Types). 477compatible_arg(+PlArg, CArg, Param, Types) :- 478 !, 479 compatible_arg(PlArg, CArg, Param, Types). 480compatible_arg(int, CType, +CType, _) :- 481 int_type(CType). 482compatible_arg(int, enum(_), +int, _). 483compatible_arg(enum, enum(Name), +enum(Name), _). 484compatible_arg(-int, *(CType), -CType, _) :- 485 int_type(CType). 486compatible_arg(*int, *(CType), *CType, _) :- 487 int_type(CType). 488compatible_arg(bool, '_Bool', +'_Bool', _). 489compatible_arg(-bool, *('_Bool'), -'_Bool', _). 490compatible_arg(*bool, *('_Bool'), *'_Bool', _). 491compatible_arg(float, CType, +CType, _) :- 492 float_type(CType). 493compatible_arg(-float, *(CType), -CType, _) :- 494 float_type(CType). 495compatible_arg(null, funcptr(_Ret, _Params), +c_callback(_:null), _Types) :- 496 !. 497compatible_arg('C'(Callback), funcptr(_Ret, _Params), +c_callback(M:Callback), _Types) :- 498 prolog_load_context(module, M), 499 !. 500compatible_arg(Func0, funcptr(Ret, Params), +closure(M:Func), Types) :- 501 prolog_load_context(module, M0), 502 strip_module(M0:Func0, M, Func1), 503 compound(Func1), 504 Func1 \= +(_), 505 Func1 \= *(_), 506 compound_name_arguments(Func1, Pred, SigArgs), 507 !, 508 matching_signature(-, SigArgs, Ret, Ret, Params, SigParams, Types), 509 compound_name_arguments(Func, Pred, SigParams). 510% compatible_arg/3 511compatible_arg(PlArg, _ArgName-CArg, Types) :- 512 !, 513 compatible_arg(PlArg, CArg, Types). 514compatible_arg(+PlArg, CArg, Types) :- 515 !, 516 compatible_arg(PlArg, CArg, Types). 517compatible_arg(Type, Type, _) :- !. 518compatible_arg(-PType~_Free, *(CType), Types) :- !, 519 compatible_arg(PType, CType, Types). 520compatible_arg(-PType, *(CType), Types) :- !, 521 compatible_arg(PType, CType, Types). 522compatible_arg(struct(Name), *(struct(Name)), _). 523compatible_arg(*struct(Name), *(struct(Name)), _). 524compatible_arg(union(Name), *(union(Name)), _). 525compatible_arg(*union(Name), *(union(Name)), _). 526compatible_arg(char, schar, _). 527compatible_arg(string, *(char), _). 528compatible_arg(string, *(schar), _). 529compatible_arg(string(wchar_t), *(Type), _) :- !, wchar_t_type(Type). 530compatible_arg(string(Enc), *(char), _) :- Enc \== wchar_t. 531compatible_arg(string(Enc), *(schar), _) :- Enc \== wchar_t. 532compatible_arg(*TypeName, CType, Types) :- 533 atom(TypeName), 534 memberchk(typedef(TypeName, Type), Types), 535 !, 536 compatible_arg(*Type, CType, Types). 537compatible_arg(TypeName, CType, Types) :- 538 atom(TypeName), 539 memberchk(typedef(TypeName, Type), Types), 540 !, 541 compatible_arg(Type, CType, Types). 542compatible_arg(-TypeName, CType, Types) :- 543 atom(TypeName), 544 memberchk(typedef(TypeName, Type), Types), 545 !, 546 compatible_arg(-Type, CType, Types). 547compatible_arg(*Type, *CType, Types) :- 548 compatible_arg(Type, CType, Types). 549 550 551compatible_return(_Func, PlArg, CArg, RetParam, Types) :- 552 compatible_ret(PlArg, CArg, RetParam, Types), 553 !. 554compatible_return(_Func, PlArg, CArg, PlArg, Types) :- 555 compatible_ret(PlArg, CArg, Types), 556 !. 557compatible_return(Func, PlArg, CArg, PlArg, _Types) :- 558 print_message(error, ffi(incompatible_return(Func, PlArg, CArg))). 559 560% compatible_ret/4 561compatible_ret(-PlArg, CArg, Param, Types) :- 562 compatible_ret(PlArg, CArg, Param, Types). 563compatible_ret(PlArg~Free, CArg, Param~Free, Types) :- 564 !, 565 compatible_ret(PlArg, CArg, Param, Types). 566compatible_ret(int, CArg, CArg, _) :- 567 int_type(CArg), 568 !. 569compatible_ret(int, enum(_), int, _) :- 570 !. 571compatible_ret(bool, '_Bool', '_Bool', _) :- 572 !. 573compatible_ret(enum, enum(Name), enum(Name), _) :- 574 !. 575compatible_ret(float, CArg, CArg, _) :- 576 float_type(CArg). 577compatible_ret(*(TypeName,Free), *(CType), *(CType,Free), Types) :- 578 !, 579 compatible_ret(*(TypeName), *(CType), *(CType), Types). 580compatible_ret(*(TypeName), *(CType), *(CType), Types) :- 581 memberchk(typedef(TypeName, Type), Types), 582 !, 583 compatible_ret(*(Type), *(CType), Types). 584% compatible_ret/3 585compatible_ret(-PlArg, CArg, Types) :- 586 !, 587 compatible_ret(PlArg, CArg, Types). 588compatible_ret(Type~_Free, CType, Types) :- 589 !, 590 compatible_ret(Type, CType, Types). 591compatible_ret(*(Type,_Free), CType, Types) :- % deprecated 592 !, 593 compatible_ret(*(Type), CType, Types). 594compatible_ret(Type, Type, _) :- !. 595compatible_ret(*(char), *(schar), _). 596compatible_ret(*(schar), *(char), _). 597compatible_ret(atom, CType, Types) :- 598 compatible_ret(string, CType, Types). 599compatible_ret(atom(Enc), CType, Types) :- 600 compatible_ret(string(Enc), CType, Types). 601compatible_ret(string, *(char), _). 602compatible_ret(string, *(schar), _). 603compatible_ret(string(wchar_t), *(Type), _) :- !, wchar_t_type(Type). 604compatible_ret(string(Enc), *(char), _) :- Enc \== wchar_t. 605compatible_ret(string(Enc), *(schar), _) :- Enc \== wchar_t. 606 607int_type(char). 608int_type(schar). 609int_type(uchar). 610int_type(short). 611int_type(ushort). 612int_type(int). 613int_type(uint). 614int_type(long). 615int_type(ulong). 616int_type(longlong). 617int_type(ulonglong). 618int_type(size_t). 619 620float_type(float). 621float_type(double). 622 623wchar_t_type(Type) :- 624 c_sizeof(Type, Size), 625 c_sizeof(wchar_t, Size).
632libs(Flags, Functions) --> 633 { convlist(flag_lib, Flags, Specs), 634 partition(load_option, Specs, Options, Libs), 635 prolog_load_context(directory, Dir) 636 }, 637 lib_clauses(Libs, Functions, [relative_to(Dir)|Options]). 638 639load_option(rtld(_)). 640 641lib_clauses([], _, _) --> []. 642lib_clauses([H|T], Functions, Options) --> 643 [ '$c_lib'(H, Options, Functions) ], 644 lib_clauses(T, Functions, Options). 645 646is_lib_flag(Flag) :- 647 flag_lib(Flag, _). 648 649flag_lib(Flag, Lib) :- 650 compound(Flag), 651 !, 652 Lib = Flag. 653flag_lib(Flag, Lib) :- 654 atom_concat('-l', Rest, Flag), 655 !, 656 atom_concat('lib', Rest, Lib). 657flag_lib(Flag, Lib) :- 658 atom_concat('--rtld_', Opt, Flag), 659 !, 660 Lib = rtld(Opt). 661flag_lib(Lib, Lib) :- 662 \+ sub_atom(Lib, 0, _, _, '-').
668:- public 669 define/2. 670 671define(QHead, CSignature) :- 672 QHead = M:_Head, 673 link_clause(QHead, CSignature, Clause), 674 !, 675 asserta(M:), 676 call(QHead). 677define(QHead, _) :- 678 throw(error(ffi_error(define(QHead)), _)). 679 680link_clause(M:Goal, CSignature, 681 (PHead :- !, Body)) :- 682 c_function(M:Goal, ParamSpec, RetType), % Also in dynamic part? 683 maplist(strip_param_name, ParamSpec, ParamTypes), 684 functor(Goal, Name, PArity), 685 functor(PHead, Name, PArity), 686 functor(CSignature, _, CArity), 687 functor(CHead, Name, CArity), 688 CSignature =.. [FName|SigArgs], 689 find_symbol(M, FName, FuncPtr), 690 prototype_types(ParamTypes, SigArgs, RetType, M, PParams, PRet), 691 debug(ffi(prototype), 692 'Binding ~p (Ret=~p, Params=~p)', [Name, PRet, PParams]), 693 ffi_prototype_create(FuncPtr, default, PRet, PParams, Prototype), 694 convert_args(SigArgs, 1, PArity, 1, CArity, PHead, CHead, 695 PreConvert, PostConvert), 696 Invoke = ffi:ffi_call(Prototype, CHead), 697 mkconj(PreConvert, Invoke, Body0), 698 mkconj(Body0, PostConvert, Body). 699 700strip_param_name(_Name-Type, Type) :- !. 701strip_param_name(Type, Type). 702 703find_symbol(M, FName, Symbol) :- 704 M:'$c_lib'(Lib, Options, Funcs), 705 member(Func, Funcs), 706 optional(Func, FName, _Optional), 707 c_library(Lib, FH, Options), 708 ffi_lookup_symbol(FH, FName, Symbol), 709 !. 710find_symbol(_, FName, _) :- 711 existence_error(c_function, FName).
718prototype_types([], [[SA]], RetType, M, [], PRet) :- 719 !, 720 prototype_type(RetType, M, SA, PRet). 721prototype_types([], [], _RetType, _M, [], void). 722prototype_types([...], PlParms, CRet, M, CTypes, CRetType) :- 723 !, 724 variadic_prototypes(PlParms, CRet, M, CTypes, CRetType). 725prototype_types([H0|T0], [SA|ST], RetType, M, [H|T], PRet) :- 726 prototype_type(H0, M, SA, H), 727 prototype_types(T0, ST, RetType, M, T, PRet). 728 729variadic_prototypes([[SA]], RetType, M, [], PRet) :- 730 !, 731 prototype_type(RetType, M, SA, PRet). 732variadic_prototypes([], _, _, [], void). 733variadic_prototypes([SA|ST], RetType, M, [H|T], CRetType) :- 734 variadic_prototype(SA, M, H), 735 variadic_prototypes(ST, RetType, M, T, CRetType). 736 737variadic_prototype(string, _, *(char)) :- !. 738variadic_prototype(Type, _, Type).
742prototype_type(funcptr(_,_), _, +c_callback(_), c_callback) :- 743 !. 744prototype_type(funcptr(_,_), _, PlType, closure) :- 745 compound_name_arguments(PlType, _, _), 746 !. 747prototype_type(*(*CType), M, -OutputType~FreeName, -(*(CType,Free))) :- 748 c_output_argument_type(OutputType), 749 find_symbol(M, FreeName, Free), 750 !. 751prototype_type(*CType, _, -OutputType, -CType) :- 752 c_output_argument_type(OutputType), 753 !. 754prototype_type(*Type0, M, Sig, *Type) :- 755 !, 756 prototype_type(Type0, M, Sig, Type). 757prototype_type(*(Type0, Free), M, Sig, *(Type, Free)) :- 758 !, 759 prototype_type(Type0, M, Sig, Type). 760prototype_type(struct(Name), M, _Sig, struct(Name, Size)) :- 761 !, 762 catch(type_size(M:struct(Name), Size), 763 error(existence_error(type,_),_), 764 Size = 0). 765prototype_type(union(Name), M, _Sig, union(Name, Size)) :- 766 !, 767 catch(type_size(M:union(Name), Size), 768 error(existence_error(type,_),_), 769 Size = 0). 770prototype_type(Type, _, _, Type). 771 772c_output_argument_type(ScalarType) :- 773 c_sizeof(ScalarType, _Size). 774c_output_argument_type(enum(_)). 775c_output_argument_type(string). 776c_output_argument_type(string(_Encoding)). 777c_output_argument_type(atom). 778c_output_argument_type(atom(_Encoding)). 779c_output_argument_type(*(_)).
787convert_args([], _, _, _, _, _, _, true, true). 788convert_args([+closure(M:Closure)|T], PI, PArity, CI, CArity, 789 PHead, CHead, GPre, GPost) :- 790 !, 791 arg(CI, CHead, CClosure), 792 closure_create(M:Closure, CClosure), 793 CI2 is CI + 1, 794 convert_args(T, PI, PArity, CI2, CArity, PHead, CHead, GPre, GPost). 795convert_args([+c_callback(M:Callback)|T], PI, PArity, CI, CArity, 796 PHead, CHead, GPre, GPost) :- 797 !, 798 arg(CI, CHead, CCallback), 799 ccallback_create(M:Callback, CCallback), 800 CI2 is CI + 1, 801 convert_args(T, PI, PArity, CI2, CArity, PHead, CHead, GPre, GPost). 802convert_args([H|T], PI, PArity, CI, CArity, PHead, CHead, GPre, GPost) :- 803 arg(PI, PHead, PArg), 804 arg(CI, CHead, CArg), 805 ( convert_arg(H, PArg, CArg, GPre1, GPost1) 806 -> true 807 ; PArg = CArg, 808 GPre1 = true, 809 GPost1 = true 810 ), 811 PI2 is PI + 1, 812 CI2 is CI + 1, 813 convert_args(T, PI2, PArity, CI2, CArity, PHead, CHead, GPre2, GPost2), 814 mkconj(GPre1, GPre2, GPre), 815 mkconj(GPost1, GPost2, GPost). 816 817% parameter values 818convert_arg(+Type, Prolog, C, Pre, Post) :- 819 !, 820 convert_arg(Type, Prolog, C, Pre, Post). 821convert_arg(-Type~_Free, Prolog, C, Pre, Post) :- 822 !, 823 convert_arg(-Type, Prolog, C, Pre, Post). 824convert_arg(-struct(Name), Ptr, Ptr, 825 c_alloc(Ptr, struct(Name)), 826 true). 827convert_arg(-union(Name), Ptr, Ptr, 828 c_alloc(Ptr, union(Name)), 829 true). 830convert_arg(-string, String, Ptr, 831 true, 832 c_load_string(Ptr, String, string, text)). 833convert_arg(-string(Enc), String, Ptr, 834 true, 835 c_load_string(Ptr, String, string, Enc)). 836convert_arg(-atom, String, Ptr, 837 true, 838 c_load_string(Ptr, String, atom, text)). 839convert_arg(-atom(Enc), String, Ptr, 840 true, 841 c_load_string(Ptr, String, atom, Enc)). 842convert_arg(string(Enc), String, Ptr, 843 c_alloc_string(Ptr, String, Enc), 844 true). 845convert_arg(string, String, Ptr, Pre, Post) :- 846 convert_arg(string(text), String, Ptr, Pre, Post). 847convert_arg(enum(Enum), Id, Int, 848 c_enum_in(Id, Enum, Int), 849 true). 850convert_arg(-enum(Enum), Id, Int, 851 true, 852 c_enum_out(Id, Enum, Int)). 853 854% return value. We allow for -Value, but do not demand it as the 855% return value can only be an output. 856convert_arg([-(X)], Out, In, Pre, Post) :- 857 !, 858 convert_arg([X], Out, In, Pre, Post). 859convert_arg([Type~_Free], Out, In, Pre, Post) :- 860 !, 861 convert_arg([Type], Out, In, Pre, Post). 862convert_arg([string(Enc)], String, Ptr, 863 true, 864 c_load_string(Ptr, String, string, Enc)). 865convert_arg([string], String, Ptr, Pre, Post) :- 866 convert_arg([-string(text)], String, Ptr, Pre, Post). 867convert_arg([atom(Enc)], String, Ptr, 868 true, 869 c_load_string(Ptr, String, atom, Enc)). 870convert_arg([atom], String, Ptr, Pre, Post) :- 871 convert_arg([-atom(text)], String, Ptr, Pre, Post). 872convert_arg([enum(Enum)], Id, Int, 873 true, 874 c_enum_out(Id, Enum, Int)). 875 876mkconj(true, G, G) :- !. 877mkconj(G, true, G) :- !. 878mkconj(G1, G2, (G1,G2)).
889ccallback_create(_:null, CCallback) :- 890 ffi:ffi_callback_ptr(_FH, '$null_callback', CCallback). 891ccallback_create(M:CHead, CCallback) :- 892 compound_name_arguments(CHead, CFuncName, _), 893 c_symbol_callback(M:CFuncName,CCallback). 894 895% Lookup C symbol address in shared libraries that have 896% been loaded by c_import in the context of module M. 897c_symbol_callback(M:Symbol, CCallback) :- 898 M:'$c_symbol_cache'(Symbol, CCallback), 899 !. 900c_symbol_callback(M:Symbol, CCallback) :- 901 M:'$c_lib'(Lib, Options, _), 902 c_library(Lib, FH, Options), 903 ffi:ffi_callback_ptr(FH, Symbol, CCallback), 904 M:assert('$c_symbol_cache'(Symbol, CCallback)), 905 debug(ffi(callback), '~p', [symcb(FH,Symbol,CCallback)]).
913closure_create(M:Head, Closure) :- 914 compound_name_arguments(Head, _, Args), 915 ( append(Params0, [[Return]], Args) 916 -> true 917 ; Params0 = Args, 918 Return = void 919 ), 920 maplist(strip_mode, Params0, Params), 921 ffi_closure_create(M:Head, default, Return, Params, Closure). 922 923strip_mode(+Type, Type) :- !. 924strip_mode(Type, Type). 925 926 927 /******************************* 928 * STRUCTURES * 929 *******************************/
f(Name, Type)Where Type is one of
char, uchar, ...)struct(Name)union(Name)enum(Name)array(Type, Size)This directive is normally used by c_import/3 to create type information for structures that are involved in functions that are imported. This directive may be used explicitly in combination with the C memory access predicates to read or write memory using C binary representation.
953c_struct(Name, Fields) :- 954 throw(error(context_error(nodirective, c_struct(Name, Fields)), _)). 955 956systemterm_expansion((:- c_struct(Name, Fields)), Clauses) :- 957 phrase(compile_structs([struct(Name, Fields)]), Clauses). 958 959compile_structs(List) --> 960 compile_structs(List, List). 961 962compile_structs([], _) --> []. 963compile_structs([struct(Name,Fields)|T], All) --> 964 compile_struct(Name, Fields, All), 965 compile_structs(T, All). 966 967compile_struct(Name, Fields, All) --> 968 field_clauses(Fields, Name, 0, End, 0, Alignment, All), 969 { Size is Alignment*((End+Alignment-1)//Alignment) }, 970 [ '$c_struct'(Name, Size, Alignment) ]. 971 972field_clauses([], _, End, End, Align, Align, _) --> []. 973field_clauses([f(Name,bitfield(Width))|T0], Struct, 974 Off0, Off, Align0, Align, All) --> !, 975 { c_type_size_align(uint, Size, Alignment, All), 976 Bits is 8*Size, 977 Align1 is max(Align0, Alignment), 978 Off1 is Alignment*((Off0+Alignment-1)//Alignment), 979 Off2 is Off1 + Size 980 }, 981 bitfield_clauses([f(Name,bitfield(Width))|T0], Struct, 982 Off1, 0, Bits, T), 983 field_clauses(T, Struct, Off2, Off, Align1, Align, All). 984field_clauses([f(Name,Type)|T], Struct, Off0, Off, Align0, Align, All) --> 985 { c_type_size_align(Type, Size, Alignment, All), 986 Align1 is max(Align0, Alignment), 987 Off1 is Alignment*((Off0+Alignment-1)//Alignment), 988 Off2 is Off1 + Size 989 }, 990 [ '$c_struct_field'(Struct, Name, Off1, Type) ], 991 field_clauses(T, Struct, Off2, Off, Align1, Align, All). 992 993bitfield_clauses([f(Name,bitfield(Width))|T0], Struct, 994 IntOffset, BitsUsed, Bits, T) --> 995 { BitsUsed1 is BitsUsed + Width, 996 BitsUsed1 =< Bits 997 }, 998 [ '$c_struct_field'(Struct, Name, IntOffset, bitfield(BitsUsed, Width)) ], 999 bitfield_clauses(T0, Struct, IntOffset, BitsUsed1, Bits, T). 1000bitfield_clauses(Fields, _, _, _, _, Fields) --> [].
1008c_union(Name, Fields) :- 1009 throw(error(context_error(nodirective, c_union(Name, Fields)), _)). 1010 1011systemterm_expansion((:- c_union(Name, Fields)), Clauses) :- 1012 phrase(compile_unions([union(Name, Fields)]), Clauses). 1013 1014compile_unions(List) --> 1015 compile_unions(List, List). 1016 1017compile_unions([], _) --> []. 1018compile_unions([union(Name,Fields)|T], All) --> 1019 compile_union(Name, Fields, All), 1020 compile_unions(T, All). 1021 1022compile_union(Name, Fields, All) --> 1023 ufield_clauses(Fields, Name, 0, Size, 0, Alignment, All), 1024 { Size is Alignment*((Size+Alignment-1)//Alignment) }, 1025 [ '$c_union'(Name, Size, Alignment) ]. 1026 1027ufield_clauses([], _, Size, Size, Align, Align, _) --> []. 1028ufield_clauses([f(Name,Type)|T], Struct, Size0, Size, Align0, Align, All) --> 1029 { c_type_size_align(Type, ESize, Alignment, All), 1030 Align1 is max(Align0, Alignment), 1031 Size1 is max(Size0, ESize) 1032 }, 1033 [ '$c_union_field'(Struct, Name, Type) ], 1034 ufield_clauses(T, Struct, Size1, Size, Align1, Align, All).
1041type_size(Type, Size) :-
1042 c_type_size_align(Type, Size, _).1048c_type_size_align(Type, Size, Alignment) :- 1049 c_type_size_align(Type, Size, Alignment, []). 1050 1051c_type_size_align(_:Type, Size, Alignment, _All) :- 1052 c_alignof(Type, Alignment), 1053 !, 1054 c_sizeof(Type, Size). 1055c_type_size_align(_:struct(Name), Size, Alignment, All) :- 1056 memberchk(struct(Name, Fields), All), !, 1057 phrase(compile_struct(Name, Fields, All), Clauses), 1058 memberchk('$c_struct'(Name, Size, Alignment), Clauses). 1059c_type_size_align(_:struct(Name, Fields), Size, Alignment, All) :- 1060 phrase(compile_struct(Name, Fields, All), Clauses), 1061 memberchk('$c_struct'(Name, Size, Alignment), Clauses). 1062c_type_size_align(_:union(Name), Size, Alignment, All) :- 1063 memberchk(union(Name, Fields), All), !, 1064 phrase(compile_union(Name, Fields, All), Clauses), 1065 memberchk('$c_union'(Name, Size, Alignment), Clauses). 1066c_type_size_align(_:union(Name, Fields), Size, Alignment, All) :- 1067 phrase(compile_union(Name, Fields, All), Clauses), 1068 memberchk('$c_union'(Name, Size, Alignment), Clauses). 1069c_type_size_align(M:struct(Name), Size, Alignment, _) :- 1070 current_predicate(M:'$c_struct'/3), 1071 M:'$c_struct'(Name, Size, Alignment), 1072 !. 1073c_type_size_align(M:union(Name), Size, Alignment, _) :- 1074 current_predicate(M:'$c_union'/3), 1075 M:'$c_union'(Name, Size, Alignment), 1076 !. 1077c_type_size_align(M:array(Type,Len), Size, Alignment, All) :- 1078 !, 1079 c_type_size_align(M:Type, Size0, Alignment, All), 1080 Size is Size0*Len. 1081c_type_size_align(_:enum(_Enum), Size, Alignment, _) :- 1082 !, 1083 c_alignof(int, Alignment), 1084 c_sizeof(int, Size). 1085c_type_size_align(_:(*(_)), Size, Alignment, _) :- 1086 !, 1087 c_alignof(pointer, Alignment), 1088 c_sizeof(pointer, Size). 1089c_type_size_align(_:funcptr(_Ret,_Params), Size, Alignment, _) :- 1090 !, 1091 c_alignof(pointer, Alignment), 1092 c_sizeof(pointer, Size). 1093c_type_size_align(Type, Size, Alignment, All) :- 1094 c_current_typedef(Type, Def), 1095 !, 1096 c_type_size_align(Def, Size, Alignment, All). 1097c_type_size_align(Type, _Size, _Alignment, _) :- 1098 existence_error(type, Type).
1104c_expand_type(M:Type0, M:Type) :- 1105 ( base_type(Type0) 1106 -> Type0 = Type 1107 ; expand_type(Type0, Type, M) 1108 ). 1109 1110base_type(struct(_)). 1111base_type(union(_)). 1112base_type(enum(_)). 1113base_type(Type) :- 1114 c_sizeof(Type, _). 1115 1116expand_type(*Type0, *Type, M) :- 1117 !, 1118 ( base_type(Type0) 1119 -> Type0 = Type 1120 ; expand_type(Type0, Type, M) 1121 ). 1122expand_type(Type0, Type, M) :- 1123 c_current_typedef(M:Type0, M:Type).
1130c_current_struct(Name) :- 1131 c_current_struct(Name, _, _). 1132c_current_struct(M:Name, Size, Align) :- 1133 current_predicate(M:'$c_struct'/3), 1134 M:'$c_struct'(Name, Size, Align).
1140c_current_struct_field(M:Name, Field, Offset, M:Type) :-
1141 current_predicate(M:'$c_struct_field'/4),
1142 M:'$c_struct_field'(Name, Field, Offset, Type).1150c_current_union(Name) :- 1151 c_current_union(Name, _, _). 1152c_current_union(M:Name, Size, Align) :- 1153 current_predicate(M:'$c_union'/3), 1154 M:'$c_union'(Name, Size, Align).
1160c_current_union_field(M:Name, Field, M:Type) :-
1161 current_predicate(M:'$c_union_field'/3),
1162 M:'$c_union_field'(Name, Field, Type).char(Encoding)[] = Texttext (as above), utf8 or iso_latin_1.Type[] = [Value].1204c_alloc(Ptr, M:(Type = Data)) :- 1205 !, 1206 c_init(M:Type, Data, Ptr). 1207c_alloc(M:Ptr, M:Type[Count]) :- 1208 !, 1209 type_size(M:Type, Size), 1210 c_calloc(Ptr, Type, Size, Count). 1211c_alloc(Ptr, M:Type) :- 1212 c_expand_type(M:Type, M:Type1), 1213 type_size(M:Type1, Size), 1214 c_calloc(Ptr, M:Type1, Size, 1). 1215 1216c_init(M:Type[], Data, Ptr) :- 1217 !, 1218 c_init_array(M:Type, Data, Ptr). 1219c_init(M:Type0, Data, Ptr) :- 1220 atom(Type0), % primitive type 1221 !, 1222 ( c_sizeof(Type0, Size) 1223 -> Type = Type0 1224 ; c_current_typedef(M:Type0, M:Type), 1225 c_sizeof(Type, Size) 1226 ), 1227 c_calloc(Ptr, Type, Size, 1), 1228 c_store(Ptr, 0, Type, Data). 1229c_init(Type, Data, Ptr) :- % user types 1230 Type = M:_, 1231 type_size(Type, Size), 1232 c_calloc(Ptr, Type, Size, 1), 1233 c_store(M:Ptr, Data).
1239c_init_array(_:char, Data, Ptr) :- 1240 !, 1241 c_alloc_string(Ptr, Data, text). 1242c_init_array(_:char(Encoding), Data, Ptr) :- 1243 !, 1244 c_alloc_string(Ptr, Data, Encoding). 1245c_init_array(_:wchar_t, Data, Ptr) :- 1246 !, 1247 c_alloc_string(Ptr, Data, wchar_t). 1248c_init_array(_:Type, List, Ptr) :- 1249 atom(Type), % primitive type 1250 !, 1251 is_list(List), 1252 length(List, Len), 1253 type_size(Type, Size), 1254 c_calloc(Ptr, Type, Size, Len), 1255 fill_array_fast(List, 0, Ptr, Size, Type). 1256c_init_array(Type, List, Ptr) :- % arbitrary types 1257 is_list(List), 1258 length(List, Len), 1259 type_size(Type, Size), 1260 c_calloc(Ptr, Type, Size, Len), 1261 fill_array(List, 0, Ptr, Size, Type). 1262 1263fill_array_fast([], _, _, _, _). 1264fill_array_fast([H|T], Offset, Ptr, Size, Type) :- 1265 c_store(Ptr, Offset, Type, H), 1266 Offset2 is Offset+Size, 1267 fill_array_fast(T, Offset2, Ptr, Size, Type). 1268 1269fill_array([], _, _, _, _). 1270fill_array([H|T], Offset, Ptr, Size, Type) :- 1271 c_store(Ptr[Offset], H), 1272 Offset2 is Offset+1, 1273 fill_array(T, Offset2, Ptr, Size, Type).
| Type | Prolog value |
| scalar | number |
| struct | pointer |
| union | pointer |
| enum | atom |
| pointer | pointer |
1293c_load(Spec, Value) :- 1294 c_address(Spec, Ptr, Offset, Type), 1295 c_load_(Ptr, Offset, Type, Value). 1296 1297c_load_(Ptr, Offset, Type, Value) :- 1298 Type = M:Plain, 1299 ( atom(Plain) 1300 -> c_load(Ptr, Offset, Plain, Value) 1301 ; compound_type(Plain) 1302 -> type_size(Type, Size), 1303 c_offset(Ptr, Offset, Type, Size, 1, Value) 1304 ; Plain = array(EType, Len) 1305 -> type_size(Type, ESize), 1306 c_offset(Ptr, Offset, EType, ESize, Len, Value) 1307 ; Plain = enum(Enum) 1308 -> c_load(Ptr, Offset, int, IntValue), 1309 c_enum_out(Value, M:Enum, IntValue) 1310 ; Plain = *(PtrType) 1311 -> c_load(Ptr, Offset, pointer(PtrType), Value) 1312 ; Plain = funcptr(_RetType, _ArgsTypes) % TBD: represent in closure? 1313 -> c_load(Ptr, Offset, pointer(closure), Value) 1314 ; domain_error(type, Type) 1315 ). 1316 1317compound_type(struct(_)). 1318compound_type(union(_)).
struct demo_func
{ int (*mul_i)(int, int);
};
We can initialise an instance of this structure holding a C function pointer that calls the predicate mymul/3 as follows:
c_alloc(Ptr, struct(demo_func)),
c_store(Ptr[mul_i], mymul(int, int, [int])),
1341c_store(Spec, Value) :- 1342 c_address(Spec, Ptr, Offset, Type), 1343 c_store_(Ptr, Offset, Type, Value). 1344 1345c_store_(Ptr, Offset, Type, Value) :- 1346 Type = M:Plain, 1347 ( atom(Plain) 1348 -> c_store(Ptr, Offset, Plain, Value) 1349 ; Plain = enum(Set) 1350 -> c_enum_in(Value, M:Set, IntValue), 1351 c_store(Ptr, Offset, int, IntValue) 1352 ; Plain = *(_EType) % TBD: validate 1353 -> c_store(Ptr, Offset, pointer, Value) 1354 ; ( Plain = funcptr(_Ret, _Params), blob(Value,c_ptr) ) 1355 -> c_store(Ptr, Offset, pointer, Value) % C callback 1356 ; Plain = funcptr(Ret, Params) 1357 -> strip_module(M:Value, PM, Func1), % ffi closure 1358 compound_name_arguments(Func1, Pred, SigArgs), 1359 matching_signature(-, SigArgs, Ret, Ret, Params, SigParams, []), 1360 compound_name_arguments(Func, Pred, SigParams), 1361 closure_create(PM:Func, Closure), 1362 c_store(Ptr, Offset, closure, Closure) 1363 ).
1377c_cast(_:Type, _, _) :- 1378 var(Type), 1379 !, 1380 type_error(c_type, Type). 1381c_cast(_:address, In, Out) :- 1382 !, 1383 c_address(In, Out). 1384c_cast(M:Type[Count], In, Out) :- 1385 !, 1386 type_size(M:Type, Size), 1387 c_offset(In, 0, Type, Size, Count, Out). 1388c_cast(Type, In, Out) :- 1389 type_size(Type, Size), 1390 c_offset(In, 0, Type, Size, _, Out).
1404c_address(_:(M2:Spec)[E], Ptr, Offset, Type) :- 1405 !, % may get wrongly qualified 1406 c_address(M2:Spec[E], Ptr, Offset, Type). 1407c_address(M:Spec[E], Ptr, Offset, Type) :- 1408 !, 1409 c_address(M:Spec, Ptr0, Offset0, Type0), 1410 ( atom(E) 1411 -> c_member(Type0, E, Ptr0, Offset0, Ptr, Offset, Type) 1412 ; integer(E) 1413 -> c_array_element(Type0, E, Ptr0, Offset0, Ptr, Offset, Type) 1414 ; type_error(member_selector, E) 1415 ). 1416c_address(M:Ptr, Ptr, 0, M:Type) :- 1417 c_typeof(Ptr, Type). 1418 1419c_array_element(M:array(EType,Size), E, Ptr, Offset0, Ptr, Offset, M:EType) :- 1420 !, 1421 ( E >= 0, 1422 E < Size 1423 -> type_size(M:EType, ESize), 1424 Offset is Offset0+E*ESize 1425 ; domain_error(array(EType,Size), E) 1426 ). 1427c_array_element(Type, E, Ptr, Offset0, Ptr, Offset, Type) :- 1428 type_size(Type, ESize), 1429 Offset is Offset0+E*ESize. 1430 1431c_member(M:struct(Struct), Field, Ptr, Offset0, Ptr, Offset, EType) :- 1432 !, 1433 c_current_struct_field(M:Struct, Field, FOffset, EType), 1434 Offset is Offset0+FOffset. 1435c_member(M:union(Union), Field, Ptr, Offset, Ptr, Offset, EType) :- 1436 !, 1437 c_current_union_field(M:Union, Field, EType). 1438c_member(Type, _, _, _, _, _, _) :- 1439 domain_error(struct_or_union, Type). 1440 1441 /******************************* 1442 * LIST * 1443 *******************************/
% C int array to list ?- c_alloc(CPtr, int[]=[3,1,0,2]), c_array_to_list(CPtr,R). CPtr = <C int[4]>(0x5629848165c0), R = [3, 1, 0, 2].
1458c_array_to_list(M:Ptr, List) :-
1459 nonvar(Ptr),
1460 !,
1461 c_array_list2(M:Ptr,List).% C int array to list ?- c_alloc(CPtr, int[]=[3,1,0,2]), c_array_to_list(CPtr,2,R). CPtr = <C int[4]>(0x5629848165c0), R = [3, 1, 0, 2].
1477c_array_to_list(M:Ptr, Count, List) :-
1478 nonvar(Ptr),
1479 !,
1480 c_array_list3(M:Ptr,Count,List).For now only numeric elements are supported.
?- c_array_from_list(Ptr,[3,2,0]). Ptr = <C long[3]>(0x55a265c6c3e0).
1496c_array_from_list(_:Ptr, List) :-
1497 nonvar(List),
1498 list_numeric(List,CTyp),
1499 !,
1500 c_alloc(Ptr,CTyp[]=List).For now only numeric elements are supported.
?- c_array_from_list(Ptr,2,[3,2,0]). Ptr = <C long[2]>(0x55a265c494c0).
1516c_array_from_list(_:Ptr, Count, List) :- 1517 nonvar(List), 1518 list_numeric(List,CTyp), 1519 length(L,Count), 1520 prefix(L,List), 1521 !, 1522 c_alloc(Ptr,CTyp[]=L). 1523 1524c_array_list_type(_:Ptr, List, CTyp) :- 1525 nonvar(List), 1526 !, 1527 c_alloc(Ptr,CTyp[]=List). 1528 1529 1530list_numeric([H|_],long) :- 1531 integer(H). 1532 1533list_numeric([H|_],double) :- 1534 float(H).
?- c_alloc(Arr,int[]=[3,0,1]), c_array_to_compound(Arr,myterm,C). Arr = <C int[3]>(0x561f2497ff00), C = myterm(3, 0, 1).
1549c_array_to_compound(M:Ptr, Name, Compound) :-
1550 nonvar(Ptr),
1551 !,
1552 c_array_compound3(M:Ptr,Name,Compound).?- c_alloc(Arr,int[]=[3,0,1]), c_array_to_compound(Arr,2,myterm,C). Arr = <C int[3]>(0x561f2497fc00), C = myterm(3, 0).
1568c_array_to_compound(M:Ptr, Count, Name, Compound) :-
1569 nonvar(Ptr),
1570 !,
1571 c_array_compound4(M:Ptr,Count,Name,Compound).For now only numeric elements are supported.
?- c_array_from_compound(Ptr,c(3,1,2)). Ptr = <C long[3]>(0x561f248c6080).
1588c_array_from_compound(M:Ptr, Compound) :-
1589 nonvar(Compound),
1590 !,
1591 functor(Compound, _Name, Count),
1592 c_array_from_compound(M:Ptr, Count, Compound).For now only numeric elements are supported.
?- c_array_from_compound(Ptr,2,c(3,1,2)). Ptr = <C long[2]>(0x561f248a70c0).
1608c_array_from_compound(_:Ptr, Count, Compound) :- 1609 nonvar(Compound), 1610 !, 1611 compound_numeric(Compound,Typ), 1612 c_sizeof(Typ, Size), 1613 c_calloc(Ptr, Typ, Size, Count), 1614 c_put_compound(Compound, Size, Ptr). 1615 1616 1617% we only check the first argument, 1618% and leave it to the user to make 1619% sure all elements are of the same 1620% type 1621compound_numeric(Compound,long) :- 1622 arg(1, Compound, H), 1623 integer(H), 1624 !. 1625 1626compound_numeric(Compound,double) :- 1627 arg(1, Compound, H), 1628 float(H), 1629 !. 1630 1631 1632 /******************************* 1633 * DICT * 1634 *******************************/
1640c_struct_dict(M:Ptr, Dict) :- 1641 nonvar(Ptr), 1642 !, 1643 c_typeof(Ptr, Type), 1644 ( Type = struct(Name) 1645 -> findall(f(Field, Offset, FType), 1646 c_current_struct_field(M:Name, Field, Offset, FType), 1647 Fields), 1648 maplist(get_field(Ptr), Fields, Pairs), 1649 dict_pairs(Dict, Name, Pairs) 1650 ; domain_error(c_struct_pointer, Ptr) 1651 ). 1652 1653get_field(Ptr, f(Name, Offset, Type), Name-Value) :- 1654 c_load_(Ptr, Offset, Type, Value). 1655 1656 1657 /******************************* 1658 * ENUM * 1659 *******************************/
1665c_current_enum(Id, M:Enum, Value) :- 1666 enum_module(M, '$c_enum'/3), 1667 M:'$c_enum'(Id, Enum, Value). 1668 1669enum_module(M, PI) :- 1670 nonvar(M), 1671 !, 1672 current_predicate(M:PI). 1673enum_module(M, PI) :- 1674 PI = Name/Arity, 1675 functor(Head, Name, Arity), 1676 current_module(M), 1677 current_predicate(M:PI), 1678 \+ predicate_property(M:Head, imported_from(_)).
1684c_enum_in(Id, Enum, Value) :- 1685 c_current_enum(Id, Enum, Value), 1686 !. 1687c_enum_in(Id, Enum, _Value) :- 1688 existence_error(enum_id, Id, Enum).
1694c_enum_out(Id, Enum, Value) :- 1695 c_current_enum(Id, Enum, Value), 1696 !. 1697c_enum_out(_Id, Enum, Value) :- 1698 existence_error(enum_value, Value, Enum).
1704:- det(compile_enum//2). 1705compile_enum(Name, Values) --> 1706 enum_clauses(Values, 0, Name). 1707 1708:- det(enum_clauses//3). 1709enum_clauses([], _, _) --> []. 1710enum_clauses([enum_value(Id, -)|T], I, Name) --> 1711 !, 1712 [ '$c_enum'(Id, Name, I) ], 1713 { I2 is I + 1 }, 1714 enum_clauses(T, I2, Name). 1715enum_clauses([enum_value(Id, C)|T], _, Name) --> 1716 { ast_constant(C, I) }, 1717 [ '$c_enum'(Id, Name, I) ], 1718 { I2 is I + 1 }, 1719 enum_clauses(T, I2, Name). 1720 1721 1722 /******************************* 1723 * TYPEDEF * 1724 *******************************/
1730c_current_typedef(M:Name, M:Type) :- 1731 enum_module(M, '$c_typedef'/2), 1732 M:'$c_typedef'(Name, Type). 1733 1734compile_typedef(Name, Type) --> 1735 [ '$c_typedef'(Name, Type) ]. 1736 1737 1738 /******************************* 1739 * MACROS * 1740 *******************************/
1746c_macro_expand(T0, T) :- 1747 prolog_load_context(module, M), 1748 current_predicate(M:c_define/2), !, 1749 c_expand(M, T0, T). 1750c_macro_expand(T, T). 1751 1752c_expand(M, T0, T) :- 1753 generalise(T0, T1), 1754 M:c_define(T1, E), 1755 T0 =@= T1, 1756 !, 1757 c_expand(M, E, T). 1758c_expand(M, T0, T) :- 1759 compound(T0), 1760 compound_name_arguments(T0, Name, Args0), 1761 maplist(c_expand(M), Args0, Args), 1762 compound_name_arguments(T1, Name, Args), 1763 T1 \== T0, !, 1764 c_expand(M, T1, T). 1765c_expand(_, T, T). 1766 1767generalise(T0, T) :- 1768 compound(T0), 1769 !, 1770 compound_name_arity(T0, Name, Arity), 1771 compound_name_arity(T, Name, Arity). 1772generalise(T0, T) :- 1773 atomic(T0), 1774 !, 1775 T = T0. 1776generalise(_, _). 1777 1778 1779 /******************************* 1780 * CPP CONSTANTS * 1781 *******************************/ 1782 1783add_constants(Module, Header0, Header) :- 1784 current_predicate(Module:cpp_const/1), 1785 findall(Const, Module:cpp_const(Const), Consts), 1786 Consts \== [], 1787 !, 1788 must_be(list(atom), Consts), 1789 maplist(const_decl, Consts, Decls), 1790 atomics_to_string([Header0|Decls], "\n", Header). 1791add_constants(_, Header, Header). 1792 1793const_decl(Const, Decl) :- 1794 format(string(Decl), "static int __swipl_const_~w = ~w;", [Const, Const]). 1795 1796c_constants([]) --> []. 1797c_constants([H|T]) --> c_constant(H), c_constants(T). 1798 1799c_constant(Name=AST) --> 1800 { ast_constant(AST, Value) }, 1801 !, 1802 [ cpp_const(Name, Value) ]. 1803c_constant(Name=AST) --> 1804 { print_message(warning, c(not_a_constant(Name, AST))) }. 1805 1806 1807 /******************************* 1808 * EXPANSION * 1809 *******************************/ 1810 1811cpp_expand(Modules, T0, CCallback) :- 1812 nonvar(T0), 1813 T0 = 'C'(sym(FName)), 1814 member(M, Modules), 1815 c_symbol_callback(M:FName, CCallback), 1816 !. 1817cpp_expand(Modules, T0, T) :- 1818 atom(T0), 1819 member(M, Modules), 1820 current_predicate(M:cpp_const/2), 1821 call(M:cpp_const(T0, T)), 1822 !. 1823cpp_expand(Modules0, T0, T) :- 1824 nonvar(T0), 1825 T0 = 'C'(Expr0), 1826 nonvar(Expr0), 1827 !, 1828 cpp_expand_module(Expr0, Expr1, Modules0, Modules), 1829 cpp_expand(Modules, Expr1, Expr), 1830 cpp_eval(Expr, T). 1831cpp_expand(Modules, T0, T) :- 1832 compound(T0), 1833 !, 1834 compound_name_arguments(T0, Name, Args0), 1835 maplist(cpp_expand(Modules), Args0, Args1), 1836 compound_name_arguments(T1, Name, Args1), 1837 ( T0 == T1 1838 -> T = T0 1839 ; T = T1 1840 ). 1841cpp_expand(_, T, T). 1842 1843cpp_expand_module(Expr0, Expr, Modules, [M|Modules]) :- 1844 nonvar(Expr0), 1845 Expr0 = _:_, 1846 !, 1847 strip_module(Expr0, M, Expr). 1848cpp_expand_module(Expr, Expr, Modules, Modules). 1849 1850 1851cpp_eval(Var, _) :- 1852 var(Var), 1853 !, 1854 instantiation_error(Var). 1855cpp_eval(Val0, Val) :- 1856 atomic(Val0), 1857 !, 1858 Val = Val0. 1859cpp_eval(Compound0, Val) :- 1860 compound_name_arguments(Compound0, Name, Args0), 1861 maplist(cpp_eval, Args0, Args), 1862 compound_name_arguments(Compound, Name, Args), 1863 cpp_eval_func(Compound, Val). 1864 1865cpp_eval_func((A|B), V) :- !, V is A \/ B. 1866cpp_eval_func(~(A), V) :- !, V is \A. 1867cpp_eval_func(&(A,B), V) :- !, V is A /\ B. 1868cpp_eval_func(Term, V) :- 1869 current_arithmetic_function(Term), 1870 !, 1871 V is Term. 1872 1873 1874systemterm_expansion(T0, T) :- 1875 prolog_load_context(module, M), 1876 current_predicate(M:c_import/3), 1877 cpp_expand([M], T0, T), 1878 T0 \== T. 1879 1880 /******************************* 1881 * LOW LEVEL DOCS * 1882 *******************************/
calloc() function. The
chunk is associated with the created Ptr, a blob of type c_ptr
(see blob/2). The content of the chunk is filled with 0-bytes. If
the blob is garbage collected by the atom garbage collector the
allocated chunk is freed.
char or wchar_t string from Prolog text Data. Data is
an atom, string, code list, char list or integer. The text is
encoded according to Encoding, which is one of iso_latin_1,
utf8, octet, text or wchar_t. The encodings octet and
iso_latin_1 are synonym. The conversion may raise a
representation_error exception if the encoding cannot represent
all code points in Data. The resulting string or wide string is
nul-terminated. Note that Data may contain code point 0 (zero). The
length of the string can be accessed using c_dim/3. The reported
length includes the terminating nul code.
This predicate is normally accessed through the high level interface provided by c_alloc/2.
The type release function is non-NULL if the block as allocated
using c_alloc/2 or a function was associated with a pointer created
from an output argument or the foreign function return value using
the ~(Type, Free) mechanism.
free() function may be used as
well. Using free() works on all Unix systems we are aware of, but
does not work on Windows.char or wchar_t, extract the
value to Prolog. The c_load_string/4 variant assumes the text is
nul-terminated.
Creating a pointer inside an existing chunk increments the reference count of Ptr0. Reclaiming the two pointers requires two atom garbage collection cycles, one to reclaim the sub-pointer Ptr and one to reclaim Ptr0.
The c_offset/5 primitive can also be used to cast a pointer, i.e., reinterpret its contents as if the pointer points at data of a different type.
2012 /******************************* 2013 * MESSAGES * 2014 *******************************/ 2015 2016:- multifile 2017 prolog:message//1, 2018 prolog:error_message//1. 2019 2020prologmessage(ffi(Msg)) --> 2021 [ 'FFI: '-[] ], 2022 message(Msg). 2023prologerror_message(ffi_error(Msg)) --> 2024 [ 'FFI: '-[] ], 2025 error_message(Msg). 2026 2027message(incompatible_return(Func, Prolog, C)) --> 2028 [ '~p: incompatible return type: ~p <- ~p'-[Func, Prolog, C] ]. 2029message(incompatible_argument(Func, Prolog, C)) --> 2030 [ '~p: incompatible parameter: ~p -> ~p'-[Func, Prolog, C] ]. 2031message(nonvoid_function(Func, Ret)) --> 2032 [ '~p: return of "~w" is ignored'-[Func, Ret] ]. 2033message(void_function(Func, PlRet)) --> 2034 [ '~p: void function defined to return ~p'-[Func, PlRet] ]. 2035message(nonmatching_params(Func, PlArgs, CArgs)) --> 2036 [ '~p: non-matching parameter list: ~p -> ~p'-[Func, PlArgs, CArgs] ]. 2037 2038error_message(define(QHead)) --> 2039 ['Failed to create link-clause for ~p'-[QHead]]
Bind Prolog predicates to C functions
*/