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-2021, 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(string, *(char), _). 598compatible_ret(string, *(schar), _). 599compatible_ret(string(wchar_t), *(Type), _) :- !, wchar_t_type(Type). 600compatible_ret(string(Enc), *(char), _) :- Enc \== wchar_t. 601compatible_ret(string(Enc), *(schar), _) :- Enc \== wchar_t. 602 603int_type(char). 604int_type(schar). 605int_type(uchar). 606int_type(short). 607int_type(ushort). 608int_type(int). 609int_type(uint). 610int_type(long). 611int_type(ulong). 612int_type(longlong). 613int_type(ulonglong). 614int_type(size_t). 615 616float_type(float). 617float_type(double). 618 619wchar_t_type(Type) :- 620 c_sizeof(Type, Size), 621 c_sizeof(wchar_t, Size).
628libs(Flags, Functions) --> 629 { convlist(flag_lib, Flags, Specs), 630 partition(load_option, Specs, Options, Libs), 631 prolog_load_context(directory, Dir) 632 }, 633 lib_clauses(Libs, Functions, [relative_to(Dir)|Options]). 634 635load_option(rtld(_)). 636 637lib_clauses([], _, _) --> []. 638lib_clauses([H|T], Functions, Options) --> 639 [ '$c_lib'(H, Options, Functions) ], 640 lib_clauses(T, Functions, Options). 641 642is_lib_flag(Flag) :- 643 flag_lib(Flag, _). 644 645flag_lib(Flag, Lib) :- 646 compound(Flag), 647 !, 648 Lib = Flag. 649flag_lib(Flag, Lib) :- 650 atom_concat('-l', Rest, Flag), 651 !, 652 atom_concat('lib', Rest, Lib). 653flag_lib(Flag, Lib) :- 654 atom_concat('--rtld_', Opt, Flag), 655 !, 656 Lib = rtld(Opt). 657flag_lib(Lib, Lib) :- 658 \+ sub_atom(Lib, 0, _, _, '-').
664:- public 665 define/2. 666 667define(QHead, CSignature) :- 668 QHead = M:_Head, 669 link_clause(QHead, CSignature, Clause), 670 !, 671 asserta(M:), 672 call(QHead). 673define(QHead, _) :- 674 throw(error(ffi_error(define(QHead)), _)). 675 676link_clause(M:Goal, CSignature, 677 (PHead :- !, Body)) :- 678 c_function(M:Goal, ParamSpec, RetType), % Also in dynamic part? 679 maplist(strip_param_name, ParamSpec, ParamTypes), 680 functor(Goal, Name, PArity), 681 functor(PHead, Name, PArity), 682 functor(CSignature, _, CArity), 683 functor(CHead, Name, CArity), 684 CSignature =.. [FName|SigArgs], 685 find_symbol(M, FName, FuncPtr), 686 prototype_types(ParamTypes, SigArgs, RetType, M, PParams, PRet), 687 debug(ffi(prototype), 688 'Binding ~p (Ret=~p, Params=~p)', [Name, PRet, PParams]), 689 ffi_prototype_create(FuncPtr, default, PRet, PParams, Prototype), 690 convert_args(SigArgs, 1, PArity, 1, CArity, PHead, CHead, 691 PreConvert, PostConvert), 692 Invoke = ffi:ffi_call(Prototype, CHead), 693 mkconj(PreConvert, Invoke, Body0), 694 mkconj(Body0, PostConvert, Body). 695 696strip_param_name(_Name-Type, Type) :- !. 697strip_param_name(Type, Type). 698 699find_symbol(M, FName, Symbol) :- 700 M:'$c_lib'(Lib, Options, Funcs), 701 member(Func, Funcs), 702 optional(Func, FName, _Optional), 703 c_library(Lib, FH, Options), 704 ffi_lookup_symbol(FH, FName, Symbol), 705 !. 706find_symbol(_, FName, _) :- 707 existence_error(c_function, FName).
714prototype_types([], [[SA]], RetType, M, [], PRet) :- 715 !, 716 prototype_type(RetType, M, SA, PRet). 717prototype_types([], [], _RetType, _M, [], void). 718prototype_types([...], PlParms, CRet, M, CTypes, CRetType) :- 719 !, 720 variadic_prototypes(PlParms, CRet, M, CTypes, CRetType). 721prototype_types([H0|T0], [SA|ST], RetType, M, [H|T], PRet) :- 722 prototype_type(H0, M, SA, H), 723 prototype_types(T0, ST, RetType, M, T, PRet). 724 725variadic_prototypes([[SA]], RetType, M, [], PRet) :- 726 !, 727 prototype_type(RetType, M, SA, PRet). 728variadic_prototypes([], _, _, [], void). 729variadic_prototypes([SA|ST], RetType, M, [H|T], CRetType) :- 730 variadic_prototype(SA, M, H), 731 variadic_prototypes(ST, RetType, M, T, CRetType). 732 733variadic_prototype(string, _, *(char)) :- !. 734variadic_prototype(Type, _, Type).
738prototype_type(funcptr(_,_), _, +c_callback(_), c_callback) :- 739 !. 740prototype_type(funcptr(_,_), _, PlType, closure) :- 741 compound_name_arguments(PlType, _, _), 742 !. 743prototype_type(*(*CType), M, -OutputType~FreeName, -(*(CType,Free))) :- 744 c_output_argument_type(OutputType), 745 find_symbol(M, FreeName, Free), 746 !. 747prototype_type(*CType, _, -OutputType, -CType) :- 748 c_output_argument_type(OutputType), 749 !. 750prototype_type(*Type0, M, Sig, *Type) :- 751 !, 752 prototype_type(Type0, M, Sig, Type). 753prototype_type(*(Type0, Free), M, Sig, *(Type, Free)) :- 754 !, 755 prototype_type(Type0, M, Sig, Type). 756prototype_type(struct(Name), M, _Sig, struct(Name, Size)) :- 757 !, 758 catch(type_size(M:struct(Name), Size), 759 error(existence_error(type,_),_), 760 Size = 0). 761prototype_type(union(Name), M, _Sig, union(Name, Size)) :- 762 !, 763 catch(type_size(M:union(Name), Size), 764 error(existence_error(type,_),_), 765 Size = 0). 766prototype_type(Type, _, _, Type). 767 768c_output_argument_type(ScalarType) :- 769 c_sizeof(ScalarType, _Size). 770c_output_argument_type(enum(_)). 771c_output_argument_type(string). 772c_output_argument_type(string(_Encoding)). 773c_output_argument_type(atom). 774c_output_argument_type(atom(_Encoding)). 775c_output_argument_type(*(_)).
783convert_args([], _, _, _, _, _, _, true, true). 784convert_args([+closure(M:Closure)|T], PI, PArity, CI, CArity, 785 PHead, CHead, GPre, GPost) :- 786 !, 787 arg(CI, CHead, CClosure), 788 closure_create(M:Closure, CClosure), 789 CI2 is CI + 1, 790 convert_args(T, PI, PArity, CI2, CArity, PHead, CHead, GPre, GPost). 791convert_args([+c_callback(M:Callback)|T], PI, PArity, CI, CArity, 792 PHead, CHead, GPre, GPost) :- 793 !, 794 arg(CI, CHead, CCallback), 795 ccallback_create(M:Callback, CCallback), 796 CI2 is CI + 1, 797 convert_args(T, PI, PArity, CI2, CArity, PHead, CHead, GPre, GPost). 798convert_args([H|T], PI, PArity, CI, CArity, PHead, CHead, GPre, GPost) :- 799 arg(PI, PHead, PArg), 800 arg(CI, CHead, CArg), 801 ( convert_arg(H, PArg, CArg, GPre1, GPost1) 802 -> true 803 ; PArg = CArg, 804 GPre1 = true, 805 GPost1 = true 806 ), 807 PI2 is PI + 1, 808 CI2 is CI + 1, 809 convert_args(T, PI2, PArity, CI2, CArity, PHead, CHead, GPre2, GPost2), 810 mkconj(GPre1, GPre2, GPre), 811 mkconj(GPost1, GPost2, GPost). 812 813% parameter values 814convert_arg(+Type, Prolog, C, Pre, Post) :- 815 !, 816 convert_arg(Type, Prolog, C, Pre, Post). 817convert_arg(-Type~_Free, Prolog, C, Pre, Post) :- 818 !, 819 convert_arg(-Type, Prolog, C, Pre, Post). 820convert_arg(-struct(Name), Ptr, Ptr, 821 c_alloc(Ptr, struct(Name)), 822 true). 823convert_arg(-union(Name), Ptr, Ptr, 824 c_alloc(Ptr, union(Name)), 825 true). 826convert_arg(-string, String, Ptr, 827 true, 828 c_load_string(Ptr, String, string, text)). 829convert_arg(-string(Enc), String, Ptr, 830 true, 831 c_load_string(Ptr, String, string, Enc)). 832convert_arg(-atom, String, Ptr, 833 true, 834 c_load_string(Ptr, String, atom, text)). 835convert_arg(-atom(Enc), String, Ptr, 836 true, 837 c_load_string(Ptr, String, atom, Enc)). 838convert_arg(string(Enc), String, Ptr, 839 c_alloc_string(Ptr, String, Enc), 840 true). 841convert_arg(string, String, Ptr, Pre, Post) :- 842 convert_arg(string(text), String, Ptr, Pre, Post). 843convert_arg(enum(Enum), Id, Int, 844 c_enum_in(Id, Enum, Int), 845 true). 846convert_arg(-enum(Enum), Id, Int, 847 true, 848 c_enum_out(Id, Enum, Int)). 849 850% return value. We allow for -Value, but do not demand it as the 851% return value can only be an output. 852convert_arg([-(X)], Out, In, Pre, Post) :- 853 !, 854 convert_arg([X], Out, In, Pre, Post). 855convert_arg([Type~_Free], Out, In, Pre, Post) :- 856 !, 857 convert_arg([Type], Out, In, Pre, Post). 858convert_arg([string(Enc)], String, Ptr, 859 true, 860 c_load_string(Ptr, String, string, Enc)). 861convert_arg([string], String, Ptr, Pre, Post) :- 862 convert_arg([-string(text)], String, Ptr, Pre, Post). 863convert_arg([atom(Enc)], String, Ptr, 864 true, 865 c_load_string(Ptr, String, atom, Enc)). 866convert_arg([atom], String, Ptr, Pre, Post) :- 867 convert_arg([-atom(text)], String, Ptr, Pre, Post). 868convert_arg([enum(Enum)], Id, Int, 869 true, 870 c_enum_out(Id, Enum, Int)). 871 872mkconj(true, G, G) :- !. 873mkconj(G, true, G) :- !. 874mkconj(G1, G2, (G1,G2)).
885ccallback_create(_:null, CCallback) :- 886 ffi:ffi_callback_ptr(_FH, '$null_callback', CCallback). 887ccallback_create(M:CHead, CCallback) :- 888 compound_name_arguments(CHead, CFuncName, _), 889 c_symbol_callback(M:CFuncName,CCallback). 890 891% Lookup C symbol address in shared libraries that have 892% been loaded by c_import in the context of module M. 893c_symbol_callback(M:Symbol, CCallback) :- 894 M:'$c_symbol_cache'(Symbol, CCallback), 895 !. 896c_symbol_callback(M:Symbol, CCallback) :- 897 M:'$c_lib'(Lib, Options, _), 898 c_library(Lib, FH, Options), 899 ffi:ffi_callback_ptr(FH, Symbol, CCallback), 900 M:assert('$c_symbol_cache'(Symbol, CCallback)), 901 debug(ffi(callback), '~p', [symcb(FH,Symbol,CCallback)]).
909closure_create(M:Head, Closure) :- 910 compound_name_arguments(Head, _, Args), 911 ( append(Params0, [[Return]], Args) 912 -> true 913 ; Params0 = Args, 914 Return = void 915 ), 916 maplist(strip_mode, Params0, Params), 917 ffi_closure_create(M:Head, default, Return, Params, Closure). 918 919strip_mode(+Type, Type) :- !. 920strip_mode(Type, Type). 921 922 923 /******************************* 924 * STRUCTURES * 925 *******************************/
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.
949c_struct(Name, Fields) :- 950 throw(error(context_error(nodirective, c_struct(Name, Fields)), _)). 951 952systemterm_expansion((:- c_struct(Name, Fields)), Clauses) :- 953 phrase(compile_structs([struct(Name, Fields)]), Clauses). 954 955compile_structs(List) --> 956 compile_structs(List, List). 957 958compile_structs([], _) --> []. 959compile_structs([struct(Name,Fields)|T], All) --> 960 compile_struct(Name, Fields, All), 961 compile_structs(T, All). 962 963compile_struct(Name, Fields, All) --> 964 field_clauses(Fields, Name, 0, End, 0, Alignment, All), 965 { Size is Alignment*((End+Alignment-1)//Alignment) }, 966 [ '$c_struct'(Name, Size, Alignment) ]. 967 968field_clauses([], _, End, End, Align, Align, _) --> []. 969field_clauses([f(Name,bitfield(Width))|T0], Struct, 970 Off0, Off, Align0, Align, All) --> !, 971 { c_type_size_align(uint, Size, Alignment, All), 972 Bits is 8*Size, 973 Align1 is max(Align0, Alignment), 974 Off1 is Alignment*((Off0+Alignment-1)//Alignment), 975 Off2 is Off1 + Size 976 }, 977 bitfield_clauses([f(Name,bitfield(Width))|T0], Struct, 978 Off1, 0, Bits, T), 979 field_clauses(T, Struct, Off2, Off, Align1, Align, All). 980field_clauses([f(Name,Type)|T], Struct, Off0, Off, Align0, Align, All) --> 981 { c_type_size_align(Type, Size, Alignment, All), 982 Align1 is max(Align0, Alignment), 983 Off1 is Alignment*((Off0+Alignment-1)//Alignment), 984 Off2 is Off1 + Size 985 }, 986 [ '$c_struct_field'(Struct, Name, Off1, Type) ], 987 field_clauses(T, Struct, Off2, Off, Align1, Align, All). 988 989bitfield_clauses([f(Name,bitfield(Width))|T0], Struct, 990 IntOffset, BitsUsed, Bits, T) --> 991 { BitsUsed1 is BitsUsed + Width, 992 BitsUsed1 =< Bits 993 }, 994 [ '$c_struct_field'(Struct, Name, IntOffset, bitfield(BitsUsed, Width)) ], 995 bitfield_clauses(T0, Struct, IntOffset, BitsUsed1, Bits, T). 996bitfield_clauses(Fields, _, _, _, _, Fields) --> [].
1004c_union(Name, Fields) :- 1005 throw(error(context_error(nodirective, c_union(Name, Fields)), _)). 1006 1007systemterm_expansion((:- c_union(Name, Fields)), Clauses) :- 1008 phrase(compile_unions([union(Name, Fields)]), Clauses). 1009 1010compile_unions(List) --> 1011 compile_unions(List, List). 1012 1013compile_unions([], _) --> []. 1014compile_unions([union(Name,Fields)|T], All) --> 1015 compile_union(Name, Fields, All), 1016 compile_unions(T, All). 1017 1018compile_union(Name, Fields, All) --> 1019 ufield_clauses(Fields, Name, 0, Size, 0, Alignment, All), 1020 { Size is Alignment*((Size+Alignment-1)//Alignment) }, 1021 [ '$c_union'(Name, Size, Alignment) ]. 1022 1023ufield_clauses([], _, Size, Size, Align, Align, _) --> []. 1024ufield_clauses([f(Name,Type)|T], Struct, Size0, Size, Align0, Align, All) --> 1025 { c_type_size_align(Type, ESize, Alignment, All), 1026 Align1 is max(Align0, Alignment), 1027 Size1 is max(Size0, ESize) 1028 }, 1029 [ '$c_union_field'(Struct, Name, Type) ], 1030 ufield_clauses(T, Struct, Size1, Size, Align1, Align, All).
1037type_size(Type, Size) :-
1038 c_type_size_align(Type, Size, _).
1044c_type_size_align(Type, Size, Alignment) :- 1045 c_type_size_align(Type, Size, Alignment, []). 1046 1047c_type_size_align(_:Type, Size, Alignment, _All) :- 1048 c_alignof(Type, Alignment), 1049 !, 1050 c_sizeof(Type, Size). 1051c_type_size_align(_:struct(Name), Size, Alignment, All) :- 1052 memberchk(struct(Name, Fields), All), !, 1053 phrase(compile_struct(Name, Fields, All), Clauses), 1054 memberchk('$c_struct'(Name, Size, Alignment), Clauses). 1055c_type_size_align(_:struct(Name, Fields), Size, Alignment, All) :- 1056 phrase(compile_struct(Name, Fields, All), Clauses), 1057 memberchk('$c_struct'(Name, Size, Alignment), Clauses). 1058c_type_size_align(_:union(Name), Size, Alignment, All) :- 1059 memberchk(union(Name, Fields), All), !, 1060 phrase(compile_union(Name, Fields, All), Clauses), 1061 memberchk('$c_union'(Name, Size, Alignment), Clauses). 1062c_type_size_align(_:union(Name, Fields), Size, Alignment, All) :- 1063 phrase(compile_union(Name, Fields, All), Clauses), 1064 memberchk('$c_union'(Name, Size, Alignment), Clauses). 1065c_type_size_align(M:struct(Name), Size, Alignment, _) :- 1066 current_predicate(M:'$c_struct'/3), 1067 M:'$c_struct'(Name, Size, Alignment), 1068 !. 1069c_type_size_align(M:union(Name), Size, Alignment, _) :- 1070 current_predicate(M:'$c_union'/3), 1071 M:'$c_union'(Name, Size, Alignment), 1072 !. 1073c_type_size_align(M:array(Type,Len), Size, Alignment, All) :- 1074 !, 1075 c_type_size_align(M:Type, Size0, Alignment, All), 1076 Size is Size0*Len. 1077c_type_size_align(_:enum(_Enum), Size, Alignment, _) :- 1078 !, 1079 c_alignof(int, Alignment), 1080 c_sizeof(int, Size). 1081c_type_size_align(_:(*(_)), Size, Alignment, _) :- 1082 !, 1083 c_alignof(pointer, Alignment), 1084 c_sizeof(pointer, Size). 1085c_type_size_align(_:funcptr(_Ret,_Params), Size, Alignment, _) :- 1086 !, 1087 c_alignof(pointer, Alignment), 1088 c_sizeof(pointer, Size). 1089c_type_size_align(Type, Size, Alignment, All) :- 1090 c_current_typedef(Type, Def), 1091 !, 1092 c_type_size_align(Def, Size, Alignment, All). 1093c_type_size_align(Type, _Size, _Alignment, _) :- 1094 existence_error(type, Type).
1100c_expand_type(M:Type0, M:Type) :- 1101 ( base_type(Type0) 1102 -> Type0 = Type 1103 ; expand_type(Type0, Type, M) 1104 ). 1105 1106base_type(struct(_)). 1107base_type(union(_)). 1108base_type(enum(_)). 1109base_type(Type) :- 1110 c_sizeof(Type, _). 1111 1112expand_type(*Type0, *Type, M) :- 1113 !, 1114 ( base_type(Type0) 1115 -> Type0 = Type 1116 ; expand_type(Type0, Type, M) 1117 ). 1118expand_type(Type0, Type, M) :- 1119 c_current_typedef(M:Type0, M:Type).
1126c_current_struct(Name) :- 1127 c_current_struct(Name, _, _). 1128c_current_struct(M:Name, Size, Align) :- 1129 current_predicate(M:'$c_struct'/3), 1130 M:'$c_struct'(Name, Size, Align).
1136c_current_struct_field(M:Name, Field, Offset, M:Type) :-
1137 current_predicate(M:'$c_struct_field'/4),
1138 M:'$c_struct_field'(Name, Field, Offset, Type).
1146c_current_union(Name) :- 1147 c_current_union(Name, _, _). 1148c_current_union(M:Name, Size, Align) :- 1149 current_predicate(M:'$c_union'/3), 1150 M:'$c_union'(Name, Size, Align).
1156c_current_union_field(M:Name, Field, M:Type) :-
1157 current_predicate(M:'$c_union_field'/3),
1158 M:'$c_union_field'(Name, Field, Type).
char(Encoding)
[] = Texttext
(as above), utf8
or iso_latin_1
.Type[] = [Value]
.1200c_alloc(Ptr, M:(Type = Data)) :- 1201 !, 1202 c_init(M:Type, Data, Ptr). 1203c_alloc(M:Ptr, M:Type[Count]) :- 1204 !, 1205 type_size(M:Type, Size), 1206 c_calloc(Ptr, Type, Size, Count). 1207c_alloc(Ptr, M:Type) :- 1208 c_expand_type(M:Type, M:Type1), 1209 type_size(M:Type1, Size), 1210 c_calloc(Ptr, M:Type1, Size, 1). 1211 1212c_init(M:Type[], Data, Ptr) :- 1213 !, 1214 c_init_array(M:Type, Data, Ptr). 1215c_init(_:Type, Data, Ptr) :- 1216 atom(Type), % primitive type 1217 !, 1218 type_size(Type, Size), 1219 c_calloc(Ptr, Type, Size, 1), 1220 c_store(Ptr, 0, Type, Data). 1221c_init(Type, Data, Ptr) :- % user types 1222 Type = M:_, 1223 type_size(Type, Size), 1224 c_calloc(Ptr, Type, Size, 1), 1225 c_store(M:Ptr, Data).
1231c_init_array(_:char, Data, Ptr) :- 1232 !, 1233 c_alloc_string(Ptr, Data, text). 1234c_init_array(_:char(Encoding), Data, Ptr) :- 1235 !, 1236 c_alloc_string(Ptr, Data, Encoding). 1237c_init_array(_:wchar_t, Data, Ptr) :- 1238 !, 1239 c_alloc_string(Ptr, Data, wchar_t). 1240c_init_array(_:Type, List, Ptr) :- 1241 atom(Type), % primitive type 1242 !, 1243 is_list(List), 1244 length(List, Len), 1245 type_size(Type, Size), 1246 c_calloc(Ptr, Type, Size, Len), 1247 fill_array_fast(List, 0, Ptr, Size, Type). 1248c_init_array(Type, List, Ptr) :- % arbitrary types 1249 is_list(List), 1250 length(List, Len), 1251 type_size(Type, Size), 1252 c_calloc(Ptr, Type, Size, Len), 1253 fill_array(List, 0, Ptr, Size, Type). 1254 1255fill_array_fast([], _, _, _, _). 1256fill_array_fast([H|T], Offset, Ptr, Size, Type) :- 1257 c_store(Ptr, Offset, Type, H), 1258 Offset2 is Offset+Size, 1259 fill_array_fast(T, Offset2, Ptr, Size, Type). 1260 1261fill_array([], _, _, _, _). 1262fill_array([H|T], Offset, Ptr, Size, Type) :- 1263 c_store(Ptr[Offset], H), 1264 Offset2 is Offset+1, 1265 fill_array(T, Offset2, Ptr, Size, Type).
Type | Prolog value |
scalar | number |
struct | pointer |
union | pointer |
enum | atom |
pointer | pointer |
1285c_load(Spec, Value) :- 1286 c_address(Spec, Ptr, Offset, Type), 1287 c_load_(Ptr, Offset, Type, Value). 1288 1289c_load_(Ptr, Offset, Type, Value) :- 1290 Type = M:Plain, 1291 ( atom(Plain) 1292 -> c_load(Ptr, Offset, Plain, Value) 1293 ; compound_type(Plain) 1294 -> type_size(Type, Size), 1295 c_offset(Ptr, Offset, Type, Size, 1, Value) 1296 ; Plain = array(EType, Len) 1297 -> type_size(Type, ESize), 1298 c_offset(Ptr, Offset, EType, ESize, Len, Value) 1299 ; Plain = enum(Enum) 1300 -> c_load(Ptr, Offset, int, IntValue), 1301 c_enum_out(Value, M:Enum, IntValue) 1302 ; Plain = *(PtrType) 1303 -> c_load(Ptr, Offset, pointer(PtrType), Value) 1304 ; domain_error(type, Type) 1305 ). 1306 1307compound_type(struct(_)). 1308compound_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])),
1331c_store(Spec, Value) :- 1332 c_address(Spec, Ptr, Offset, Type), 1333 c_store_(Ptr, Offset, Type, Value). 1334 1335c_store_(Ptr, Offset, Type, Value) :- 1336 Type = M:Plain, 1337 ( atom(Plain) 1338 -> c_store(Ptr, Offset, Plain, Value) 1339 ; Plain = enum(Set) 1340 -> c_enum_in(Value, M:Set, IntValue), 1341 c_store(Ptr, Offset, int, IntValue) 1342 ; Plain = *(_EType) % TBD: validate 1343 -> c_store(Ptr, Offset, pointer, Value) 1344 ; ( Plain = funcptr(_Ret, _Params), blob(Value,c_ptr) ) 1345 -> c_store(Ptr, Offset, pointer, Value) % C callback 1346 ; Plain = funcptr(Ret, Params) 1347 -> strip_module(M:Value, PM, Func1), % ffi closure 1348 compound_name_arguments(Func1, Pred, SigArgs), 1349 matching_signature(-, SigArgs, Ret, Ret, Params, SigParams, []), 1350 compound_name_arguments(Func, Pred, SigParams), 1351 closure_create(PM:Func, Closure), 1352 c_store(Ptr, Offset, closure, Closure) 1353 ).
1367c_cast(_:Type, _, _) :- 1368 var(Type), 1369 !, 1370 type_error(c_type, Type). 1371c_cast(_:address, In, Out) :- 1372 !, 1373 c_address(In, Out). 1374c_cast(M:Type[Count], In, Out) :- 1375 !, 1376 type_size(M:Type, Size), 1377 c_offset(In, 0, Type, Size, Count, Out). 1378c_cast(Type, In, Out) :- 1379 type_size(Type, Size), 1380 c_offset(In, 0, Type, Size, _, Out).
1394c_address(_:(M2:Spec)[E], Ptr, Offset, Type) :- 1395 !, % may get wrongly qualified 1396 c_address(M2:Spec[E], Ptr, Offset, Type). 1397c_address(M:Spec[E], Ptr, Offset, Type) :- 1398 !, 1399 c_address(M:Spec, Ptr0, Offset0, Type0), 1400 ( atom(E) 1401 -> c_member(Type0, E, Ptr0, Offset0, Ptr, Offset, Type) 1402 ; integer(E) 1403 -> c_array_element(Type0, E, Ptr0, Offset0, Ptr, Offset, Type) 1404 ; type_error(member_selector, E) 1405 ). 1406c_address(M:Ptr, Ptr, 0, M:Type) :- 1407 c_typeof(Ptr, Type). 1408 1409c_array_element(M:array(EType,Size), E, Ptr, Offset0, Ptr, Offset, M:EType) :- 1410 !, 1411 ( E >= 0, 1412 E < Size 1413 -> type_size(M:EType, ESize), 1414 Offset is Offset0+E*ESize 1415 ; domain_error(array(EType,Size), E) 1416 ). 1417c_array_element(Type, E, Ptr, Offset0, Ptr, Offset, Type) :- 1418 type_size(Type, ESize), 1419 Offset is Offset0+E*ESize. 1420 1421c_member(M:struct(Struct), Field, Ptr, Offset0, Ptr, Offset, EType) :- 1422 !, 1423 c_current_struct_field(M:Struct, Field, FOffset, EType), 1424 Offset is Offset0+FOffset. 1425c_member(M:union(Union), Field, Ptr, Offset, Ptr, Offset, EType) :- 1426 !, 1427 c_current_union_field(M:Union, Field, EType). 1428c_member(Type, _, _, _, _, _, _) :- 1429 domain_error(struct_or_union, Type). 1430 1431 /******************************* 1432 * LIST * 1433 *******************************/
% 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].
1448c_array_to_list(M:Ptr, List) :-
1449 nonvar(Ptr),
1450 !,
1451 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].
1467c_array_to_list(M:Ptr, Count, List) :-
1468 nonvar(Ptr),
1469 !,
1470 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).
1486c_array_from_list(_:Ptr, List) :-
1487 nonvar(List),
1488 list_numeric(List,CTyp),
1489 !,
1490 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).
1506c_array_from_list(_:Ptr, Count, List) :- 1507 nonvar(List), 1508 list_numeric(List,CTyp), 1509 length(L,Count), 1510 prefix(L,List), 1511 !, 1512 c_alloc(Ptr,CTyp[]=L). 1513 1514c_array_list_type(_:Ptr, List, CTyp) :- 1515 nonvar(List), 1516 !, 1517 c_alloc(Ptr,CTyp[]=List). 1518 1519 1520list_numeric([H|_],long) :- 1521 integer(H). 1522 1523list_numeric([H|_],double) :- 1524 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).
1539c_array_to_compound(M:Ptr, Name, Compound) :-
1540 nonvar(Ptr),
1541 !,
1542 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).
1558c_array_to_compound(M:Ptr, Count, Name, Compound) :-
1559 nonvar(Ptr),
1560 !,
1561 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).
1578c_array_from_compound(M:Ptr, Compound) :-
1579 nonvar(Compound),
1580 !,
1581 functor(Compound, _Name, Count),
1582 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).
1598c_array_from_compound(_:Ptr, Count, Compound) :- 1599 nonvar(Compound), 1600 !, 1601 compound_numeric(Compound,Typ), 1602 c_sizeof(Typ, Size), 1603 c_calloc(Ptr, Typ, Size, Count), 1604 c_put_compound(Compound, Size, Ptr). 1605 1606 1607% we only check the first argument, 1608% and leave it to the user to make 1609% sure all elements are of the same 1610% type 1611compound_numeric(Compound,long) :- 1612 arg(1, Compound, H), 1613 integer(H), 1614 !. 1615 1616compound_numeric(Compound,double) :- 1617 arg(1, Compound, H), 1618 float(H), 1619 !. 1620 1621 1622 /******************************* 1623 * DICT * 1624 *******************************/
1630c_struct_dict(M:Ptr, Dict) :- 1631 nonvar(Ptr), 1632 !, 1633 c_typeof(Ptr, Type), 1634 ( Type = struct(Name) 1635 -> findall(f(Field, Offset, FType), 1636 c_current_struct_field(M:Name, Field, Offset, FType), 1637 Fields), 1638 maplist(get_field(Ptr), Fields, Pairs), 1639 dict_pairs(Dict, Name, Pairs) 1640 ; domain_error(c_struct_pointer, Ptr) 1641 ). 1642 1643get_field(Ptr, f(Name, Offset, Type), Name-Value) :- 1644 c_load_(Ptr, Offset, Type, Value). 1645 1646 1647 /******************************* 1648 * ENUM * 1649 *******************************/
1655c_current_enum(Id, M:Enum, Value) :- 1656 enum_module(M, '$c_enum'/3), 1657 M:'$c_enum'(Id, Enum, Value). 1658 1659enum_module(M, PI) :- 1660 nonvar(M), 1661 !, 1662 current_predicate(M:PI). 1663enum_module(M, PI) :- 1664 PI = Name/Arity, 1665 functor(Head, Name, Arity), 1666 current_module(M), 1667 current_predicate(M:PI), 1668 \+ predicate_property(M:Head, imported_from(_)).
1674c_enum_in(Id, Enum, Value) :- 1675 c_current_enum(Id, Enum, Value), 1676 !. 1677c_enum_in(Id, Enum, _Value) :- 1678 existence_error(enum_id, Id, Enum).
1684c_enum_out(Id, Enum, Value) :- 1685 c_current_enum(Id, Enum, Value), 1686 !. 1687c_enum_out(_Id, Enum, Value) :- 1688 existence_error(enum_value, Value, Enum).
1694compile_enum(Name, Values) --> 1695 enum_clauses(Values, 0, Name). 1696 1697enum_clauses([], _, _) --> []. 1698enum_clauses([enum_value(Id, -)|T], I, Name) --> 1699 !, 1700 [ '$c_enum'(Id, Name, I) ], 1701 { I2 is I + 1 }, 1702 enum_clauses(T, I2, Name). 1703enum_clauses([enum_value(Id, C)|T], _, Name) --> 1704 { ast_constant(C, I) }, 1705 [ '$c_enum'(Id, Name, I) ], 1706 { I2 is I + 1 }, 1707 enum_clauses(T, I2, Name). 1708 1709 1710 /******************************* 1711 * TYPEDEF * 1712 *******************************/
1718c_current_typedef(M:Name, M:Type) :- 1719 enum_module(M, '$c_typedef'/2), 1720 M:'$c_typedef'(Name, Type). 1721 1722compile_typedef(Name, Type) --> 1723 [ '$c_typedef'(Name, Type) ]. 1724 1725 1726 /******************************* 1727 * MACROS * 1728 *******************************/
1734c_macro_expand(T0, T) :- 1735 prolog_load_context(module, M), 1736 current_predicate(M:c_define/2), !, 1737 c_expand(M, T0, T). 1738c_macro_expand(T, T). 1739 1740c_expand(M, T0, T) :- 1741 generalise(T0, T1), 1742 M:c_define(T1, E), 1743 T0 =@= T1, 1744 !, 1745 c_expand(M, E, T). 1746c_expand(M, T0, T) :- 1747 compound(T0), 1748 compound_name_arguments(T0, Name, Args0), 1749 maplist(c_expand(M), Args0, Args), 1750 compound_name_arguments(T1, Name, Args), 1751 T1 \== T0, !, 1752 c_expand(M, T1, T). 1753c_expand(_, T, T). 1754 1755generalise(T0, T) :- 1756 compound(T0), 1757 !, 1758 compound_name_arity(T0, Name, Arity), 1759 compound_name_arity(T, Name, Arity). 1760generalise(T0, T) :- 1761 atomic(T0), 1762 !, 1763 T = T0. 1764generalise(_, _). 1765 1766 1767 /******************************* 1768 * CPP CONSTANTS * 1769 *******************************/ 1770 1771add_constants(Module, Header0, Header) :- 1772 current_predicate(Module:cpp_const/1), 1773 findall(Const, Module:cpp_const(Const), Consts), 1774 Consts \== [], 1775 !, 1776 must_be(list(atom), Consts), 1777 maplist(const_decl, Consts, Decls), 1778 atomics_to_string([Header0|Decls], "\n", Header). 1779add_constants(_, Header, Header). 1780 1781const_decl(Const, Decl) :- 1782 format(string(Decl), "static int __swipl_const_~w = ~w;", [Const, Const]). 1783 1784c_constants([]) --> []. 1785c_constants([H|T]) --> c_constant(H), c_constants(T). 1786 1787c_constant(Name=AST) --> 1788 { ast_constant(AST, Value) }, 1789 !, 1790 [ cpp_const(Name, Value) ]. 1791c_constant(Name=AST) --> 1792 { print_message(warning, c(not_a_constant(Name, AST))) }. 1793 1794 1795 /******************************* 1796 * EXPANSION * 1797 *******************************/ 1798 1799cpp_expand(Modules, T0, CCallback) :- 1800 nonvar(T0), 1801 T0 = 'C'(sym(FName)), 1802 member(M, Modules), 1803 c_symbol_callback(M:FName, CCallback), 1804 !. 1805cpp_expand(Modules, T0, T) :- 1806 atom(T0), 1807 member(M, Modules), 1808 current_predicate(M:cpp_const/2), 1809 call(M:cpp_const(T0, T)), 1810 !. 1811cpp_expand(Modules0, T0, T) :- 1812 nonvar(T0), 1813 T0 = 'C'(Expr0), 1814 nonvar(Expr0), 1815 !, 1816 cpp_expand_module(Expr0, Expr1, Modules0, Modules), 1817 cpp_expand(Modules, Expr1, Expr), 1818 cpp_eval(Expr, T). 1819cpp_expand(Modules, T0, T) :- 1820 compound(T0), 1821 !, 1822 compound_name_arguments(T0, Name, Args0), 1823 maplist(cpp_expand(Modules), Args0, Args1), 1824 compound_name_arguments(T1, Name, Args1), 1825 ( T0 == T1 1826 -> T = T0 1827 ; T = T1 1828 ). 1829cpp_expand(_, T, T). 1830 1831cpp_expand_module(Expr0, Expr, Modules, [M|Modules]) :- 1832 nonvar(Expr0), 1833 Expr0 = _:_, 1834 !, 1835 strip_module(Expr0, M, Expr). 1836cpp_expand_module(Expr, Expr, Modules, Modules). 1837 1838 1839cpp_eval(Var, _) :- 1840 var(Var), 1841 !, 1842 instantiation_error(Var). 1843cpp_eval(Val0, Val) :- 1844 atomic(Val0), 1845 !, 1846 Val = Val0. 1847cpp_eval(Compound0, Val) :- 1848 compound_name_arguments(Compound0, Name, Args0), 1849 maplist(cpp_eval, Args0, Args), 1850 compound_name_arguments(Compound, Name, Args), 1851 cpp_eval_func(Compound, Val). 1852 1853cpp_eval_func((A|B), V) :- !, V is A \/ B. 1854cpp_eval_func(~(A), V) :- !, V is \A. 1855cpp_eval_func(&(A,B), V) :- !, V is A /\ B. 1856cpp_eval_func(Term, V) :- 1857 current_arithmetic_function(Term), 1858 !, 1859 V is Term. 1860 1861 1862systemterm_expansion(T0, T) :- 1863 prolog_load_context(module, M), 1864 current_predicate(M:c_import/3), 1865 cpp_expand([M], T0, T), 1866 T0 \== T. 1867 1868 /******************************* 1869 * LOW LEVEL DOCS * 1870 *******************************/
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.
2000 /******************************* 2001 * MESSAGES * 2002 *******************************/ 2003 2004:- multifile 2005 prolog:message//1, 2006 prolog:error_message//1. 2007 2008prologmessage(ffi(Msg)) --> 2009 [ 'FFI: '-[] ], 2010 message(Msg). 2011prologerror_message(ffi_error(Msg)) --> 2012 [ 'FFI: '-[] ], 2013 error_message(Msg). 2014 2015message(incompatible_return(Func, Prolog, C)) --> 2016 [ '~p: incompatible return type: ~p <- ~p'-[Func, Prolog, C] ]. 2017message(incompatible_argument(Func, Prolog, C)) --> 2018 [ '~p: incompatible parameter: ~p -> ~p'-[Func, Prolog, C] ]. 2019message(nonvoid_function(Func, Ret)) --> 2020 [ '~p: return of "~w" is ignored'-[Func, Ret] ]. 2021message(void_function(Func, PlRet)) --> 2022 [ '~p: void function defined to return ~p'-[Func, PlRet] ]. 2023message(nonmatching_params(Func, PlArgs, CArgs)) --> 2024 [ '~p: non-matching parameter list: ~p -> ~p'-[Func, PlArgs, CArgs] ]. 2025 2026error_message(define(QHead)) --> 2027 ['Failed to create link-clause for ~p'-[QHead]]
Bind Prolog predicates to C functions
*/