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)  2001-2014, University of Amsterdam, VU University Amsterdam
    7    All rights reserved.
    8
    9    Redistribution and use in source and binary forms, with or without
   10    modification, are permitted provided that the following conditions
   11    are met:
   12
   13    1. Redistributions of source code must retain the above copyright
   14       notice, this list of conditions and the following disclaimer.
   15
   16    2. Redistributions in binary form must reproduce the above copyright
   17       notice, this list of conditions and the following disclaimer in
   18       the documentation and/or other materials provided with the
   19       distribution.
   20
   21    THIS SOFTWARE IS PROVIDED BY THE COPYRIGHT HOLDERS AND CONTRIBUTORS
   22    "AS IS" AND ANY EXPRESS OR IMPLIED WARRANTIES, INCLUDING, BUT NOT
   23    LIMITED TO, THE IMPLIED WARRANTIES OF MERCHANTABILITY AND FITNESS
   24    FOR A PARTICULAR PURPOSE ARE DISCLAIMED. IN NO EVENT SHALL THE
   25    COPYRIGHT OWNER OR CONTRIBUTORS BE LIABLE FOR ANY DIRECT, INDIRECT,
   26    INCIDENTAL, SPECIAL, EXEMPLARY, OR CONSEQUENTIAL DAMAGES (INCLUDING,
   27    BUT NOT LIMITED TO, PROCUREMENT OF SUBSTITUTE GOODS OR SERVICES;
   28    LOSS OF USE, DATA, OR PROFITS; OR BUSINESS INTERRUPTION) HOWEVER
   29    CAUSED AND ON ANY THEORY OF LIABILITY, WHETHER IN CONTRACT, STRICT
   30    LIABILITY, OR TORT (INCLUDING NEGLIGENCE OR OTHERWISE) ARISING IN
   31    ANY WAY OUT OF THE USE OF THIS SOFTWARE, EVEN IF ADVISED OF THE
   32    POSSIBILITY OF SUCH DAMAGE.
   33*/
   34
   35:- module(qp_foreign,
   36          [ load_foreign_files/0,               %
   37            load_foreign_files/2,               % +Files, +Libs
   38            load_foreign_files/3,               % +Object, +Files, +Libs
   39            make_shared_object/3,               % +Object, +Files, +Libs
   40            make_foreign_wrapper_file/1,        % +OutBase
   41            make_foreign_wrapper_file/2,        % +OFiles, +OutBase
   42                                                % SICStus stuff
   43            make_foreign_resource_wrapper/3,    % +Resource, +ResBase, +FileBase
   44            load_foreign_resource/2             % +Resource, +Dir
   45          ]).   46
   47:- autoload(library(apply),[exclude/3]).   48:- autoload(library(error),[existence_error/2]).   49:- autoload(library(gensym),[gensym/2]).   50:- autoload(library(lists),[member/2,append/3,select/3]).   51:- autoload(library(shlib),[load_foreign_library/1]).   52
   53
   54/** <module> Quintus compatible foreign loader
   55
   56This module defines a  Quintus   compatible  foreign  language interface
   57based on the foreign_file/2 and foreign/3 declarations.
   58
   59Predicates:
   60
   61        * load_foreign_files
   62        Load all foreign files defined with foreign_file/2 statement
   63        in the current module.
   64
   65        * load_foreign_files(+Files, +Libs)
   66        Load specified foreign files, linking them with the given
   67        libraries
   68
   69        * load_foreign_files(+SharedObject, +Files, +Libs)
   70        As load_foreign_files/2, but first tries to load `SharedObject'.
   71        If the SharedObject exists it is loaded using load_foreign_library/1.
   72        Otherwise it is first created with make_shared_object/3.
   73
   74        * make_shared_object(+SharedObject, +Files, +Libs)
   75        Generate a wrapper and link it using plld to the given SharedObject.
   76
   77        * make_foreign_wrapper_file(+Files, +OutBase)
   78        Generate wrapper for the named object files in OutBase.c.
   79
   80        * make_foreign_wrapper_file(+Files)
   81        Generate wrapper for all declared object files in OutBase.c.
   82
   83Example:
   84
   85        ==
   86        foreign_file('-lm', [sin/2]).
   87        foreign(sin, c, sin(+float, [-float])).
   88        :- load_foreign_files,
   89           abolish(foreign_file, 2),
   90           abolish(foreign, 3).
   91        ==
   92
   93Supported types:
   94
   95        | *Spec*        | *Prolog*      | *C*                           |
   96        | integer       | integer       | long                          |
   97        | float         | float,integer | double                        |
   98        | single        | float,integer | single                        |
   99        | string        | atom,string   | char *                        |
  100        | atom          | atom          | atom identifier (type atomic) |
  101
  102*NOTE*  This modules requires a correctly functioning swipl-ld and
  103        load_foreign_library/1 on your system.  If this isn't the
  104        case use make_foreign_wrapper_file/[1,2] to generate a
  105        wrapper and use static embedding.
  106
  107@bug    Only supports C-interface
  108@bug    Insufficient checking for misusage.
  109@bug    Documentation is too short and very outdated
  110*/
  111
  112:- module_transparent
  113    load_foreign_files/0.  114
  115:- meta_predicate
  116    load_foreign_files(:, +),
  117    load_foreign_files(+, :, +),
  118    make_shared_object(+, :, +),
  119    make_foreign_wrapper_file(:),
  120    make_foreign_wrapper_file(:, +),
  121                                    % SICStus
  122    make_foreign_resource_wrapper(:, +, +),
  123    load_foreign_resource(:, +).  124
  125setting(linker, 'swipl-ld').
  126
  127hook(M:Goal) :-
  128    M:Goal.
  129
  130%!  make_wrappers(+PrologHeads, +Module, +OutStream)
  131
  132make_wrappers([], _, _).
  133make_wrappers([H|T], M, Out) :-
  134    make_wrapper(Out, M:H),
  135    make_wrappers(T, M, Out).
  136
  137%!  make_wrapper(+Stream, :PrologHead)
  138%
  139%   Generates a C-wrapper function for the given foreign defined
  140%   Prolog predicate.  The wrapper is called _plw_<predname><arity>.
  141
  142make_wrapper(Out, Spec) :-
  143    get_foreign_head(Spec, Func, Head),
  144    !,
  145    (   check_head(Head)
  146    ->  wrapper_name(Head, WrapName, ArgN),
  147        make_C_header(Out, WrapName, ArgN),
  148        make_C_decls(Out, Head),
  149        make_C_prototype(Out, Head),
  150        make_C_input_conversions(Out, Head),
  151        make_C_wrapper_setup(Out),
  152        make_C_call(Out, Head, Func),
  153        make_C_wrapper_check(Out),
  154        make_C_output_conversions(Out, Head),
  155        make_C_footer(Out)
  156    ;   fail
  157    ).
  158make_wrapper(_, Spec) :-
  159    existence_error(foreign_declaration, Spec).
  160
  161%!  get_foreign_head(:Spec, -Func, -Head)
  162%
  163%   Get 3rd argument of relevant foreign/3   clause. Seems there are
  164%   two versions. In Quintus Spec was  a predicate specification and
  165%   in SICStus it seems to be a (C) function name.
  166
  167get_foreign_head(M:Function, Function, M:Head) :-
  168    prolog_load_context(dialect, sicstus),
  169    !,
  170    hook(M:foreign(Function, c, Head)).
  171get_foreign_head(M:Spec, Func, M:Head) :-
  172    (   atom(Spec),
  173        hook(M:foreign(Spec, c, Head)),
  174        functor(Head, Spec, _)
  175    ->  true
  176    ;   Spec = Name/Arity
  177    ->  functor(Head, Name, Arity),
  178        hook(M:foreign(Func, c, Head))
  179    ;   Head = Spec,
  180        hook(M:foreign(Func, c, Head))
  181    ).
  182
  183
  184check_head(_:Head) :-
  185    functor(Head, _, Arity),
  186    (   Arity == 0
  187    ->  true
  188    ;   arg(_, Head, [-T]),
  189        \+ valid_type(T)
  190    ->  warning('Bad return type ~w in ~w', [T, Head]),
  191        fail
  192    ;   arg(N, Head, [-_T]),
  193        N \== Arity
  194    ->  warning('Return type must be last in ~w', Head),
  195        fail
  196    ;   (arg(_, Head, -T) ; arg(_, Head, +T)),
  197        \+ valid_type(T)
  198    ->  warning('Bad type ~w in ~w', [T, Head]),
  199        fail
  200    ;   true
  201    ).
  202
  203valid_type(int).
  204valid_type(integer).
  205valid_type(size_t).
  206valid_type(float).
  207valid_type(single).
  208valid_type(string).
  209valid_type(chars).                      % actually, `codes'!
  210valid_type(atom).
  211valid_type(term).
  212valid_type(address).
  213valid_type(address(_)).
  214
  215%!  cvt_name(+Type, +IO, -Suffix) is det.
  216
  217cvt_name(chars,      _, codes) :- !.
  218cvt_name(address(_), _, address) :- !.
  219cvt_name(int,        o, int64) :- !.
  220cvt_name(integer,    o, int64) :- !.
  221cvt_name(size_t,     o, int64) :- !.
  222cvt_name(integer,    i, long) :- !.
  223cvt_name(Type,       _, Type).
  224
  225
  226%!  make_C_header(+Stream, +WrapperName, +Arity)
  227%
  228%   Write function-header for the wrapper.  This is easy as the
  229%   the return-type is always foreign_t and the arguments are
  230%   always of type `term_t'.  The arguments are simply named `a',
  231%   `b', ...
  232
  233make_C_header(Out, WrapName, ArgN) :-
  234    format(Out, '~n~nstatic foreign_t~n~w(', [WrapName]),
  235    forall(between(1, ArgN, A),
  236           (   (A \== 1 -> format(Out, ', ', []) ; true)
  237           ,   arg_name(A, AName),
  238               format(Out, 'term_t ~w', [AName])
  239           )),
  240    format(Out, ')~n{ ', []).
  241
  242%!  make_C_decls(+Stream, :PrologHead)
  243%
  244%   Writes the C variable declarations. If  the return value is used
  245%   a variable named `rval' is created. For each input parameter a C
  246%   variable named i<argname> is created;   for each output variable
  247%   o<argname>.
  248
  249make_C_decls(Out, _:Head) :-
  250    compound(Head),
  251    arg(_, Head, [-PlType]),
  252    map_C_type(PlType, CType),
  253    format(Out, '~wrval;~n  ', [CType]),
  254    fail.
  255make_C_decls(Out, _:Head) :-
  256    compound(Head),
  257    arg(N, Head, -PlType),
  258    arg_name(N, AName),
  259    (   PlType == term
  260    ->  format(Out, 'term_t o_~w = PL_new_term_ref();~n  ', [AName])
  261    ;   map_C_type(PlType, CType),
  262        format(Out, '~wo_~w;~n  ', [CType, AName])
  263    ),
  264    fail.
  265make_C_decls(Out, _:Head) :-
  266    compound(Head),
  267    arg(N, Head, +PlType),
  268    PlType \== term,
  269    map_C_type(PlType, CType),
  270    CType \== term,
  271    arg_name(N, AName),
  272    format(Out, '~wi_~w;~n  ', [CType, AName]),
  273    fail.
  274make_C_decls(Out, _) :-
  275    format(Out, '~n', []).
  276
  277%!  make_C_prototype(+Stream, :PrologHead)
  278%
  279%   If the function handles floats or doubles, make a prototype
  280%   declaration for it to avoid unwanted conversions.
  281
  282make_C_prototype(Out, M:Head) :-
  283    (   compound(Head),
  284        arg(_, Head, [-Type])
  285    ->  map_C_type(Type, CType)
  286    ;   CType = 'void '
  287    ),
  288    copy_term(Head, H2),            % don't bind Head
  289    hook(M:foreign(CFunc, c, H2)),
  290    !,
  291    format(Out, '  extern ~w~w(', [CType, CFunc]),
  292    (   compound(Head),
  293        arg(N, Head, AType),
  294        AType \= [_],               % return-type
  295        (N > 1 -> format(Out, ', ', []) ; true),
  296        (   AType = +T2
  297        ->  map_C_type(T2, CT2),
  298            format(Out, '~w', [CT2])
  299        ;   AType == -term
  300        ->  format(Out, term_t, [])
  301        ;   AType = -T2
  302        ->  map_C_type(T2, CT2),
  303            format(Out, '~w *', [CT2])
  304        ),
  305        fail
  306    ;   format(Out, ');~n~n', [])
  307    ).
  308make_C_prototype(_, _).
  309
  310
  311%!  make_C_input_conversions(+Stream, :PrologHead)
  312%
  313%   Generate the input checking and conversion code.  Assumes
  314%   boolean functions that take a Prolog term_t as first argument
  315%   and a pointer to the requested C-type as a second argument.
  316%   Function returns 0 if the conversion fails.
  317
  318make_C_input_conversions(Out, _:Head) :-
  319    findall(N-T, (compound(Head),arg(N, Head, +T)), IArgs0),
  320    exclude(term_arg, IArgs0, IArgs),
  321    (   IArgs == []
  322    ->  true
  323    ;   format(Out, '  if ( ', []),
  324        (   member(N-T, IArgs),
  325            T \== term,
  326            (IArgs \= [N-T|_] -> format(Out, ' ||~n       ', []) ; true),
  327            arg_name(N, AName),
  328            atom_concat(i_, AName, IName),
  329            cvt_name(T, i, CVT),
  330            format(Out, '!PL_cvt_i_~w(~w, &~w)', [CVT, AName, IName]),
  331            fail
  332        ;   true
  333        ),
  334        format(Out, ' )~n    return FALSE;~n~n', [])
  335    ).
  336
  337term_arg(_-term).
  338
  339
  340%!  make_C_call(+Stream, :PrologHead, +CFunction)
  341%
  342%   Generate  the  actual  call  to   the  foreign  function.  Input
  343%   variables may be handed directly; output  variables as a pointer
  344%   to the o<var>, except for output-variables of type term.
  345
  346make_C_call(Out, _:Head, CFunc) :-
  347    (   compound(Head),
  348        arg(_, Head, [-_])
  349    ->  format(Out, '  rval = ~w(', [CFunc])
  350    ;   format(Out, '  (void) ~w(', [CFunc])
  351    ),
  352    compound(Head),
  353    arg(N, Head, Arg),
  354    Arg \= [_],
  355    (N \== 1 -> format(Out, ', ', []) ; true),
  356    arg_name(N, AName),
  357    (   Arg = -term
  358    ->  format(Out, 'o_~w', [AName])
  359    ;   Arg = -_
  360    ->  format(Out, '&o_~w', [AName])
  361    ;   Arg = +term
  362    ->  format(Out, '~w', [AName])
  363    ;   format(Out, 'i_~w', [AName])
  364    ),
  365    fail.
  366make_C_call(Out, _, _) :-
  367    format(Out, ');~n', []).
  368
  369%!  make_C_wrapper_setup(+Stream)
  370%
  371%   Call SP_WRAP_INIT() when  running  on   SICStus.  This  supports
  372%   SP_fail() and SP_raise_exception().
  373
  374make_C_wrapper_setup(Stream) :-
  375    prolog_load_context(dialect, sicstus),
  376    !,
  377    format(Stream, '  SP_WRAP_INIT();~n', []).
  378make_C_wrapper_setup(_).
  379
  380
  381%!  make_C_wrapper_check(+Stream)
  382%
  383%   Call  SP_WRAP_CHECK_STATE()  when  running    on  SICStus.  This
  384%   supports SP_fail() and SP_raise_exception().
  385
  386make_C_wrapper_check(Stream) :-
  387    prolog_load_context(dialect, sicstus),
  388    !,
  389    format(Stream, '  SP_WRAP_CHECK_STATE();~n', []).
  390make_C_wrapper_check(_).
  391
  392
  393%!  make_C_output_conversions(+Stream, :PrologHead)
  394%
  395%   Generate conversions for the output arguments and unify them
  396%   with the Prolog term_t arguments.
  397
  398make_C_output_conversions(Out, _:Head) :-
  399    findall(N-T, (compound(Head),arg(N, Head, -T)), OArgs0),
  400    (   compound(Head),
  401        arg(_, Head, [-RT])
  402    ->  OArgs = [rval-RT|OArgs0]
  403    ;   OArgs = OArgs0
  404    ),
  405    (   OArgs == []
  406    ->  true
  407    ;   format(Out, '~n  if ( ', []),
  408        (   member(N-T, OArgs),
  409            (   N == rval
  410            ->  OName = rval,
  411                arg(RN, Head, [-_]),
  412                arg_name(RN, AName)
  413            ;   arg_name(N, AName),
  414                atom_concat(o_, AName, OName)
  415            ),
  416            (OArgs = [N-T|_] -> true ; format(Out, ' ||~n       ', [])),
  417            (   T == term
  418            ->  format(Out, '!PL_unify(~w, ~w)', [OName, AName])
  419            ;   cvt_name(T, o, CVT),
  420                format(Out, '!PL_cvt_o_~w(~w, ~w)', [CVT, OName, AName])
  421            ),
  422            fail
  423        ;   true
  424        ),
  425        format(Out, ' )~n    return FALSE;~n', [])
  426    ).
  427
  428
  429make_C_footer(Out) :-
  430    format(Out, '~n  return TRUE;~n}~n', []).
  431
  432                 /*******************************
  433                 *        INIT STATEMENT        *
  434                 *******************************/
  435
  436%!  make_C_init(+Stream, +InstallFunc, +InitFunc, +Module, +PredList)
  437%
  438%   Generate an array of PL_extension structures,   that may be used
  439%   to create a statically  linked  image   as  well  as through the
  440%   PL_load_extensions() call.
  441%
  442%   Of the supported PL_FA_<FLAGS>, TRANSPARENT   may be declared by
  443%   looking at the transparent  (meta_predivate)   attribute  of the
  444%   predicate.
  445
  446make_C_init(Out, InstallFunc, Init, M, Preds) :-
  447    format(Out, '~n~nstatic PL_extension predicates [] =~n{~n', []),
  448    format(Out, '/*{ "name", arity, function, PL_FA_<flags> },*/~n', []),
  449    (   member(Pred, Preds),
  450        get_foreign_head(M:Pred, _Func, Head),
  451        Head = M:H,
  452        functor(H, Name, Arity),
  453        wrapper_name(Head, Wrapper, Arity),
  454        foreign_attributes(M:H, Atts),
  455        format(Out, '  { "~w", ~d, ~w, ~w },~n',
  456               [Name, Arity, Wrapper, Atts]),
  457        fail
  458    ;   true
  459    ),
  460    format(Out, '  { NULL, 0, NULL, 0 } /* terminator */~n};~n~n', []),
  461    format(Out, 'install_t~n~w()~n{ PL_load_extensions(predicates);~n',
  462           [InstallFunc]),
  463    sicstus_init_function(Out, Init),
  464    format(Out, '}~n', []).
  465
  466sicstus_init_function(_, -) :- !.
  467sicstus_init_function(Out, Init) :-
  468    format(Out, '  extern void ~w(int);~n', [Init]),
  469    format(Out, '  ~w(0);~n', [Init]).
  470
  471foreign_attributes(Head, Atts) :-
  472    findall(A, foreign_attribute(Head, A), A0),
  473    (   A0 == []
  474    ->  Atts = 0
  475    ;   atomic_list_concat(A0, '|', Atts)
  476    ).
  477
  478foreign_attribute(Head, 'PL_FA_TRANSPARENT') :-
  479    predicate_property(Head, transparent).
  480
  481%!  make_C_deinit(+Stream, +UninstallFunc, +DeInitFunc) is det.
  482%
  483%   Write the uninstall function
  484
  485make_C_deinit(_, _, -) :- !.
  486make_C_deinit(Out, Func, DeInit) :-
  487    format(Out, '~ninstall_t~n', []),
  488    format(Out, '~w()~n', [Func]),
  489    format(Out, '{ extern void ~w(int);~n', [DeInit]),
  490    format(Out, '  ~w(0);~n', [DeInit]),
  491    format(Out, '}~n', []).
  492
  493
  494%!  make_C_file_header(+Stream)
  495%
  496%   Output the generic header declarations needed and some comments
  497
  498make_C_file_header(Out) :-
  499    current_prolog_flag(version_data, swi(Major, Minor, Patch, _)),
  500    get_time(Time),
  501    format_time(string(When), '%F %H:%M', Time),
  502    format(Out, '/*  SWI-Prolog link wrapper~n', []),
  503    format(Out, '    Generated by SWI-Prolog version ~w.~w.~w~n',
  504           [Major, Minor, Patch]),
  505    format(Out, '    At ~s~n', [When]),
  506    (   source_location(File, Line)
  507    ->  format(Out, '    Source context ~w:~d~n', [File, Line])
  508    ;   true
  509    ),
  510    format(Out, '*/~n~n', []),
  511    format(Out, '#include <SWI-Prolog.h>~n', []),
  512    make_C_compat_file_header(Out),
  513    format(Out, '#ifndef NULL~n', []),
  514    format(Out, '#define NULL ((void *)0)~n', []),
  515    format(Out, '#endif~n~n', []).
  516
  517
  518make_C_compat_file_header(Out) :-
  519    prolog_load_context(dialect, sicstus),
  520    !,
  521    format(Out, '#define SP_WRAPPER 1~n', []),
  522    format(Out, '#include <sicstus/sicstus.h>~n', []).
  523make_C_compat_file_header(_).
  524
  525
  526                 /*******************************
  527                 *           TOPLEVEL           *
  528                 *******************************/
  529
  530%!  load_foreign_files is det.
  531%!  load_foreign_files(:Files, +Libs) is det.
  532%!  load_foreign_files(+SharedObject, :Files, +Libs) is det.
  533%
  534%   Calls make_foreign_wrapper_file(+File), compiles the wrapper
  535%   and loads the predicates.
  536
  537load_foreign_files :-
  538    context_module(M),
  539    findall(File, hook(M:foreign_file(File, _)), OFiles),
  540    load_foreign_files(M:OFiles, []).
  541load_foreign_files(OFiles, Libs) :-
  542    gensym(link, LinkBase),
  543    load_foreign_files(LinkBase, OFiles, Libs).
  544
  545load_foreign_files(LinkBase, M:_, _) :-
  546    catch(load_foreign_library(M:LinkBase), _, fail),
  547    !.
  548load_foreign_files(LinkBase, OFiles, Libs) :-
  549    make_shared_object(LinkBase, OFiles, Libs),
  550    OFiles = M:_List,
  551    load_foreign_library(M:LinkBase).
  552
  553%!  make_shared_object(+Object, :Files, +Libs) is det.
  554%
  555%   Generate  a  wrapper  and  link  it  using  plld  to  the  given
  556%   SharedObject.
  557
  558make_shared_object(LinkBase, M:OFiles, Libs) :-
  559    make_foreign_wrapper_file(M:OFiles, LinkBase),
  560    file_name_extension(LinkBase, c, CFile),
  561    build_shared_object(LinkBase, [CFile|OFiles], Libs).
  562
  563%!  make_foreign_wrapper_file(:OutFile) is det.
  564%!  make_foreign_wrapper_file(:Files, +OutFile) is det.
  565%
  566%   Just output the wrapper file to the named .c file.  May be used
  567%   to prepare for static linking or the preparation of the native
  568%   SWI-Prolog foreign-file.
  569
  570make_foreign_wrapper_file(M:CFile) :-
  571    findall(File, hook(M:foreign_file(File, _)), OFiles),
  572    make_foreign_wrapper_file(M:OFiles, CFile).
  573make_foreign_wrapper_file(M:OFiles, Base) :-
  574    file_name_extension(Base, c, CFile),
  575    file_base_name(Base, FuncBase),
  576    atom_concat(install_, FuncBase, InstallFunc),
  577    collect_foreign_predicates(OFiles, M, Preds),
  578    open(CFile, write, Out),
  579    make_C_file_header(Out),
  580    make_wrappers(Preds, M, Out),
  581    make_C_init(Out, InstallFunc, -, M, Preds),
  582    close(Out).
  583
  584
  585collect_foreign_predicates([], _, []).
  586collect_foreign_predicates([File|Files], M, Preds) :-
  587    hook(M:foreign_file(File, P0)),
  588    collect_foreign_predicates(Files, M, P1),
  589    append(P0, P1, Preds).
  590
  591build_shared_object(Object, Files, Libs) :-
  592    current_prolog_flag(shared_object_extension, Ext),
  593    file_name_extension(Object, Ext, SharedObject),
  594    append(Files, Libs, Input),
  595    atomic_list_concat(Input, ' ', InputAtom),
  596    setting(linker, Linker),
  597    format(string(Command),
  598           '~w -shared -o ~w ~w', [Linker, SharedObject, InputAtom]),
  599    shell(Command).
  600
  601
  602                 /*******************************
  603                 *            SICSTUS           *
  604                 *******************************/
  605
  606%!  make_foreign_resource_wrapper(:Resource, +ResBase, +FileBase)
  607%
  608%   Create a wrapper-file for the given foreign resource
  609
  610make_foreign_resource_wrapper(M:Resource, ResBase, FileBase) :-
  611    hook(M:foreign_resource(Resource, Functions)),
  612    take(init(Init), Functions, Functions1, -),
  613    take(deinit(DeInit), Functions1, Preds, -),
  614    file_name_extension(FileBase, c, CFile),
  615    file_base_name(ResBase, FuncBase),
  616    atom_concat(install_, FuncBase, InstallFunc),
  617    atom_concat(uninstall_, FuncBase, UninstallFunc),
  618    open(CFile, write, Out),
  619    make_C_file_header(Out),
  620    make_wrappers(Preds, M, Out),
  621    make_C_init(Out, InstallFunc, Init, M, Preds),
  622    make_C_deinit(Out, UninstallFunc, DeInit),
  623    close(Out).
  624
  625take(Term, List, Rest, Default) :-
  626    (   select(Term, List, Rest)
  627    ->  true
  628    ;   arg(1, Term, Default),
  629        Rest = List
  630    ).
  631
  632
  633%!  load_foreign_resource(:Resource, +Dir)
  634%
  635%   Load a foreign module. First try to  load from the same direcory
  636%   as the Prolog file. Otherwise   load  using SWI-Prolog's default
  637%   search path.
  638
  639load_foreign_resource(M:Resource, Source) :-
  640    absolute_file_name(Resource, Object,
  641                       [ file_type(executable),
  642                         relative_to(Source),
  643                         file_errors(fail)
  644                       ]),
  645    !,
  646    load_foreign_library(M:Object).
  647load_foreign_resource(M:Resource, _) :-
  648    load_foreign_library(M:foreign(Resource)).
  649
  650
  651                 /*******************************
  652                 *             UTIL             *
  653                 *******************************/
  654
  655arg_name(N, Name) :-
  656    C is N + 0'a - 1,
  657    atom_codes(Name, [C]).
  658
  659wrapper_name(_:Head, Wrapper, Arity) :-
  660    functor(Head, Name, Arity),
  661    atomic_list_concat(['_plw_', Name, Arity], Wrapper).
  662
  663%!  map_C_type(+Prolog, -C)
  664%
  665%   Map Prolog interface type declarations into C types.
  666
  667map_C_type(X, Y) :-
  668    map_C_type_(X, Y),
  669    !.
  670map_C_type(X, X).
  671
  672map_C_type_(int, 'int ').
  673map_C_type_(integer, 'long ').
  674map_C_type_(size_t, 'size_t ').
  675map_C_type_(float,   'double ').
  676map_C_type_(string,  'char *').
  677map_C_type_(chars,   'char *').
  678map_C_type_(address, 'void *').
  679map_C_type_(address(Of), Type) :-
  680    atom_concat(Of, ' *', Type).
  681map_C_type_(term,    'term_t ').
  682
  683warning(Fmt, Args) :-
  684    print_message(warning, format(Fmt, Args)).
  685
  686
  687                 /*******************************
  688                 *            XREF              *
  689                 *******************************/
  690
  691:- multifile
  692    prolog:hook/1.  693
  694prolog:hook(foreign(_,_,_)).
  695prolog:hook(foreign_resource(_,_))