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)  1985-2020, University of Amsterdam
    7                              VU University Amsterdam
    8                              CWI, Amsterdam
    9    All rights reserved.
   10
   11    Redistribution and use in source and binary forms, with or without
   12    modification, are permitted provided that the following conditions
   13    are met:
   14
   15    1. Redistributions of source code must retain the above copyright
   16       notice, this list of conditions and the following disclaimer.
   17
   18    2. Redistributions in binary form must reproduce the above copyright
   19       notice, this list of conditions and the following disclaimer in
   20       the documentation and/or other materials provided with the
   21       distribution.
   22
   23    THIS SOFTWARE IS PROVIDED BY THE COPYRIGHT HOLDERS AND CONTRIBUTORS
   24    "AS IS" AND ANY EXPRESS OR IMPLIED WARRANTIES, INCLUDING, BUT NOT
   25    LIMITED TO, THE IMPLIED WARRANTIES OF MERCHANTABILITY AND FITNESS
   26    FOR A PARTICULAR PURPOSE ARE DISCLAIMED. IN NO EVENT SHALL THE
   27    COPYRIGHT OWNER OR CONTRIBUTORS BE LIABLE FOR ANY DIRECT, INDIRECT,
   28    INCIDENTAL, SPECIAL, EXEMPLARY, OR CONSEQUENTIAL DAMAGES (INCLUDING,
   29    BUT NOT LIMITED TO, PROCUREMENT OF SUBSTITUTE GOODS OR SERVICES;
   30    LOSS OF USE, DATA, OR PROFITS; OR BUSINESS INTERRUPTION) HOWEVER
   31    CAUSED AND ON ANY THEORY OF LIABILITY, WHETHER IN CONTRACT, STRICT
   32    LIABILITY, OR TORT (INCLUDING NEGLIGENCE OR OTHERWISE) ARISING IN
   33    ANY WAY OUT OF THE USE OF THIS SOFTWARE, EVEN IF ADVISED OF THE
   34    POSSIBILITY OF SUCH DAMAGE.
   35*/
   36
   37:- module('$syspreds',
   38          [ leash/1,
   39            visible/1,
   40            style_check/1,
   41            (spy)/1,
   42            (nospy)/1,
   43            nospyall/0,
   44            debugging/0,
   45            flag/3,
   46            atom_prefix/2,
   47            dwim_match/2,
   48            source_file_property/2,
   49            source_file/1,
   50            source_file/2,
   51            unload_file/1,
   52            exists_source/1,                    % +Spec
   53            exists_source/2,                    % +Spec, -Path
   54            use_foreign_library/1,		% :FileSpec
   55            use_foreign_library/2,		% :FileSpec, +Install
   56            prolog_load_context/2,
   57            stream_position_data/3,
   58            current_predicate/2,
   59            '$defined_predicate'/1,
   60            predicate_property/2,
   61            '$predicate_property'/2,
   62            (dynamic)/2,                        % :Predicates, +Options
   63            clause_property/2,
   64            current_module/1,                   % ?Module
   65            module_property/2,                  % ?Module, ?Property
   66            module/1,                           % +Module
   67            current_trie/1,                     % ?Trie
   68            trie_property/2,                    % ?Trie, ?Property
   69            working_directory/2,                % -OldDir, +NewDir
   70            shell/1,                            % +Command
   71            on_signal/3,
   72            current_signal/3,
   73            open_shared_object/2,
   74            open_shared_object/3,
   75            format/1,
   76            garbage_collect/0,
   77            set_prolog_stack/2,
   78            prolog_stack_property/2,
   79            absolute_file_name/2,
   80            tmp_file_stream/3,                  % +Enc, -File, -Stream
   81            call_with_depth_limit/3,            % :Goal, +Limit, -Result
   82            call_with_inference_limit/3,        % :Goal, +Limit, -Result
   83            numbervars/3,                       % +Term, +Start, -End
   84            term_string/3,                      % ?Term, ?String, +Options
   85            nb_setval/2,                        % +Var, +Value
   86            thread_create/2,                    % :Goal, -Id
   87            thread_join/1,                      % +Id
   88            transaction/1,                      % :Goal
   89            transaction/2,                      % :Goal, +Options
   90            transaction/3,                      % :Goal, :Constraint, +Mutex
   91            snapshot/1,                         % :Goal
   92            set_prolog_gc_thread/1,		% +Status
   93
   94            '$wrap_predicate'/5                 % :Head, +Name, -Closure, -Wrapped, +Body
   95          ]).   96
   97:- meta_predicate
   98    dynamic(:, +),
   99    use_foreign_library(:),
  100    use_foreign_library(:, +),
  101    transaction(0),
  102    transaction(0,0,+),
  103    snapshot(0).  104
  105
  106                /********************************
  107                *           DEBUGGER            *
  108                *********************************/
  109
  110%!  map_bits(:Pred, +Modify, +OldBits, -NewBits)
  111
  112:- meta_predicate
  113    map_bits(2, +, +, -).  114
  115map_bits(_, Var, _, _) :-
  116    var(Var),
  117    !,
  118    '$instantiation_error'(Var).
  119map_bits(_, [], Bits, Bits) :- !.
  120map_bits(Pred, [H|T], Old, New) :-
  121    map_bits(Pred, H, Old, New0),
  122    map_bits(Pred, T, New0, New).
  123map_bits(Pred, +Name, Old, New) :-     % set a bit
  124    !,
  125    bit(Pred, Name, Bits),
  126    !,
  127    New is Old \/ Bits.
  128map_bits(Pred, -Name, Old, New) :-     % clear a bit
  129    !,
  130    bit(Pred, Name, Bits),
  131    !,
  132    New is Old /\ (\Bits).
  133map_bits(Pred, ?(Name), Old, Old) :-   % ask a bit
  134    !,
  135    bit(Pred, Name, Bits),
  136    Old /\ Bits > 0.
  137map_bits(_, Term, _, _) :-
  138    '$type_error'('+|-|?(Flag)', Term).
  139
  140bit(Pred, Name, Bits) :-
  141    call(Pred, Name, Bits),
  142    !.
  143bit(_:Pred, Name, _) :-
  144    '$domain_error'(Pred, Name).
  145
  146:- public port_name/2.                  % used by library(test_cover)
  147
  148port_name(      call, 2'000000001).
  149port_name(      exit, 2'000000010).
  150port_name(      fail, 2'000000100).
  151port_name(      redo, 2'000001000).
  152port_name(     unify, 2'000010000).
  153port_name(     break, 2'000100000).
  154port_name(  cut_call, 2'001000000).
  155port_name(  cut_exit, 2'010000000).
  156port_name( exception, 2'100000000).
  157port_name(       cut, 2'011000000).
  158port_name(       all, 2'000111111).
  159port_name(      full, 2'000101111).
  160port_name(      half, 2'000101101).     % '
  161
  162leash(Ports) :-
  163    '$leash'(Old, Old),
  164    map_bits(port_name, Ports, Old, New),
  165    '$leash'(_, New).
  166
  167visible(Ports) :-
  168    '$visible'(Old, Old),
  169    map_bits(port_name, Ports, Old, New),
  170    '$visible'(_, New).
  171
  172style_name(atom,            0x0001) :-
  173    print_message(warning, decl_no_effect(style_check(atom))).
  174style_name(singleton,       0x0042).            % semantic and syntactic
  175style_name(discontiguous,   0x0008).
  176style_name(charset,         0x0020).
  177style_name(no_effect,       0x0080).
  178style_name(var_branches,    0x0100).
  179
  180%!  style_check(+Spec) is nondet.
  181
  182style_check(Var) :-
  183    var(Var),
  184    !,
  185    '$instantiation_error'(Var).
  186style_check(?(Style)) :-
  187    !,
  188    (   var(Style)
  189    ->  enum_style_check(Style)
  190    ;   enum_style_check(Style)
  191    ->  true
  192    ).
  193style_check(Spec) :-
  194    '$style_check'(Old, Old),
  195    map_bits(style_name, Spec, Old, New),
  196    '$style_check'(_, New).
  197
  198enum_style_check(Style) :-
  199    '$style_check'(Bits, Bits),
  200    style_name(Style, Bit),
  201    Bit /\ Bits =\= 0.
  202
  203
  204%!  prolog:debug_control_hook(+Action)
  205%
  206%   Allow user-hooks in the Prolog debugger interaction.  See the calls
  207%   below for the provided hooks.  We use a single predicate with action
  208%   argument to avoid an uncontrolled poliferation of hooks.
  209
  210:- multifile
  211    prolog:debug_control_hook/1.    % +Action
  212
  213:- meta_predicate
  214    spy(:),
  215    nospy(:).  216
  217%!  spy(:Spec) is det.
  218%!  nospy(:Spec) is det.
  219%!  nospyall is det.
  220%
  221%   Set/clear spy-points. A successfully set or cleared spy-point is
  222%   reported using print_message/2, level  =informational=, with one
  223%   of the following terms, where Spec is of the form M:Head.
  224%
  225%       - spy(Spec)
  226%       - nospy(Spec)
  227%
  228%   @see    spy/1 and nospy/1 call the hook prolog:debug_control_hook/1
  229%           to allow for alternative specifications of the thing to
  230%           debug.
  231
  232spy(_:X) :-
  233    var(X),
  234    throw(error(instantiation_error, _)).
  235spy(_:[]) :- !.
  236spy(M:[H|T]) :-
  237    !,
  238    spy(M:H),
  239    spy(M:T).
  240spy(Spec) :-
  241    notrace(prolog:debug_control_hook(spy(Spec))),
  242    !.
  243spy(Spec) :-
  244    '$find_predicate'(Spec, Preds),
  245    '$member'(PI, Preds),
  246        pi_to_head(PI, Head),
  247        '$define_predicate'(Head),
  248        '$spy'(Head),
  249    fail.
  250spy(_).
  251
  252nospy(_:X) :-
  253    var(X),
  254    throw(error(instantiation_error, _)).
  255nospy(_:[]) :- !.
  256nospy(M:[H|T]) :-
  257    !,
  258    nospy(M:H),
  259    nospy(M:T).
  260nospy(Spec) :-
  261    notrace(prolog:debug_control_hook(nospy(Spec))),
  262    !.
  263nospy(Spec) :-
  264    '$find_predicate'(Spec, Preds),
  265    '$member'(PI, Preds),
  266         pi_to_head(PI, Head),
  267        '$nospy'(Head),
  268    fail.
  269nospy(_).
  270
  271nospyall :-
  272    notrace(prolog:debug_control_hook(nospyall)),
  273    fail.
  274nospyall :-
  275    spy_point(Head),
  276        '$nospy'(Head),
  277    fail.
  278nospyall.
  279
  280pi_to_head(M:PI, M:Head) :-
  281    !,
  282    pi_to_head(PI, Head).
  283pi_to_head(Name/Arity, Head) :-
  284    functor(Head, Name, Arity).
  285
  286%!  debugging is det.
  287%
  288%   Report current status of the debugger.
  289
  290debugging :-
  291    notrace(prolog:debug_control_hook(debugging)),
  292    !.
  293debugging :-
  294    current_prolog_flag(debug, true),
  295    !,
  296    print_message(informational, debugging(on)),
  297    findall(H, spy_point(H), SpyPoints),
  298    print_message(informational, spying(SpyPoints)).
  299debugging :-
  300    print_message(informational, debugging(off)).
  301
  302spy_point(Module:Head) :-
  303    current_predicate(_, Module:Head),
  304    '$get_predicate_attribute'(Module:Head, spy, 1),
  305    \+ predicate_property(Module:Head, imported_from(_)).
  306
  307%!  flag(+Name, -Old, +New) is det.
  308%
  309%   True when Old is the current value associated with the flag Name
  310%   and New has become the new value.
  311
  312flag(Name, Old, New) :-
  313    Old == New,
  314    !,
  315    get_flag(Name, Old).
  316flag(Name, Old, New) :-
  317    with_mutex('$flag', update_flag(Name, Old, New)).
  318
  319update_flag(Name, Old, New) :-
  320    get_flag(Name, Old),
  321    (   atom(New)
  322    ->  set_flag(Name, New)
  323    ;   Value is New,
  324        set_flag(Name, Value)
  325    ).
  326
  327
  328                /********************************
  329                *             ATOMS             *
  330                *********************************/
  331
  332dwim_match(A1, A2) :-
  333    dwim_match(A1, A2, _).
  334
  335atom_prefix(Atom, Prefix) :-
  336    sub_atom(Atom, 0, _, _, Prefix).
  337
  338
  339                /********************************
  340                *             SOURCE            *
  341                *********************************/
  342
  343%!  source_file(-File) is nondet.
  344%!  source_file(+File) is semidet.
  345%
  346%   True if File is loaded into  Prolog.   If  File is unbound it is
  347%   bound to the canonical name for it. If File is bound it succeeds
  348%   if the canonical name  as   defined  by  absolute_file_name/2 is
  349%   known as a loaded filename.
  350%
  351%   Note that Time = 0.0 is used by  PlDoc and other code that needs
  352%   to create a file record without being interested in the time.
  353
  354source_file(File) :-
  355    (   current_prolog_flag(access_level, user)
  356    ->  Level = user
  357    ;   true
  358    ),
  359    (   ground(File)
  360    ->  (   '$time_source_file'(File, Time, Level)
  361        ;   absolute_file_name(File, Abs),
  362            '$time_source_file'(Abs, Time, Level)
  363        ), !
  364    ;   '$time_source_file'(File, Time, Level)
  365    ),
  366    Time > 0.0.
  367
  368%!  source_file(+Head, -File) is semidet.
  369%!  source_file(?Head, ?File) is nondet.
  370%
  371%   True when Head is a predicate owned by File.
  372
  373:- meta_predicate source_file(:, ?).  374
  375source_file(M:Head, File) :-
  376    nonvar(M), nonvar(Head),
  377    !,
  378    (   '$c_current_predicate'(_, M:Head),
  379        predicate_property(M:Head, multifile)
  380    ->  multi_source_files(M:Head, Files),
  381        '$member'(File, Files)
  382    ;   '$source_file'(M:Head, File)
  383    ).
  384source_file(M:Head, File) :-
  385    (   nonvar(File)
  386    ->  true
  387    ;   source_file(File)
  388    ),
  389    '$source_file_predicates'(File, Predicates),
  390    '$member'(M:Head, Predicates).
  391
  392:- thread_local found_src_file/1.  393
  394multi_source_files(Head, Files) :-
  395    call_cleanup(
  396        findall(File, multi_source_file(Head, File), Files),
  397        retractall(found_src_file(_))).
  398
  399multi_source_file(Head, File) :-
  400    nth_clause(Head, _, Clause),
  401    clause_property(Clause, source(File)),
  402    \+ found_src_file(File),
  403    asserta(found_src_file(File)).
  404
  405
  406%!  source_file_property(?File, ?Property) is nondet.
  407%
  408%   True if Property is a property of the loaded source-file File.
  409
  410source_file_property(File, P) :-
  411    nonvar(File),
  412    !,
  413    canonical_source_file(File, Path),
  414    property_source_file(P, Path).
  415source_file_property(File, P) :-
  416    property_source_file(P, File).
  417
  418property_source_file(modified(Time), File) :-
  419    '$time_source_file'(File, Time, user).
  420property_source_file(source(Source), File) :-
  421    (   '$source_file_property'(File, from_state, true)
  422    ->  Source = state
  423    ;   '$source_file_property'(File, resource, true)
  424    ->  Source = resource
  425    ;   Source = file
  426    ).
  427property_source_file(module(M), File) :-
  428    (   nonvar(M)
  429    ->  '$current_module'(M, File)
  430    ;   nonvar(File)
  431    ->  '$current_module'(ML, File),
  432        (   atom(ML)
  433        ->  M = ML
  434        ;   '$member'(M, ML)
  435        )
  436    ;   '$current_module'(M, File)
  437    ).
  438property_source_file(load_context(Module, Location, Options), File) :-
  439    '$time_source_file'(File, _, user),
  440    clause(system:'$load_context_module'(File, Module, Options), true, Ref),
  441    (   clause_property(Ref, file(FromFile)),
  442        clause_property(Ref, line_count(FromLine))
  443    ->  Location = FromFile:FromLine
  444    ;   Location = user
  445    ).
  446property_source_file(includes(Master, Stamp), File) :-
  447    system:'$included'(File, _Line, Master, Stamp).
  448property_source_file(included_in(Master, Line), File) :-
  449    system:'$included'(Master, Line, File, _).
  450property_source_file(derived_from(DerivedFrom, Stamp), File) :-
  451    system:'$derived_source'(File, DerivedFrom, Stamp).
  452property_source_file(reloading, File) :-
  453    source_file(File),
  454    '$source_file_property'(File, reloading, true).
  455property_source_file(load_count(Count), File) :-
  456    source_file(File),
  457    '$source_file_property'(File, load_count, Count).
  458property_source_file(number_of_clauses(Count), File) :-
  459    source_file(File),
  460    '$source_file_property'(File, number_of_clauses, Count).
  461
  462
  463%!  canonical_source_file(+Spec, -File) is semidet.
  464%
  465%   File is the canonical representation of the source-file Spec.
  466
  467canonical_source_file(Spec, File) :-
  468    atom(Spec),
  469    '$time_source_file'(Spec, _, _),
  470    !,
  471    File = Spec.
  472canonical_source_file(Spec, File) :-
  473    system:'$included'(_Master, _Line, Spec, _),
  474    !,
  475    File = Spec.
  476canonical_source_file(Spec, File) :-
  477    absolute_file_name(Spec,
  478                           [ file_type(prolog),
  479                             access(read),
  480                             file_errors(fail)
  481                           ],
  482                           File),
  483    source_file(File).
  484
  485
  486%!  exists_source(+Source) is semidet.
  487%!  exists_source(+Source, -Path) is semidet.
  488%
  489%   True if Source (a term  valid   for  load_files/2) exists. Fails
  490%   without error if this is not the case. The predicate is intended
  491%   to be used with  :-  if,  as   in  the  example  below. See also
  492%   source_exports/2.
  493%
  494%   ```
  495%   :- if(exists_source(library(error))).
  496%   :- use_module_library(error).
  497%   :- endif.
  498%   ```
  499
  500exists_source(Source) :-
  501    exists_source(Source, _Path).
  502
  503exists_source(Source, Path) :-
  504    absolute_file_name(Source, Path,
  505                       [ file_type(prolog),
  506                         access(read),
  507                         file_errors(fail)
  508                       ]).
  509
  510
  511%!  prolog_load_context(+Key, -Value)
  512%
  513%   Provides context information for  term_expansion and directives.
  514%   Note  that  only  the  line-number  info    is   valid  for  the
  515%   '$stream_position'. Largely Quintus compatible.
  516
  517prolog_load_context(module, Module) :-
  518    '$current_source_module'(Module).
  519prolog_load_context(file, File) :-
  520    input_file(File).
  521prolog_load_context(source, F) :-       % SICStus compatibility
  522    input_file(F0),
  523    '$input_context'(Context),
  524    '$top_file'(Context, F0, F).
  525prolog_load_context(stream, S) :-
  526    (   system:'$load_input'(_, S0)
  527    ->  S = S0
  528    ).
  529prolog_load_context(directory, D) :-
  530    input_file(F),
  531    file_directory_name(F, D).
  532prolog_load_context(dialect, D) :-
  533    current_prolog_flag(emulated_dialect, D).
  534prolog_load_context(term_position, TermPos) :-
  535    source_location(_, L),
  536    (   nb_current('$term_position', Pos),
  537        compound(Pos),              % actually set
  538        stream_position_data(line_count, Pos, L)
  539    ->  TermPos = Pos
  540    ;   TermPos = '$stream_position'(0,L,0,0)
  541    ).
  542prolog_load_context(script, Bool) :-
  543    (   '$toplevel':loaded_init_file(script, Path),
  544        input_file(File),
  545        same_file(File, Path)
  546    ->  Bool = true
  547    ;   Bool = false
  548    ).
  549prolog_load_context(variable_names, Bindings) :-
  550    nb_current('$variable_names', Bindings).
  551prolog_load_context(term, Term) :-
  552    nb_current('$term', Term).
  553prolog_load_context(reloading, true) :-
  554    prolog_load_context(source, F),
  555    '$source_file_property'(F, reloading, true).
  556
  557input_file(File) :-
  558    (   system:'$load_input'(_, Stream)
  559    ->  stream_property(Stream, file_name(File))
  560    ),
  561    !.
  562input_file(File) :-
  563    source_location(File, _).
  564
  565
  566%!  unload_file(+File) is det.
  567%
  568%   Remove all traces of loading file.
  569
  570:- dynamic system:'$resolved_source_path'/2.  571
  572unload_file(File) :-
  573    (   canonical_source_file(File, Path)
  574    ->  '$unload_file'(Path),
  575        retractall(system:'$resolved_source_path'(_, Path))
  576    ;   true
  577    ).
  578
  579		 /*******************************
  580		 *      FOREIGN LIBRARIES	*
  581		 *******************************/
  582
  583%!  use_foreign_library(+FileSpec) is det.
  584%!  use_foreign_library(+FileSpec, +Entry:atom) is det.
  585%
  586%   Load and install a foreign   library as load_foreign_library/1,2
  587%   and register the installation using   initialization/2  with the
  588%   option =now=. This is similar to using:
  589%
  590%     ==
  591%     :- initialization(load_foreign_library(foreign(mylib))).
  592%     ==
  593%
  594%   but using the initialization/1 wrapper causes  the library to be
  595%   loaded _after_ loading of  the  file   in  which  it  appears is
  596%   completed,  while  use_foreign_library/1  loads    the   library
  597%   _immediately_. I.e. the  difference  is   only  relevant  if the
  598%   remainder of the file uses functionality of the C-library.
  599
  600use_foreign_library(FileSpec) :-
  601    ensure_shlib,
  602    initialization(shlib:load_foreign_library(FileSpec), now).
  603
  604use_foreign_library(FileSpec, Entry) :-
  605    ensure_shlib,
  606    initialization(shlib:load_foreign_library(FileSpec, Entry), now).
  607
  608ensure_shlib :-
  609    '$get_predicate_attribute'(shlib:load_foreign_library(_), defined, 1),
  610    '$get_predicate_attribute'(shlib:load_foreign_library(_,_), defined, 1),
  611    !.
  612ensure_shlib :-
  613    use_module(library(shlib), []).
  614
  615
  616                 /*******************************
  617                 *            STREAMS           *
  618                 *******************************/
  619
  620%!  stream_position_data(?Field, +Pos, ?Date)
  621%
  622%   Extract values from stream position objects. '$stream_position' is
  623%   of the format '$stream_position'(Byte, Char, Line, LinePos)
  624
  625stream_position_data(Prop, Term, Value) :-
  626    nonvar(Prop),
  627    !,
  628    (   stream_position_field(Prop, Pos)
  629    ->  arg(Pos, Term, Value)
  630    ;   throw(error(domain_error(stream_position_data, Prop)))
  631    ).
  632stream_position_data(Prop, Term, Value) :-
  633    stream_position_field(Prop, Pos),
  634    arg(Pos, Term, Value).
  635
  636stream_position_field(char_count,    1).
  637stream_position_field(line_count,    2).
  638stream_position_field(line_position, 3).
  639stream_position_field(byte_count,    4).
  640
  641
  642                 /*******************************
  643                 *            CONTROL           *
  644                 *******************************/
  645
  646%!  call_with_depth_limit(:Goal, +DepthLimit, -Result)
  647%
  648%   Try to proof Goal, but fail on any branch exceeding the indicated
  649%   depth-limit.  Unify Result with the maximum-reached limit on success,
  650%   depth_limit_exceeded if the limit was exceeded and fails otherwise.
  651
  652:- meta_predicate
  653    call_with_depth_limit(0, +, -).  654
  655call_with_depth_limit(G, Limit, Result) :-
  656    '$depth_limit'(Limit, OLimit, OReached),
  657    (   catch(G, E, '$depth_limit_except'(OLimit, OReached, E)),
  658        '$depth_limit_true'(Limit, OLimit, OReached, Result, Det),
  659        ( Det == ! -> ! ; true )
  660    ;   '$depth_limit_false'(OLimit, OReached, Result)
  661    ).
  662
  663%!  call_with_inference_limit(:Goal, +InferenceLimit, -Result)
  664%
  665%   Equivalent to call(Goal),  but  poses  a   limit  on  the  number of
  666%   inferences. If this  limit  is  reached,   Result  is  unified  with
  667%   `inference_limit_exceeded`, otherwise Result is unified  with `!` if
  668%   Goal succeeded without a choicepoint and `true` otherwise.
  669%
  670%   Note that we perform calls in  system to avoid auto-importing, which
  671%   makes raiseInferenceLimitException() fail  to   recognise  that  the
  672%   exception happens in the overhead.
  673
  674:- meta_predicate
  675    call_with_inference_limit(0, +, -).  676
  677call_with_inference_limit(G, Limit, Result) :-
  678    '$inference_limit'(Limit, OLimit),
  679    (   catch(G, Except,
  680              system:'$inference_limit_except'(OLimit, Except, Result0)),
  681        (   Result0 == inference_limit_exceeded
  682        ->  !
  683        ;   system:'$inference_limit_true'(Limit, OLimit, Result0),
  684            ( Result0 == ! -> ! ; true )
  685        ),
  686        Result = Result0
  687    ;   system:'$inference_limit_false'(OLimit)
  688    ).
  689
  690
  691                /********************************
  692                *           DATA BASE           *
  693                *********************************/
  694
  695/* - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - -
  696The predicate current_predicate/2 is   a  difficult subject since  the
  697introduction  of defaulting     modules   and   dynamic     libraries.
  698current_predicate/2 is normally  called with instantiated arguments to
  699verify some  predicate can   be called without trapping   an undefined
  700predicate.  In this case we must  perform the search algorithm used by
  701the prolog system itself.
  702
  703If the pattern is not fully specified, we only generate the predicates
  704actually available in this  module.   This seems the best for listing,
  705etc.
  706- - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - */
  707
  708
  709:- meta_predicate
  710    current_predicate(?, :),
  711    '$defined_predicate'(:).  712
  713current_predicate(Name, Module:Head) :-
  714    (var(Module) ; var(Head)),
  715    !,
  716    generate_current_predicate(Name, Module, Head).
  717current_predicate(Name, Term) :-
  718    '$c_current_predicate'(Name, Term),
  719    '$defined_predicate'(Term),
  720    !.
  721current_predicate(Name, Module:Head) :-
  722    default_module(Module, DefModule),
  723    '$c_current_predicate'(Name, DefModule:Head),
  724    '$defined_predicate'(DefModule:Head),
  725    !.
  726current_predicate(Name, Module:Head) :-
  727    '$autoload':autoload_in(Module, general),
  728    \+ current_prolog_flag(Module:unknown, fail),
  729    (   compound(Head)
  730    ->  compound_name_arity(Head, Name, Arity)
  731    ;   Name = Head, Arity = 0
  732    ),
  733    '$find_library'(Module, Name, Arity, _LoadModule, _Library),
  734    !.
  735
  736generate_current_predicate(Name, Module, Head) :-
  737    current_module(Module),
  738    QHead = Module:Head,
  739    '$c_current_predicate'(Name, QHead),
  740    '$get_predicate_attribute'(QHead, defined, 1).
  741
  742'$defined_predicate'(Head) :-
  743    '$get_predicate_attribute'(Head, defined, 1),
  744    !.
  745
  746%!  predicate_property(?Predicate, ?Property) is nondet.
  747%
  748%   True when Property is a property of Predicate.
  749
  750:- meta_predicate
  751    predicate_property(:, ?).  752
  753:- multifile
  754    '$predicate_property'/2.  755
  756:- '$iso'(predicate_property/2).  757
  758predicate_property(Pred, Property) :-           % Mode ?,+
  759    nonvar(Property),
  760    !,
  761    property_predicate(Property, Pred).
  762predicate_property(Pred, Property) :-           % Mode +,-
  763    define_or_generate(Pred),
  764    '$predicate_property'(Property, Pred).
  765
  766%!  property_predicate(+Property, ?Pred)
  767%
  768%   First handle the special  cases  that   are  not  about querying
  769%   normally  defined  predicates:   =undefined=,    =visible=   and
  770%   =autoload=, followed by the generic case.
  771
  772property_predicate(undefined, Pred) :-
  773    !,
  774    Pred = Module:Head,
  775    current_module(Module),
  776    '$c_current_predicate'(_, Pred),
  777    \+ '$defined_predicate'(Pred),          % Speed up a bit
  778    \+ current_predicate(_, Pred),
  779    goal_name_arity(Head, Name, Arity),
  780    \+ system_undefined(Module:Name/Arity).
  781property_predicate(visible, Pred) :-
  782    !,
  783    visible_predicate(Pred).
  784property_predicate(autoload(File), Head) :-
  785    !,
  786    \+ current_prolog_flag(autoload, false),
  787    '$autoload':autoloadable(Head, File).
  788property_predicate(implementation_module(IM), M:Head) :-
  789    !,
  790    atom(M),
  791    (   default_module(M, DM),
  792        '$get_predicate_attribute'(DM:Head, defined, 1)
  793    ->  (   '$get_predicate_attribute'(DM:Head, imported, ImportM)
  794        ->  IM = ImportM
  795        ;   IM = M
  796        )
  797    ;   \+ current_prolog_flag(M:unknown, fail),
  798        goal_name_arity(Head, Name, Arity),
  799        '$find_library'(_, Name, Arity, LoadModule, _File)
  800    ->  IM = LoadModule
  801    ;   M = IM
  802    ).
  803property_predicate(iso, _:Head) :-
  804    callable(Head),
  805    !,
  806    goal_name_arity(Head, Name, Arity),
  807    current_predicate(system:Name/Arity),
  808    '$predicate_property'(iso, system:Head).
  809property_predicate(built_in, Module:Head) :-
  810    callable(Head),
  811    !,
  812    goal_name_arity(Head, Name, Arity),
  813    current_predicate(Module:Name/Arity),
  814    '$predicate_property'(built_in, Module:Head).
  815property_predicate(Property, Pred) :-
  816    define_or_generate(Pred),
  817    '$predicate_property'(Property, Pred).
  818
  819goal_name_arity(Head, Name, Arity) :-
  820    compound(Head),
  821    !,
  822    compound_name_arity(Head, Name, Arity).
  823goal_name_arity(Head, Head, 0).
  824
  825
  826%!  define_or_generate(+Head) is semidet.
  827%!  define_or_generate(-Head) is nondet.
  828%
  829%   If the predicate is known, try to resolve it. Otherwise generate
  830%   the known predicate, but do not try to (auto)load the predicate.
  831
  832define_or_generate(M:Head) :-
  833    callable(Head),
  834    atom(M),
  835    '$get_predicate_attribute'(M:Head, defined, 1),
  836    !.
  837define_or_generate(M:Head) :-
  838    callable(Head),
  839    nonvar(M), M \== system,
  840    !,
  841    '$define_predicate'(M:Head).
  842define_or_generate(Pred) :-
  843    current_predicate(_, Pred),
  844    '$define_predicate'(Pred).
  845
  846
  847'$predicate_property'(interpreted, Pred) :-
  848    '$get_predicate_attribute'(Pred, foreign, 0).
  849'$predicate_property'(visible, Pred) :-
  850    '$get_predicate_attribute'(Pred, defined, 1).
  851'$predicate_property'(built_in, Pred) :-
  852    '$get_predicate_attribute'(Pred, system, 1).
  853'$predicate_property'(exported, Pred) :-
  854    '$get_predicate_attribute'(Pred, exported, 1).
  855'$predicate_property'(public, Pred) :-
  856    '$get_predicate_attribute'(Pred, public, 1).
  857'$predicate_property'(non_terminal, Pred) :-
  858    '$get_predicate_attribute'(Pred, non_terminal, 1).
  859'$predicate_property'(foreign, Pred) :-
  860    '$get_predicate_attribute'(Pred, foreign, 1).
  861'$predicate_property'((dynamic), Pred) :-
  862    '$get_predicate_attribute'(Pred, (dynamic), 1).
  863'$predicate_property'((static), Pred) :-
  864    '$get_predicate_attribute'(Pred, (dynamic), 0).
  865'$predicate_property'((volatile), Pred) :-
  866    '$get_predicate_attribute'(Pred, (volatile), 1).
  867'$predicate_property'((thread_local), Pred) :-
  868    '$get_predicate_attribute'(Pred, (thread_local), 1).
  869'$predicate_property'((multifile), Pred) :-
  870    '$get_predicate_attribute'(Pred, (multifile), 1).
  871'$predicate_property'(imported_from(Module), Pred) :-
  872    '$get_predicate_attribute'(Pred, imported, Module).
  873'$predicate_property'(transparent, Pred) :-
  874    '$get_predicate_attribute'(Pred, transparent, 1).
  875'$predicate_property'(meta_predicate(Pattern), Pred) :-
  876    '$get_predicate_attribute'(Pred, meta_predicate, Pattern).
  877'$predicate_property'(file(File), Pred) :-
  878    '$get_predicate_attribute'(Pred, file, File).
  879'$predicate_property'(line_count(LineNumber), Pred) :-
  880    '$get_predicate_attribute'(Pred, line_count, LineNumber).
  881'$predicate_property'(notrace, Pred) :-
  882    '$get_predicate_attribute'(Pred, trace, 0).
  883'$predicate_property'(nodebug, Pred) :-
  884    '$get_predicate_attribute'(Pred, hide_childs, 1).
  885'$predicate_property'(spying, Pred) :-
  886    '$get_predicate_attribute'(Pred, spy, 1).
  887'$predicate_property'(number_of_clauses(N), Pred) :-
  888    '$get_predicate_attribute'(Pred, number_of_clauses, N).
  889'$predicate_property'(number_of_rules(N), Pred) :-
  890    '$get_predicate_attribute'(Pred, number_of_rules, N).
  891'$predicate_property'(last_modified_generation(Gen), Pred) :-
  892    '$get_predicate_attribute'(Pred, last_modified_generation, Gen).
  893'$predicate_property'(indexed(Indices), Pred) :-
  894    '$get_predicate_attribute'(Pred, indexed, Indices).
  895'$predicate_property'(noprofile, Pred) :-
  896    '$get_predicate_attribute'(Pred, noprofile, 1).
  897'$predicate_property'(iso, Pred) :-
  898    '$get_predicate_attribute'(Pred, iso, 1).
  899'$predicate_property'(quasi_quotation_syntax, Pred) :-
  900    '$get_predicate_attribute'(Pred, quasi_quotation_syntax, 1).
  901'$predicate_property'(defined, Pred) :-
  902    '$get_predicate_attribute'(Pred, defined, 1).
  903'$predicate_property'(tabled, Pred) :-
  904    '$get_predicate_attribute'(Pred, tabled, 1).
  905'$predicate_property'(tabled(Flag), Pred) :-
  906    '$get_predicate_attribute'(Pred, tabled, 1),
  907    table_flag(Flag, Pred).
  908'$predicate_property'(incremental, Pred) :-
  909    '$get_predicate_attribute'(Pred, incremental, 1).
  910'$predicate_property'(monotonic, Pred) :-
  911    '$get_predicate_attribute'(Pred, monotonic, 1).
  912'$predicate_property'(opaque, Pred) :-
  913    '$get_predicate_attribute'(Pred, opaque, 1).
  914'$predicate_property'(lazy, Pred) :-
  915    '$get_predicate_attribute'(Pred, lazy, 1).
  916'$predicate_property'(abstract(N), Pred) :-
  917    '$get_predicate_attribute'(Pred, abstract, N).
  918'$predicate_property'(size(Bytes), Pred) :-
  919    '$get_predicate_attribute'(Pred, size, Bytes).
  920
  921system_undefined(user:prolog_trace_interception/4).
  922system_undefined(user:prolog_exception_hook/4).
  923system_undefined(system:'$c_call_prolog'/0).
  924system_undefined(system:window_title/2).
  925
  926table_flag(variant, Pred) :-
  927    '$tbl_implementation'(Pred, M:Head),
  928    M:'$tabled'(Head, variant).
  929table_flag(subsumptive, Pred) :-
  930    '$tbl_implementation'(Pred, M:Head),
  931    M:'$tabled'(Head, subsumptive).
  932table_flag(shared, Pred) :-
  933    '$get_predicate_attribute'(Pred, tshared, 1).
  934table_flag(incremental, Pred) :-
  935    '$get_predicate_attribute'(Pred, incremental, 1).
  936table_flag(monotonic, Pred) :-
  937    '$get_predicate_attribute'(Pred, monotonic, 1).
  938table_flag(subgoal_abstract(N), Pred) :-
  939    '$get_predicate_attribute'(Pred, subgoal_abstract, N).
  940table_flag(answer_abstract(N), Pred) :-
  941    '$get_predicate_attribute'(Pred, subgoal_abstract, N).
  942table_flag(subgoal_abstract(N), Pred) :-
  943    '$get_predicate_attribute'(Pred, max_answers, N).
  944
  945
  946%!  visible_predicate(:Head) is nondet.
  947%
  948%   True when Head can be called without raising an existence error.
  949%   This implies it is defined,  can   be  inherited  from a default
  950%   module or can be autoloaded.
  951
  952visible_predicate(Pred) :-
  953    Pred = M:Head,
  954    current_module(M),
  955    (   callable(Head)
  956    ->  (   '$get_predicate_attribute'(Pred, defined, 1)
  957        ->  true
  958        ;   \+ current_prolog_flag(M:unknown, fail),
  959            functor(Head, Name, Arity),
  960            '$find_library'(M, Name, Arity, _LoadModule, _Library)
  961        )
  962    ;   setof(PI, visible_in_module(M, PI), PIs),
  963        '$member'(Name/Arity, PIs),
  964        functor(Head, Name, Arity)
  965    ).
  966
  967visible_in_module(M, Name/Arity) :-
  968    default_module(M, DefM),
  969    DefHead = DefM:Head,
  970    '$c_current_predicate'(_, DefHead),
  971    '$get_predicate_attribute'(DefHead, defined, 1),
  972    \+ hidden_system_predicate(Head),
  973    functor(Head, Name, Arity).
  974visible_in_module(_, Name/Arity) :-
  975    '$in_library'(Name, Arity, _).
  976
  977hidden_system_predicate(Head) :-
  978    functor(Head, Name, _),
  979    atom(Name),                     % Avoid [].
  980    sub_atom(Name, 0, _, _, $),
  981    \+ current_prolog_flag(access_level, system).
  982
  983
  984%!  clause_property(+ClauseRef, ?Property) is nondet.
  985%
  986%   Provide information on individual clauses.  Defined properties
  987%   are:
  988%
  989%       * line_count(-Line)
  990%       Line from which the clause is loaded.
  991%       * file(-File)
  992%       File from which the clause is loaded.
  993%       * source(-File)
  994%       File that `owns' the clause: reloading this file wipes
  995%       the clause.
  996%       * fact
  997%       Clause has body =true=.
  998%       * erased
  999%       Clause was erased.
 1000%       * predicate(:PI)
 1001%       Predicate indicator of the predicate this clause belongs
 1002%       to.  Can be used to find the predicate of erased clauses.
 1003%       * module(-M)
 1004%       Module context in which the clause was compiled.
 1005
 1006clause_property(Clause, Property) :-
 1007    '$clause_property'(Property, Clause).
 1008
 1009'$clause_property'(line_count(LineNumber), Clause) :-
 1010    '$get_clause_attribute'(Clause, line_count, LineNumber).
 1011'$clause_property'(file(File), Clause) :-
 1012    '$get_clause_attribute'(Clause, file, File).
 1013'$clause_property'(source(File), Clause) :-
 1014    '$get_clause_attribute'(Clause, owner, File).
 1015'$clause_property'(size(Bytes), Clause) :-
 1016    '$get_clause_attribute'(Clause, size, Bytes).
 1017'$clause_property'(fact, Clause) :-
 1018    '$get_clause_attribute'(Clause, fact, true).
 1019'$clause_property'(erased, Clause) :-
 1020    '$get_clause_attribute'(Clause, erased, true).
 1021'$clause_property'(predicate(PI), Clause) :-
 1022    '$get_clause_attribute'(Clause, predicate_indicator, PI).
 1023'$clause_property'(module(M), Clause) :-
 1024    '$get_clause_attribute'(Clause, module, M).
 1025
 1026%!  dynamic(:Predicates, +Options) is det.
 1027%
 1028%   Define a predicate as dynamic with optionally additional properties.
 1029%   Defined options are:
 1030%
 1031%     - incremental(+Bool)
 1032%     - abstract(+Level)
 1033%     - multifile(+Bool)
 1034%     - discontiguous(+Bool)
 1035%     - thread(+Mode)
 1036%     - volatile(+Bool)
 1037
 1038dynamic(M:Predicates, Options) :-
 1039    '$must_be'(list, Predicates),
 1040    options_properties(Options, Props),
 1041    set_pprops(Predicates, M, [dynamic|Props]).
 1042
 1043set_pprops([], _, _).
 1044set_pprops([H|T], M, Props) :-
 1045    set_pprops1(Props, M:H),
 1046    strip_module(M:H, M2, P),
 1047    '$pi_head'(M2:P, Pred),
 1048    '$set_table_wrappers'(Pred),
 1049    set_pprops(T, M, Props).
 1050
 1051set_pprops1([], _).
 1052set_pprops1([H|T], P) :-
 1053    (   atom(H)
 1054    ->  '$set_predicate_attribute'(P, H, true)
 1055    ;   H =.. [Name,Value]
 1056    ->  '$set_predicate_attribute'(P, Name, Value)
 1057    ),
 1058    set_pprops1(T, P).
 1059
 1060options_properties(Options, Props) :-
 1061    G = opt_prop(_,_,_,_),
 1062    findall(G, G, Spec),
 1063    options_properties(Spec, Options, Props).
 1064
 1065options_properties([], _, []).
 1066options_properties([opt_prop(Name, Type, SetValue, Prop)|T],
 1067                   Options, [Prop|PT]) :-
 1068    Opt =.. [Name,V],
 1069    '$option'(Opt, Options),
 1070    '$must_be'(Type, V),
 1071    V = SetValue,
 1072    !,
 1073    options_properties(T, Options, PT).
 1074options_properties([_|T], Options, PT) :-
 1075    options_properties(T, Options, PT).
 1076
 1077opt_prop(incremental,   boolean,               Bool,  incremental(Bool)).
 1078opt_prop(abstract,      between(0,0),          0,     abstract).
 1079opt_prop(multifile,     boolean,               true,  multifile).
 1080opt_prop(discontiguous, boolean,               true,  discontiguous).
 1081opt_prop(volatile,      boolean,               true,  volatile).
 1082opt_prop(thread,        oneof(atom, [local,shared],[local,shared]),
 1083                                               local, thread_local).
 1084
 1085                /********************************
 1086                *            MODULES            *
 1087                *********************************/
 1088
 1089%!  current_module(?Module) is nondet.
 1090%
 1091%   True if Module is a currently defined module.
 1092
 1093current_module(Module) :-
 1094    '$current_module'(Module, _).
 1095
 1096%!  module_property(?Module, ?Property) is nondet.
 1097%
 1098%   True if Property is a property of Module.  Defined properties
 1099%   are:
 1100%
 1101%       * file(File)
 1102%       Module is loaded from File.
 1103%       * line_count(Count)
 1104%       The module declaration is on line Count of File.
 1105%       * exports(ListOfPredicateIndicators)
 1106%       The module exports ListOfPredicateIndicators
 1107%       * exported_operators(ListOfOp3)
 1108%       The module exports the operators ListOfOp3.
 1109
 1110module_property(Module, Property) :-
 1111    nonvar(Module), nonvar(Property),
 1112    !,
 1113    property_module(Property, Module).
 1114module_property(Module, Property) :-    % -, file(File)
 1115    nonvar(Property), Property = file(File),
 1116    !,
 1117    (   nonvar(File)
 1118    ->  '$current_module'(Modules, File),
 1119        (   atom(Modules)
 1120        ->  Module = Modules
 1121        ;   '$member'(Module, Modules)
 1122        )
 1123    ;   '$current_module'(Module, File),
 1124        File \== []
 1125    ).
 1126module_property(Module, Property) :-
 1127    current_module(Module),
 1128    property_module(Property, Module).
 1129
 1130property_module(Property, Module) :-
 1131    module_property(Property),
 1132    (   Property = exported_operators(List)
 1133    ->  '$exported_ops'(Module, List, [])
 1134    ;   '$module_property'(Module, Property)
 1135    ).
 1136
 1137module_property(class(_)).
 1138module_property(file(_)).
 1139module_property(line_count(_)).
 1140module_property(exports(_)).
 1141module_property(exported_operators(_)).
 1142module_property(size(_)).
 1143module_property(program_size(_)).
 1144module_property(program_space(_)).
 1145module_property(last_modified_generation(_)).
 1146
 1147%!  module(+Module) is det.
 1148%
 1149%   Set the module that is associated to the toplevel to Module.
 1150
 1151module(Module) :-
 1152    atom(Module),
 1153    current_module(Module),
 1154    !,
 1155    '$set_typein_module'(Module).
 1156module(Module) :-
 1157    '$set_typein_module'(Module),
 1158    print_message(warning, no_current_module(Module)).
 1159
 1160%!  working_directory(-Old, +New)
 1161%
 1162%   True when Old is the current working directory and the working
 1163%   directory has been updated to New.
 1164
 1165working_directory(Old, New) :-
 1166    '$cwd'(Old),
 1167    (   Old == New
 1168    ->  true
 1169    ;   '$chdir'(New)
 1170    ).
 1171
 1172
 1173                 /*******************************
 1174                 *            TRIES             *
 1175                 *******************************/
 1176
 1177%!  current_trie(?Trie) is nondet.
 1178%
 1179%   True if Trie is the handle of an existing trie.
 1180
 1181current_trie(Trie) :-
 1182    current_blob(Trie, trie),
 1183    is_trie(Trie).
 1184
 1185%!  trie_property(?Trie, ?Property)
 1186%
 1187%   True when Property is a property of Trie. Defined properties
 1188%   are:
 1189%
 1190%     - value_count(Count)
 1191%       Number of terms in the trie.
 1192%     - node_count(Count)
 1193%       Number of nodes in the trie.
 1194%     - size(Bytes)
 1195%       Number of bytes needed to store the trie.
 1196%     - hashed(Count)
 1197%       Number of hashed nodes.
 1198%     - compiled_size(Bytes)
 1199%       Size of the compiled representation (if the trie is compiled)
 1200%     - lookup_count(Count)
 1201%       Number of data lookups on the trie
 1202%     - gen_call_count(Count)
 1203%       Number of trie_gen/2 calls on this trie
 1204%
 1205%   Incremental tabling statistics:
 1206%
 1207%     - invalidated(Count)
 1208%       Number of times the trie was inivalidated
 1209%     - reevaluated(Count)
 1210%       Number of times the trie was re-evaluated
 1211%
 1212%   Shared tabling statistics:
 1213%
 1214%     - deadlock(Count)
 1215%       Number of times the table was involved in a deadlock
 1216%     - wait(Count)
 1217%       Number of times a thread had to wait for this table
 1218
 1219trie_property(Trie, Property) :-
 1220    current_trie(Trie),
 1221    trie_property(Property),
 1222    '$trie_property'(Trie, Property).
 1223
 1224trie_property(node_count(_)).
 1225trie_property(value_count(_)).
 1226trie_property(size(_)).
 1227trie_property(hashed(_)).
 1228trie_property(compiled_size(_)).
 1229                                                % below only when -DO_TRIE_STATS
 1230trie_property(lookup_count(_)).                 % is enabled in pl-trie.h
 1231trie_property(gen_call_count(_)).
 1232trie_property(invalidated(_)).                  % IDG stats
 1233trie_property(reevaluated(_)).
 1234trie_property(deadlock(_)).                     % Shared tabling stats
 1235trie_property(wait(_)).
 1236trie_property(idg_affected_count(_)).
 1237trie_property(idg_dependent_count(_)).
 1238trie_property(idg_size(_)).
 1239
 1240
 1241                /********************************
 1242                *      SYSTEM INTERACTION       *
 1243                *********************************/
 1244
 1245shell(Command) :-
 1246    shell(Command, 0).
 1247
 1248
 1249                 /*******************************
 1250                 *            SIGNALS           *
 1251                 *******************************/
 1252
 1253:- meta_predicate
 1254    on_signal(+, :, :),
 1255    current_signal(?, ?, :). 1256
 1257%!  on_signal(+Signal, -OldHandler, :NewHandler) is det.
 1258
 1259on_signal(Signal, Old, New) :-
 1260    atom(Signal),
 1261    !,
 1262    '$on_signal'(_Num, Signal, Old, New).
 1263on_signal(Signal, Old, New) :-
 1264    integer(Signal),
 1265    !,
 1266    '$on_signal'(Signal, _Name, Old, New).
 1267on_signal(Signal, _Old, _New) :-
 1268    '$type_error'(signal_name, Signal).
 1269
 1270%!  current_signal(?Name, ?SignalNumber, :Handler) is nondet.
 1271
 1272current_signal(Name, Id, Handler) :-
 1273    between(1, 32, Id),
 1274    '$on_signal'(Id, Name, Handler, Handler).
 1275
 1276:- multifile
 1277    prolog:called_by/2. 1278
 1279prolog:called_by(on_signal(_,_,New), [New+1]) :-
 1280    (   new == throw
 1281    ;   new == default
 1282    ), !, fail.
 1283
 1284
 1285                 /*******************************
 1286                 *            DLOPEN            *
 1287                 *******************************/
 1288
 1289%!  open_shared_object(+File, -Handle) is det.
 1290%!  open_shared_object(+File, -Handle, +Flags) is det.
 1291%
 1292%   Open a shared object or DLL file. Flags  is a list of flags. The
 1293%   following flags are recognised. Note   however  that these flags
 1294%   may have no affect on the target platform.
 1295%
 1296%       * =now=
 1297%       Resolve all symbols in the file now instead of lazily.
 1298%       * =global=
 1299%       Make new symbols globally known.
 1300
 1301open_shared_object(File, Handle) :-
 1302    open_shared_object(File, Handle, []). % use pl-load.c defaults
 1303
 1304open_shared_object(File, Handle, Flags) :-
 1305    (   is_list(Flags)
 1306    ->  true
 1307    ;   throw(error(type_error(list, Flags), _))
 1308    ),
 1309    map_dlflags(Flags, Mask),
 1310    '$open_shared_object'(File, Handle, Mask).
 1311
 1312dlopen_flag(now,        2'01).          % see pl-load.c for these constants
 1313dlopen_flag(global,     2'10).          % Solaris only
 1314
 1315map_dlflags([], 0).
 1316map_dlflags([F|T], M) :-
 1317    map_dlflags(T, M0),
 1318    (   dlopen_flag(F, I)
 1319    ->  true
 1320    ;   throw(error(domain_error(dlopen_flag, F), _))
 1321    ),
 1322    M is M0 \/ I.
 1323
 1324
 1325                 /*******************************
 1326                 *             I/O              *
 1327                 *******************************/
 1328
 1329format(Fmt) :-
 1330    format(Fmt, []).
 1331
 1332                 /*******************************
 1333                 *            FILES             *
 1334                 *******************************/
 1335
 1336%!  absolute_file_name(+Term, -AbsoluteFile)
 1337
 1338absolute_file_name(Name, Abs) :-
 1339    atomic(Name),
 1340    !,
 1341    '$absolute_file_name'(Name, Abs).
 1342absolute_file_name(Term, Abs) :-
 1343    '$chk_file'(Term, [''], [access(read)], true, File),
 1344    !,
 1345    '$absolute_file_name'(File, Abs).
 1346absolute_file_name(Term, Abs) :-
 1347    '$chk_file'(Term, [''], [], true, File),
 1348    !,
 1349    '$absolute_file_name'(File, Abs).
 1350
 1351%!  tmp_file_stream(-File, -Stream, +Options) is det.
 1352%!  tmp_file_stream(+Encoding, -File, -Stream) is det.
 1353%
 1354%   Create a temporary file and open it   atomically. The second mode is
 1355%   for compatibility reasons.
 1356
 1357tmp_file_stream(Enc, File, Stream) :-
 1358    atom(Enc), var(File), var(Stream),
 1359    !,
 1360    '$tmp_file_stream'('', Enc, File, Stream).
 1361tmp_file_stream(File, Stream, Options) :-
 1362    current_prolog_flag(encoding, DefEnc),
 1363    '$option'(encoding(Enc), Options, DefEnc),
 1364    '$option'(extension(Ext), Options, ''),
 1365    '$tmp_file_stream'(Ext, Enc, File, Stream),
 1366    set_stream(Stream, file_name(File)).
 1367
 1368
 1369                /********************************
 1370                *        MEMORY MANAGEMENT      *
 1371                *********************************/
 1372
 1373%!  garbage_collect is det.
 1374%
 1375%   Invoke the garbage collector.  The   argument  of the underlying
 1376%   '$garbage_collect'/1  is  the  debugging  level  to  use  during
 1377%   garbage collection. This only works if   the  system is compiled
 1378%   with the -DODEBUG cpp flag. Only to simplify maintenance.
 1379
 1380garbage_collect :-
 1381    '$garbage_collect'(0).
 1382
 1383%!  set_prolog_stack(+Name, +Option) is det.
 1384%
 1385%   Set a parameter for one of the Prolog stacks.
 1386
 1387set_prolog_stack(Stack, Option) :-
 1388    Option =.. [Name,Value0],
 1389    Value is Value0,
 1390    '$set_prolog_stack'(Stack, Name, _Old, Value).
 1391
 1392%!  prolog_stack_property(?Stack, ?Property) is nondet.
 1393%
 1394%   Examine stack properties.
 1395
 1396prolog_stack_property(Stack, Property) :-
 1397    stack_property(P),
 1398    stack_name(Stack),
 1399    Property =.. [P,Value],
 1400    '$set_prolog_stack'(Stack, P, Value, Value).
 1401
 1402stack_name(local).
 1403stack_name(global).
 1404stack_name(trail).
 1405
 1406stack_property(limit).
 1407stack_property(spare).
 1408stack_property(min_free).
 1409stack_property(low).
 1410stack_property(factor).
 1411
 1412
 1413                 /*******************************
 1414                 *             TERM             *
 1415                 *******************************/
 1416
 1417:- '$iso'((numbervars/3)). 1418
 1419%!  numbervars(+Term, +StartIndex, -EndIndex) is det.
 1420%
 1421%   Number all unbound variables in Term   using  '$VAR'(N), where the
 1422%   first N is StartIndex and EndIndex is  unified to the index that
 1423%   will be given to the next variable.
 1424
 1425numbervars(Term, From, To) :-
 1426    numbervars(Term, From, To, []).
 1427
 1428
 1429                 /*******************************
 1430                 *            STRING            *
 1431                 *******************************/
 1432
 1433%!  term_string(?Term, ?String, +Options)
 1434%
 1435%   Parse/write a term from/to a string using Options.
 1436
 1437term_string(Term, String, Options) :-
 1438    nonvar(String),
 1439    !,
 1440    read_term_from_atom(String, Term, Options).
 1441term_string(Term, String, Options) :-
 1442    (   '$option'(quoted(_), Options)
 1443    ->  Options1 = Options
 1444    ;   '$merge_options'(_{quoted:true}, Options, Options1)
 1445    ),
 1446    format(string(String), '~W', [Term, Options1]).
 1447
 1448
 1449                 /*******************************
 1450                 *             GVAR             *
 1451                 *******************************/
 1452
 1453%!  nb_setval(+Name, +Value) is det.
 1454%
 1455%   Bind the non-backtrackable variable Name with a copy of Value
 1456
 1457nb_setval(Name, Value) :-
 1458    duplicate_term(Value, Copy),
 1459    nb_linkval(Name, Copy).
 1460
 1461
 1462		 /*******************************
 1463		 *            THREADS		*
 1464		 *******************************/
 1465
 1466:- meta_predicate
 1467    thread_create(0, -). 1468
 1469%!  thread_create(:Goal, -Id)
 1470%
 1471%   Shorthand for thread_create(Goal, Id, []).
 1472
 1473thread_create(Goal, Id) :-
 1474    thread_create(Goal, Id, []).
 1475
 1476%!  thread_join(+Id)
 1477%
 1478%   Join a thread and raise an error of the thread did not succeed.
 1479%
 1480%   @error  thread_error(Status),  where  Status  is    the   result  of
 1481%   thread_join/2.
 1482
 1483thread_join(Id) :-
 1484    thread_join(Id, Status),
 1485    (   Status == true
 1486    ->  true
 1487    ;   throw(error(thread_error(Id, Status), _))
 1488    ).
 1489
 1490%!  set_prolog_gc_thread(+Status)
 1491%
 1492%   Control the GC thread.  Status is one of
 1493%
 1494%     - false
 1495%     Disable the separate GC thread, running atom and clause
 1496%     garbage collection in the triggering thread.
 1497%     - true
 1498%     Enable the separate GC thread.  All implicit atom and clause
 1499%     garbage collection is executed by the thread `gc`.
 1500%     - stop
 1501%     Stop the `gc` thread if it is running.  The thread is recreated
 1502%     on the next implicit atom or clause garbage collection.  Used
 1503%     by fork/1 to avoid forking a multi-threaded application.
 1504
 1505set_prolog_gc_thread(Status) :-
 1506    var(Status),
 1507    !,
 1508    '$instantiation_error'(Status).
 1509set_prolog_gc_thread(false) :-
 1510    !,
 1511    set_prolog_flag(gc_thread, false),
 1512    (   current_prolog_flag(threads, true)
 1513    ->  (   '$gc_stop'
 1514        ->  thread_join(gc)
 1515        ;   true
 1516        )
 1517    ;   true
 1518    ).
 1519set_prolog_gc_thread(true) :-
 1520    !,
 1521    set_prolog_flag(gc_thread, true).
 1522set_prolog_gc_thread(stop) :-
 1523    !,
 1524    (   current_prolog_flag(threads, true)
 1525    ->  (   '$gc_stop'
 1526        ->  thread_join(gc)
 1527        ;   true
 1528        )
 1529    ;   true
 1530    ).
 1531set_prolog_gc_thread(Status) :-
 1532    '$domain_error'(gc_thread, Status).
 1533
 1534%!  transaction(:Goal).
 1535%!  transaction(:Goal, +Options).
 1536%!  transaction(:Goal, :Constraint, +Mutex).
 1537%!  snapshot(:Goal).
 1538%
 1539%   Wrappers to guarantee clean Module:Goal terms.
 1540
 1541transaction(Goal) :-
 1542    '$transaction'(Goal, []).
 1543transaction(Goal, Options) :-
 1544    '$transaction'(Goal, Options).
 1545transaction(Goal, Constraint, Mutex) :-
 1546    '$transaction'(Goal, Constraint, Mutex).
 1547snapshot(Goal) :-
 1548    '$snapshot'(Goal).
 1549
 1550
 1551%!  '$wrap_predicate'(:Head, +Name, -Closure, -Wrapped, +Body) is det.
 1552%
 1553%   Would be nicer to have this   from library(prolog_wrap), but we need
 1554%   it for tabling, so it must be a system predicate.
 1555
 1556:- meta_predicate
 1557    '$wrap_predicate'(:, +, -, -, +). 1558
 1559'$wrap_predicate'(M:Head, WName, Closure, call(Wrapped), Body) :-
 1560    callable_name_arguments(Head, PName, Args),
 1561    callable_name_arity(Head, PName, Arity),
 1562    (   is_most_general_term(Head)
 1563    ->  true
 1564    ;   '$domain_error'(most_general_term, Head)
 1565    ),
 1566    atomic_list_concat(['$wrap$', PName], WrapName),
 1567    volatile(M:WrapName/Arity),
 1568    module_transparent(M:WrapName/Arity),
 1569    WHead =.. [WrapName|Args],
 1570    '$c_wrap_predicate'(M:Head, WName, Closure, Wrapped, M:(WHead :- Body)).
 1571
 1572callable_name_arguments(Head, PName, Args) :-
 1573    atom(Head),
 1574    !,
 1575    PName = Head,
 1576    Args = [].
 1577callable_name_arguments(Head, PName, Args) :-
 1578    compound_name_arguments(Head, PName, Args).
 1579
 1580callable_name_arity(Head, PName, Arity) :-
 1581    atom(Head),
 1582    !,
 1583    PName = Head,
 1584    Arity = 0.
 1585callable_name_arity(Head, PName, Arity) :-
 1586    compound_name_arity(Head, PName, Arity)