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)  2019-2025, VU University Amsterdam
    7                              CWI, Amsterdam
    8                              SWI-Prolog Solutions b.v.
    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(machine,
   38          [ gc_heap/0,
   39            trimcore/0,
   40
   41            abolish_table_info/0,
   42            close_open_tables/1,          % ?
   43
   44            get_attr/3,
   45            put_attr/3,
   46            del_attr/2,
   47            attv_unify/2,                       % AttVar, Value
   48            install_verify_attribute_handler/4, % +Mod, -AttrValue,
   49                                                % -Target, :Handler)
   50            install_attribute_portray_hook/3,   % +Mod, -AttrValue, :Handler
   51
   52            str_cat/3,
   53
   54            parsort/4,                    % +List, +Spec, +Dupl, -Sorted
   55
   56            term_type/2,
   57
   58            xsb_expand_file_name/2,       % +File, -Expanded
   59            expand_filename_no_prepend/2, % FileName, -ExpandedName
   60            parse_filename/4,             % +FileName, -Dir, -Base, -Extension
   61
   62            conset/2,                     % +Term, +Value
   63            conget/2,                     % +Term, -Value
   64
   65            slash/1,                      % -OSDirSlash
   66
   67            xsb_backtrace/1,              % -Backtrace
   68            xwam_state/2                  % +Id, -Value
   69            ]).   70:- use_module(library(debug)).   71:- use_module(library(error)).   72:- use_module(library(prolog_stack)).   73
   74:- meta_predicate
   75    install_verify_attribute_handler(+, -, -, 0).   76:- multifile
   77    system:term_expansion/2.

 gc_heap

Explicitly invoke heap garbage collection.

   83gc_heap :-
   84    garbage_collect.

 trimcore

Trim the stacks.

   90trimcore :-
   91    trim_stacks.

 abolish_table_info

Undocumented in the XSB manual.

   97abolish_table_info.

 close_open_tables(?Arg)

Undocumented in the XSB manual. Tables are always closed on exceptions, so it is unclear what this should do?

  104close_open_tables(_).
  105
  106                /*******************************
  107                *     ATTRIBUTED VARIABLES     *
  108                *******************************/

 attv_unify(?AttVar, ?Value) is semidet

Unify AttVar with Value without causing a wakeup. If AttVar is not an attributed variable, this is a normal unification.

  115attv_unify(AttVar, Value) :-
  116    '$attv_unify'(AttVar, Value).

 install_verify_attribute_handler(+Mod, -AttrValue, -Target, :Handler) is det

 install_attribute_portray_hook(+Mod, -AttrValue, :Handler) is det

Install attributed variable hooks for Mod.

  124install_verify_attribute_handler(Mod, AttrValue, Target, Handler) :-
  125    retractall(Mod:attr_unify_hook(_,_)),
  126    asserta(Mod:(attr_unify_hook(AttrValue, Target) :- Handler)).
  127install_attribute_portray_hook(Mod, AttrValue, Handler) :-
  128    retractall(Mod:attr_portray_hook(_,_)),
  129    asserta(Mod:(attr_portray_hook(AttrValue, _Var) :- Handler)).
  130
  131system:term_expansion((:-install_verify_attribute_handler(Mod, AttrValue, Target, Handler)),
  132                      (Mod:attr_unify_hook(AttrValue, Target) :- Handler)).
  133system:term_expansion((:-install_attribute_portray_hook(Mod, AttrValue, Handler)),
  134                      (Mod:attr_portray_hook(AttrValue, _Var) :- Handler)).
  135
  136                /*******************************
  137                *             MISC             *
  138                *******************************/

 str_cat(+Atom1, +Atom2, -Atom3)

  142str_cat(A, B, AB) :-
  143    must_be(atom, A),
  144    must_be(atom, B),
  145    atom_concat(A, B, AB).

 parsort(+List, +Order, +Dupl, -Sorted) is det

parsort/4 is a very general sorting routine.

  151parsort(_List, Spec, _Dupl, _Sorted) :-
  152    var(Spec),
  153    !,
  154    uninstantiation_error(Spec).
  155parsort(_List, _Spec, Dupl, _Sorted) :-
  156    var(Dupl),
  157    !,
  158    uninstantiation_error(Dupl).
  159parsort(List, asc,  0, Sorted) :- !, sort(0, @=<, List, Sorted).
  160parsort(List, asc,  _, Sorted) :- !, sort(0, @<,  List, Sorted).
  161parsort(List, [],   0, Sorted) :- !, sort(0, @=<, List, Sorted).
  162parsort(List, [],   _, Sorted) :- !, sort(0, @<,  List, Sorted).
  163parsort(List, desc, 0, Sorted) :- !, sort(0, @>=, List, Sorted).
  164parsort(List, desc, _, Sorted) :- !, sort(0, @>,  List, Sorted).
  165parsort(List, SortSpec, Dupl, Sorted) :-
  166    must_be(list, SortSpec),
  167    reverse(SortSpec, Rev),
  168    parsort_(Rev, Dupl, List, Sorted).
  169
  170parsort_([], _, List, List).
  171parsort_([H|T], Dupl, List0, List) :-
  172    parsort_1(H, Dupl, List0, List1),
  173    parsort_(T, Dupl, List1, List).
  174
  175parsort_1(asc(I),  0, List, Sorted) :- !, sort(I, @=<, List, Sorted).
  176parsort_1(asc(I),  _, List, Sorted) :- !, sort(I, @<,  List, Sorted).
  177parsort_1(desc(I), 0, List, Sorted) :- !, sort(I, @>=, List, Sorted).
  178parsort_1(desc(I), _, List, Sorted) :- !, sort(I, @>,  List, Sorted).
  179parsort_1(Spec,  _, _, _) :-
  180    domain_error(parsort_spec, Spec).

 term_type(+Term, -Type:integer)

Emulation of internal XSB predicate

  186term_type(Term, Type) :-
  187    (   atom(Term)
  188    ->  Type = 5
  189    ;   compound(Term)
  190    ->  (   Term = [_|_]
  191        ->  Type = 3
  192        ;   Type = 1
  193        )
  194    ;   integer(Term)
  195    ->  Type = 2
  196    ;   float(Term)
  197    ->  Type = 6
  198    ;   var(Term)
  199    ->  Type = 0
  200    ;   assertion(fail)
  201    ).
  202
  203		 /*******************************
  204		 *              FILES		*
  205		 *******************************/

 xsb_expand_file_name(+File, -Expanded)

  211xsb_expand_file_name(File, Expanded) :-
  212    absolute_file_name(File, Expanded, [expand(true)]).

 expand_filename_no_prepend(+FileName, -ExpandedName)

  218expand_filename_no_prepend(File, Expanded) :-
  219    expand_file_name(File, Absolute),
  220    working_directory(Dir0, Dir0),
  221    ensure_slash(Dir0, Dir),
  222    (   atom_concat(Dir, Ex0, Absolute)
  223    ->  Expanded = Ex0
  224    ;   Expanded = Absolute
  225    ).

 parse_filename(+FileName, -Dir, -Base, -Extension)

  231parse_filename(FileName, Dir, Base, Extension) :-
  232    sub_atom(FileName, 0, _, _, '~'),
  233    !,
  234    expand_file_name(FileName, Absolute),
  235    parse_filename_2(Absolute, Dir, Base, Extension).
  236parse_filename(FileName, Dir, Base, Extension) :-
  237    parse_filename_2(FileName, Dir, Base, Extension).
  238
  239parse_filename_2(FileName, Dir, Base, Extension) :-
  240    file_directory_name(FileName, Dir0),
  241    (   Dir0 == '.'
  242    ->  Dir = ''
  243    ;   ensure_slash(Dir0, Dir)
  244    ),
  245    file_base_name(FileName, File),
  246    file_name_extension(Base, Extension, File).
  247
  248ensure_slash(Dir, DirS) :-
  249    sub_atom(Dir, _, _, 0, '/'),
  250    !,
  251    DirS = Dir.
  252ensure_slash(Dir, DirS) :-
  253    atom_concat(Dir, '/', DirS).

 conset(+Term, +Value) is det

 conget(+Term, -Value) is det

Cheap set/get integer value associated with an atom. Seems this is a subset of what SWI-Prolog flags can do.

  262conset(Name, Value) :-
  263    set_flag(Name, Value).
  264
  265conget(Name, Value) :-
  266    get_flag(Name, Value).

 slash(-Slash)

Return the directory separator for the platform

  272slash(Slash) :-
  273    current_prolog_flag(dir_sep, Slash).

 xsb_backtrace(-Backtrace)

Upon success Backtrace is bound to a structure indicating the forward continuations for a point of execution. This structure should be treated as opaque.

  281xsb_backtrace(Backtrace) :-
  282    get_prolog_backtrace(25, Backtrace).

 xwam_state(+Id, -Value)

Low-level query. Used by the XSB test suite.

  288xwam_state(2, DelayReg) :-
  289    !,
  290    (   '$tbl_delay_list'([_|_])
  291    ->  DelayReg = 1
  292    ;   DelayReg = 0
  293    ).
  294xwam_state(Id, _Value) :-
  295    domain_error(xwam_state, Id)