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)  1995-2021, University of Amsterdam
    7                              VU University Amsterdam
    8                              CWI, Amsterdam
    9                              SWI-Prolog Solutions b.v.
   10    All rights reserved.
   11
   12    Redistribution and use in source and binary forms, with or without
   13    modification, are permitted provided that the following conditions
   14    are met:
   15
   16    1. Redistributions of source code must retain the above copyright
   17       notice, this list of conditions and the following disclaimer.
   18
   19    2. Redistributions in binary form must reproduce the above copyright
   20       notice, this list of conditions and the following disclaimer in
   21       the documentation and/or other materials provided with the
   22       distribution.
   23
   24    THIS SOFTWARE IS PROVIDED BY THE COPYRIGHT HOLDERS AND CONTRIBUTORS
   25    "AS IS" AND ANY EXPRESS OR IMPLIED WARRANTIES, INCLUDING, BUT NOT
   26    LIMITED TO, THE IMPLIED WARRANTIES OF MERCHANTABILITY AND FITNESS
   27    FOR A PARTICULAR PURPOSE ARE DISCLAIMED. IN NO EVENT SHALL THE
   28    COPYRIGHT OWNER OR CONTRIBUTORS BE LIABLE FOR ANY DIRECT, INDIRECT,
   29    INCIDENTAL, SPECIAL, EXEMPLARY, OR CONSEQUENTIAL DAMAGES (INCLUDING,
   30    BUT NOT LIMITED TO, PROCUREMENT OF SUBSTITUTE GOODS OR SERVICES;
   31    LOSS OF USE, DATA, OR PROFITS; OR BUSINESS INTERRUPTION) HOWEVER
   32    CAUSED AND ON ANY THEORY OF LIABILITY, WHETHER IN CONTRACT, STRICT
   33    LIABILITY, OR TORT (INCLUDING NEGLIGENCE OR OTHERWISE) ARISING IN
   34    ANY WAY OUT OF THE USE OF THIS SOFTWARE, EVEN IF ADVISED OF THE
   35    POSSIBILITY OF SUCH DAMAGE.
   36*/
   37
   38:- module(qsave,
   39          [ qsave_program/1,                    % +File
   40            qsave_program/2                     % +File, +Options
   41          ]).   42:- use_module(library(zip)).   43:- use_module(library(lists)).   44:- use_module(library(option)).   45:- use_module(library(error)).   46:- use_module(library(apply)).   47:- autoload(library(shlib), [current_foreign_library/2]).   48:- autoload(library(prolog_autoload), [autoload_all/1]).   49
   50/** <module> Save current program as a state or executable
   51
   52This library provides qsave_program/1  and   qsave_program/2,  which are
   53also used by the commandline sequence below.
   54
   55  ==
   56  swipl -o exe -c file.pl ...
   57  ==
   58*/
   59
   60:- meta_predicate
   61    qsave_program(+, :).   62
   63:- multifile error:has_type/2.   64error:has_type(qsave_foreign_option, Term) :-
   65    is_of_type(oneof([save, no_save]), Term),
   66    !.
   67error:has_type(qsave_foreign_option, arch(Archs)) :-
   68    is_of_type(list(atom), Archs),
   69    !.
   70
   71save_option(stack_limit, integer,
   72            "Stack limit (bytes)").
   73save_option(goal,        callable,
   74            "Main initialization goal").
   75save_option(toplevel,    callable,
   76            "Toplevel goal").
   77save_option(init_file,   atom,
   78            "Application init file").
   79save_option(pce,         boolean,
   80            "Do (not) include the xpce graphics subsystem").
   81save_option(packs,       boolean,
   82            "Do (not) attach packs").
   83save_option(class,       oneof([runtime,development,prolog]),
   84            "Development state").
   85save_option(op,          oneof([save,standard]),
   86            "Save operators").
   87save_option(autoload,    boolean,
   88            "Resolve autoloadable predicates").
   89save_option(map,         atom,
   90            "File to report content of the state").
   91save_option(stand_alone, boolean,
   92            "Add emulator at start").
   93save_option(traditional, boolean,
   94            "Use traditional mode").
   95save_option(emulator,    ground,
   96            "Emulator to use").
   97save_option(foreign,     qsave_foreign_option,
   98            "Include foreign code in state").
   99save_option(obfuscate,   boolean,
  100            "Obfuscate identifiers").
  101save_option(verbose,     boolean,
  102            "Be more verbose about the state creation").
  103save_option(undefined,   oneof([ignore,error]),
  104            "How to handle undefined predicates").
  105save_option(on_error,    oneof([print,halt,status]),
  106            "How to handle errors").
  107save_option(on_warning,  oneof([print,halt,status]),
  108            "How to handle warnings").
  109
  110term_expansion(save_pred_options,
  111               (:- predicate_options(qsave_program/2, 2, Options))) :-
  112    findall(O,
  113            ( save_option(Name, Type, _),
  114              O =.. [Name,Type]
  115            ),
  116            Options).
  117
  118save_pred_options.
  119
  120:- set_prolog_flag(generate_debug_info, false).  121
  122:- dynamic
  123    verbose/1,
  124    saved_resource_file/1.  125:- volatile
  126    verbose/1,                  % contains a stream-handle
  127    saved_resource_file/1.  128
  129%!  qsave_program(+File) is det.
  130%!  qsave_program(+File, :Options) is det.
  131%
  132%   Make a saved state in file `File'.
  133
  134qsave_program(File) :-
  135    qsave_program(File, []).
  136
  137qsave_program(FileBase, Options0) :-
  138    meta_options(is_meta, Options0, Options1),
  139    check_options(Options1),
  140    exe_file(FileBase, File, Options1),
  141    option(class(SaveClass), Options1, runtime),
  142    qsave_init_file_option(SaveClass, Options1, Options),
  143    prepare_entry_points(Options),
  144    save_autoload(Options),
  145    setup_call_cleanup(
  146        open_map(Options),
  147        ( prepare_state(Options),
  148          create_prolog_flag(saved_program, true, []),
  149          create_prolog_flag(saved_program_class, SaveClass, []),
  150          delete_if_exists(File),    % truncate will crash a Prolog
  151                                     % running on this state
  152          setup_call_catcher_cleanup(
  153              open(File, write, StateOut, [type(binary)]),
  154              write_state(StateOut, SaveClass, Options),
  155              Reason,
  156              finalize_state(Reason, StateOut, File))
  157        ),
  158        close_map),
  159    cleanup,
  160    !.
  161
  162write_state(StateOut, SaveClass, Options) :-
  163    make_header(StateOut, SaveClass, Options),
  164    setup_call_cleanup(
  165        zip_open_stream(StateOut, RC, []),
  166        write_zip_state(RC, SaveClass, Options),
  167        zip_close(RC, [comment('SWI-Prolog saved state')])),
  168    flush_output(StateOut).
  169
  170write_zip_state(RC, SaveClass, Options) :-
  171    save_options(RC, SaveClass, Options),
  172    save_resources(RC, SaveClass),
  173    lock_files(SaveClass),
  174    save_program(RC, SaveClass, Options),
  175    save_foreign_libraries(RC, Options).
  176
  177finalize_state(exit, StateOut, File) :-
  178    close(StateOut),
  179    '$mark_executable'(File).
  180finalize_state(!, StateOut, File) :-
  181    print_message(warning, qsave(nondet)),
  182    finalize_state(exit, StateOut, File).
  183finalize_state(_, StateOut, File) :-
  184    close(StateOut, [force(true)]),
  185    catch(delete_file(File),
  186          Error,
  187          print_message(error, Error)).
  188
  189cleanup :-
  190    retractall(saved_resource_file(_)).
  191
  192is_meta(goal).
  193is_meta(toplevel).
  194
  195exe_file(Base, Exe, Options) :-
  196    current_prolog_flag(windows, true),
  197    option(stand_alone(true), Options, true),
  198    file_name_extension(_, '', Base),
  199    !,
  200    file_name_extension(Base, exe, Exe).
  201exe_file(Exe, Exe, _).
  202
  203delete_if_exists(File) :-
  204    (   exists_file(File)
  205    ->  delete_file(File)
  206    ;   true
  207    ).
  208
  209qsave_init_file_option(runtime, Options1, Options) :-
  210    \+ option(init_file(_), Options1),
  211    !,
  212    Options = [init_file(none)|Options1].
  213qsave_init_file_option(_, Options, Options).
  214
  215
  216                 /*******************************
  217                 *           HEADER             *
  218                 *******************************/
  219
  220%!  make_header(+Out:stream, +SaveClass, +Options) is det.
  221
  222make_header(Out, _, Options) :-
  223    option(emulator(OptVal), Options),
  224    !,
  225    absolute_file_name(OptVal, [access(read)], Emulator),
  226    setup_call_cleanup(
  227        open(Emulator, read, In, [type(binary)]),
  228        copy_stream_data(In, Out),
  229        close(In)).
  230make_header(Out, _, Options) :-
  231    (   current_prolog_flag(windows, true)
  232    ->  DefStandAlone = true
  233    ;   DefStandAlone = false
  234    ),
  235    option(stand_alone(true), Options, DefStandAlone),
  236    !,
  237    current_prolog_flag(executable, Executable),
  238    setup_call_cleanup(
  239        open(Executable, read, In, [type(binary)]),
  240        copy_stream_data(In, Out),
  241        close(In)).
  242make_header(Out, SaveClass, _Options) :-
  243    current_prolog_flag(unix, true),
  244    !,
  245    current_prolog_flag(executable, Executable),
  246    current_prolog_flag(posix_shell, Shell),
  247    format(Out, '#!~w~n', [Shell]),
  248    format(Out, '# SWI-Prolog saved state~n', []),
  249    (   SaveClass == runtime
  250    ->  ArgSep = ' -- '
  251    ;   ArgSep = ' '
  252    ),
  253    format(Out, 'exec ${SWIPL-~w} -x "$0"~w"$@"~n~n', [Executable, ArgSep]).
  254make_header(_, _, _).
  255
  256
  257                 /*******************************
  258                 *           OPTIONS            *
  259                 *******************************/
  260
  261min_stack(stack_limit, 100_000).
  262
  263convert_option(Stack, Val, NewVal, '~w') :-     % stack-sizes are in K-bytes
  264    min_stack(Stack, Min),
  265    !,
  266    (   Val == 0
  267    ->  NewVal = Val
  268    ;   NewVal is max(Min, Val)
  269    ).
  270convert_option(toplevel, Callable, Callable, '~q') :- !.
  271convert_option(_, Value, Value, '~w').
  272
  273doption(Name) :- min_stack(Name, _).
  274doption(init_file).
  275doption(system_init_file).
  276doption(class).
  277doption(home).
  278doption(nosignals).
  279
  280%!  save_options(+ArchiveHandle, +SaveClass, +Options)
  281%
  282%   Save the options in the '$options'   resource. The home directory is
  283%   saved for development  states  to  make   it  keep  refering  to the
  284%   development home.
  285%
  286%   The script files (-s script) are not saved   at all. I think this is
  287%   fine to avoid a save-script loading itself.
  288
  289save_options(RC, SaveClass, Options) :-
  290    zipper_open_new_file_in_zip(RC, '$prolog/options.txt', Fd, []),
  291    (   doption(OptionName),
  292            (   OptTerm =.. [OptionName,OptionVal2],
  293                option(OptTerm, Options)
  294            ->  convert_option(OptionName, OptionVal2, OptionVal, FmtVal)
  295            ;   '$cmd_option_val'(OptionName, OptionVal0),
  296                save_option_value(SaveClass, OptionName, OptionVal0, OptionVal1),
  297                OptionVal = OptionVal1,
  298                FmtVal = '~w'
  299            ),
  300            atomics_to_string(['~w=', FmtVal, '~n'], Fmt),
  301            format(Fd, Fmt, [OptionName, OptionVal]),
  302        fail
  303    ;   true
  304    ),
  305    save_init_goals(Fd, Options),
  306    close(Fd).
  307
  308%!  save_option_value(+SaveClass, +OptionName, +OptionValue, -FinalValue)
  309
  310save_option_value(Class,   class, _,     Class) :- !.
  311save_option_value(runtime, home,  _,     _) :- !, fail.
  312save_option_value(_,       _,     Value, Value).
  313
  314%!  save_init_goals(+Stream, +Options)
  315%
  316%   Save initialization goals. If there  is   a  goal(Goal)  option, use
  317%   that, else save the goals from '$cmd_option_val'/2.
  318
  319save_init_goals(Out, Options) :-
  320    option(goal(Goal), Options),
  321    !,
  322    format(Out, 'goal=~q~n', [Goal]),
  323    save_toplevel_goal(Out, halt, Options).
  324save_init_goals(Out, Options) :-
  325    '$cmd_option_val'(goals, Goals),
  326    forall(member(Goal, Goals),
  327           format(Out, 'goal=~w~n', [Goal])),
  328    (   Goals == []
  329    ->  DefToplevel = default
  330    ;   DefToplevel = halt
  331    ),
  332    save_toplevel_goal(Out, DefToplevel, Options).
  333
  334save_toplevel_goal(Out, _Default, Options) :-
  335    option(toplevel(Goal), Options),
  336    !,
  337    unqualify_reserved_goal(Goal, Goal1),
  338    format(Out, 'toplevel=~q~n', [Goal1]).
  339save_toplevel_goal(Out, _Default, _Options) :-
  340    '$cmd_option_val'(toplevel, Toplevel),
  341    Toplevel \== default,
  342    !,
  343    format(Out, 'toplevel=~w~n', [Toplevel]).
  344save_toplevel_goal(Out, Default, _Options) :-
  345    format(Out, 'toplevel=~q~n', [Default]).
  346
  347unqualify_reserved_goal(_:prolog, prolog) :- !.
  348unqualify_reserved_goal(_:default, default) :- !.
  349unqualify_reserved_goal(Goal, Goal).
  350
  351
  352                 /*******************************
  353                 *           RESOURCES          *
  354                 *******************************/
  355
  356save_resources(_RC, development) :- !.
  357save_resources(RC, _SaveClass) :-
  358    feedback('~nRESOURCES~n~n', []),
  359    copy_resources(RC),
  360    forall(declared_resource(Name, FileSpec, Options),
  361           save_resource(RC, Name, FileSpec, Options)).
  362
  363declared_resource(RcName, FileSpec, []) :-
  364    current_predicate(_, M:resource(_,_)),
  365    M:resource(Name, FileSpec),
  366    mkrcname(M, Name, RcName).
  367declared_resource(RcName, FileSpec, Options) :-
  368    current_predicate(_, M:resource(_,_,_)),
  369    M:resource(Name, A2, A3),
  370    (   is_list(A3)
  371    ->  FileSpec = A2,
  372        Options = A3
  373    ;   FileSpec = A3
  374    ),
  375    mkrcname(M, Name, RcName).
  376
  377%!  mkrcname(+Module, +NameSpec, -Name)
  378%
  379%   Turn a resource name term into a resource name atom.
  380
  381mkrcname(user, Name0, Name) :-
  382    !,
  383    path_segments_to_atom(Name0, Name).
  384mkrcname(M, Name0, RcName) :-
  385    path_segments_to_atom(Name0, Name),
  386    atomic_list_concat([M, :, Name], RcName).
  387
  388path_segments_to_atom(Name0, Name) :-
  389    phrase(segments_to_atom(Name0), Atoms),
  390    atomic_list_concat(Atoms, /, Name).
  391
  392segments_to_atom(Var) -->
  393    { var(Var), !,
  394      instantiation_error(Var)
  395    }.
  396segments_to_atom(A/B) -->
  397    !,
  398    segments_to_atom(A),
  399    segments_to_atom(B).
  400segments_to_atom(A) -->
  401    [A].
  402
  403%!  save_resource(+Zipper, +Name, +FileSpec, +Options) is det.
  404%
  405%   Add the content represented by FileSpec to Zipper under Name.
  406
  407save_resource(RC, Name, FileSpec, _Options) :-
  408    absolute_file_name(FileSpec,
  409                       [ access(read),
  410                         file_errors(fail)
  411                       ], File),
  412    !,
  413    feedback('~t~8|~w~t~32|~w~n',
  414             [Name, File]),
  415    zipper_append_file(RC, Name, File, []).
  416save_resource(RC, Name, FileSpec, Options) :-
  417    findall(Dir,
  418            absolute_file_name(FileSpec, Dir,
  419                               [ access(read),
  420                                 file_type(directory),
  421                                 file_errors(fail),
  422                                 solutions(all)
  423                               ]),
  424            Dirs),
  425    Dirs \== [],
  426    !,
  427    forall(member(Dir, Dirs),
  428           ( feedback('~t~8|~w~t~32|~w~n',
  429                      [Name, Dir]),
  430             zipper_append_directory(RC, Name, Dir, Options))).
  431save_resource(RC, Name, _, _Options) :-
  432    '$rc_handle'(SystemRC),
  433    copy_resource(SystemRC, RC, Name),
  434    !.
  435save_resource(_, Name, FileSpec, _Options) :-
  436    print_message(warning,
  437                  error(existence_error(resource,
  438                                        resource(Name, FileSpec)),
  439                        _)).
  440
  441copy_resources(ToRC) :-
  442    '$rc_handle'(FromRC),
  443    zipper_members(FromRC, List),
  444    (   member(Name, List),
  445        \+ declared_resource(Name, _, _),
  446        \+ reserved_resource(Name),
  447        copy_resource(FromRC, ToRC, Name),
  448        fail
  449    ;   true
  450    ).
  451
  452reserved_resource('$prolog/state.qlf').
  453reserved_resource('$prolog/options.txt').
  454
  455copy_resource(FromRC, ToRC, Name) :-
  456    (   zipper_goto(FromRC, file(Name))
  457    ->  true
  458    ;   existence_error(resource, Name)
  459    ),
  460    zipper_file_info(FromRC, _Name, Attrs),
  461    get_dict(time, Attrs, Time),
  462    setup_call_cleanup(
  463        zipper_open_current(FromRC, FdIn,
  464                            [ type(binary),
  465                              time(Time)
  466                            ]),
  467        setup_call_cleanup(
  468            zipper_open_new_file_in_zip(ToRC, Name, FdOut, []),
  469            ( feedback('~t~8|~w~t~24|~w~n',
  470                       [Name, '<Copied from running state>']),
  471              copy_stream_data(FdIn, FdOut)
  472            ),
  473            close(FdOut)),
  474        close(FdIn)).
  475
  476
  477		 /*******************************
  478		 *           OBFUSCATE		*
  479		 *******************************/
  480
  481%!  create_mapping(+Options) is det.
  482%
  483%   Call hook to obfuscate symbols.
  484
  485:- multifile prolog:obfuscate_identifiers/1.  486
  487create_mapping(Options) :-
  488    option(obfuscate(true), Options),
  489    !,
  490    (   predicate_property(prolog:obfuscate_identifiers(_), number_of_clauses(N)),
  491        N > 0
  492    ->  true
  493    ;   use_module(library(obfuscate))
  494    ),
  495    (   catch(prolog:obfuscate_identifiers(Options), E,
  496              print_message(error, E))
  497    ->  true
  498    ;   print_message(warning, failed(obfuscate_identifiers))
  499    ).
  500create_mapping(_).
  501
  502%!  lock_files(+SaveClass) is det.
  503%
  504%   When saving as `runtime`, lock all files  such that when running the
  505%   program the system stops checking existence and modification time on
  506%   the filesystem.
  507%
  508%   @tbd `system` is a poor name.  Maybe use `resource`?
  509
  510lock_files(runtime) :-
  511    !,
  512    '$set_source_files'(system).                % implies from_state
  513lock_files(_) :-
  514    '$set_source_files'(from_state).
  515
  516%!  save_program(+Zipper, +SaveClass, +Options) is det.
  517%
  518%   Save the program itself as virtual machine code to Zipper.
  519
  520save_program(RC, SaveClass, Options) :-
  521    setup_call_cleanup(
  522        ( zipper_open_new_file_in_zip(RC, '$prolog/state.qlf', StateFd,
  523                                      [ zip64(true)
  524                                      ]),
  525          current_prolog_flag(access_level, OldLevel),
  526          set_prolog_flag(access_level, system), % generate system modules
  527          '$open_wic'(StateFd, Options)
  528        ),
  529        ( create_mapping(Options),
  530          save_modules(SaveClass),
  531          save_records,
  532          save_flags,
  533          save_prompt,
  534          save_imports,
  535          save_prolog_flags(Options),
  536          save_operators(Options),
  537          save_format_predicates
  538        ),
  539        ( '$close_wic',
  540          set_prolog_flag(access_level, OldLevel),
  541          close(StateFd)
  542        )).
  543
  544
  545                 /*******************************
  546                 *            MODULES           *
  547                 *******************************/
  548
  549save_modules(SaveClass) :-
  550    forall(special_module(X),
  551           save_module(X, SaveClass)),
  552    forall((current_module(X), \+ special_module(X)),
  553           save_module(X, SaveClass)).
  554
  555special_module(system).
  556special_module(user).
  557
  558
  559%!  prepare_entry_points(+Options)
  560%
  561%   Prepare  the  --goal=Goal  and  --toplevel=Goal  options.  Preparing
  562%   implies autoloading the definition and declaring it _public_ such at
  563%   it doesn't get obfuscated.
  564
  565prepare_entry_points(Options) :-
  566    define_init_goal(Options),
  567    define_toplevel_goal(Options).
  568
  569define_init_goal(Options) :-
  570    option(goal(Goal), Options),
  571    !,
  572    entry_point(Goal).
  573define_init_goal(_).
  574
  575define_toplevel_goal(Options) :-
  576    option(toplevel(Goal), Options),
  577    !,
  578    entry_point(Goal).
  579define_toplevel_goal(_).
  580
  581entry_point(Goal) :-
  582    define_predicate(Goal),
  583    (   \+ predicate_property(Goal, built_in),
  584        \+ predicate_property(Goal, imported_from(_))
  585    ->  goal_pi(Goal, PI),
  586        public(PI)
  587    ;   true
  588    ).
  589
  590define_predicate(Head) :-
  591    '$define_predicate'(Head),
  592    !.   % autoloader
  593define_predicate(Head) :-
  594    strip_module(Head, _, Term),
  595    functor(Term, Name, Arity),
  596    throw(error(existence_error(procedure, Name/Arity), _)).
  597
  598goal_pi(M:G, QPI) :-
  599    !,
  600    strip_module(M:G, Module, Goal),
  601    functor(Goal, Name, Arity),
  602    QPI = Module:Name/Arity.
  603goal_pi(Goal, Name/Arity) :-
  604    functor(Goal, Name, Arity).
  605
  606%!  prepare_state(+Options) is det.
  607%
  608%   Prepare the executable by  running   the  `prepare_state` registered
  609%   initialization hooks.
  610
  611prepare_state(_) :-
  612    forall('$init_goal'(when(prepare_state), Goal, Ctx),
  613           run_initialize(Goal, Ctx)).
  614
  615run_initialize(Goal, Ctx) :-
  616    (   catch(Goal, E, true),
  617        (   var(E)
  618        ->  true
  619        ;   throw(error(initialization_error(E, Goal, Ctx), _))
  620        )
  621    ;   throw(error(initialization_error(failed, Goal, Ctx), _))
  622    ).
  623
  624
  625                 /*******************************
  626                 *            AUTOLOAD          *
  627                 *******************************/
  628
  629%!  save_autoload(+Options) is det.
  630%
  631%   Resolve all autoload dependencies.
  632%
  633%   @error existence_error(procedures, List) if undefined(true) is
  634%   in Options and there are undefined predicates.
  635
  636save_autoload(Options) :-
  637    option(autoload(true),  Options, true),
  638    !,
  639    setup_call_cleanup(
  640        current_prolog_flag(autoload, Old),
  641        autoload_all(Options),
  642        set_prolog_flag(autoload, Old)).
  643save_autoload(_).
  644
  645
  646                 /*******************************
  647                 *             MODULES          *
  648                 *******************************/
  649
  650%!  save_module(+Module, +SaveClass)
  651%
  652%   Saves a module
  653
  654save_module(M, SaveClass) :-
  655    '$qlf_start_module'(M),
  656    feedback('~n~nMODULE ~w~n', [M]),
  657    save_unknown(M),
  658    (   P = (M:_H),
  659        current_predicate(_, P),
  660        \+ predicate_property(P, imported_from(_)),
  661        save_predicate(P, SaveClass),
  662        fail
  663    ;   '$qlf_end_part',
  664        feedback('~n', [])
  665    ).
  666
  667save_predicate(P, _SaveClass) :-
  668    predicate_property(P, foreign),
  669    !,
  670    P = (M:H),
  671    functor(H, Name, Arity),
  672    feedback('~npre-defining foreign ~w/~d ', [Name, Arity]),
  673    '$add_directive_wic'('$predefine_foreign'(M:Name/Arity)).
  674save_predicate(P, SaveClass) :-
  675    P = (M:H),
  676    functor(H, F, A),
  677    feedback('~nsaving ~w/~d ', [F, A]),
  678    (   (   H = resource(_,_)
  679        ;   H = resource(_,_,_)
  680        )
  681    ->  (   SaveClass == development
  682        ->  true
  683        ;   save_attribute(P, (dynamic)),
  684            (   M == user
  685            ->  save_attribute(P, (multifile))
  686            ),
  687            feedback('(Skipped clauses)', []),
  688            fail
  689        )
  690    ;   true
  691    ),
  692    (   no_save(P)
  693    ->  true
  694    ;   save_attributes(P),
  695        \+ predicate_property(P, (volatile)),
  696        (   nth_clause(P, _, Ref),
  697            feedback('.', []),
  698            '$qlf_assert_clause'(Ref, SaveClass),
  699            fail
  700        ;   true
  701        )
  702    ).
  703
  704no_save(P) :-
  705    predicate_property(P, volatile),
  706    \+ predicate_property(P, dynamic),
  707    \+ predicate_property(P, multifile).
  708
  709pred_attrib(meta_predicate(Term), Head, meta_predicate(M:Term)) :-
  710    !,
  711    strip_module(Head, M, _).
  712pred_attrib(Attrib, Head,
  713            '$set_predicate_attribute'(M:Name/Arity, AttName, Val)) :-
  714    attrib_name(Attrib, AttName, Val),
  715    strip_module(Head, M, Term),
  716    functor(Term, Name, Arity).
  717
  718attrib_name(dynamic,                dynamic,                true).
  719attrib_name(volatile,               volatile,               true).
  720attrib_name(thread_local,           thread_local,           true).
  721attrib_name(multifile,              multifile,              true).
  722attrib_name(public,                 public,                 true).
  723attrib_name(transparent,            transparent,            true).
  724attrib_name(discontiguous,          discontiguous,          true).
  725attrib_name(notrace,                trace,                  false).
  726attrib_name(show_childs,            hide_childs,            false).
  727attrib_name(built_in,               system,                 true).
  728attrib_name(nodebug,                hide_childs,            true).
  729attrib_name(quasi_quotation_syntax, quasi_quotation_syntax, true).
  730attrib_name(iso,                    iso,                    true).
  731
  732
  733save_attribute(P, Attribute) :-
  734    pred_attrib(Attribute, P, D),
  735    (   Attribute == built_in       % no need if there are clauses
  736    ->  (   predicate_property(P, number_of_clauses(0))
  737        ->  true
  738        ;   predicate_property(P, volatile)
  739        )
  740    ;   Attribute == (dynamic)      % no need if predicate is thread_local
  741    ->  \+ predicate_property(P, thread_local)
  742    ;   true
  743    ),
  744    '$add_directive_wic'(D),
  745    feedback('(~w) ', [Attribute]).
  746
  747save_attributes(P) :-
  748    (   predicate_property(P, Attribute),
  749        save_attribute(P, Attribute),
  750        fail
  751    ;   true
  752    ).
  753
  754%       Save status of the unknown flag
  755
  756save_unknown(M) :-
  757    current_prolog_flag(M:unknown, Unknown),
  758    (   Unknown == error
  759    ->  true
  760    ;   '$add_directive_wic'(set_prolog_flag(M:unknown, Unknown))
  761    ).
  762
  763                 /*******************************
  764                 *            RECORDS           *
  765                 *******************************/
  766
  767save_records :-
  768    feedback('~nRECORDS~n', []),
  769    (   current_key(X),
  770        X \== '$topvar',                        % do not safe toplevel variables
  771        feedback('~n~t~8|~w ', [X]),
  772        recorded(X, V, _),
  773        feedback('.', []),
  774        '$add_directive_wic'(recordz(X, V, _)),
  775        fail
  776    ;   true
  777    ).
  778
  779
  780                 /*******************************
  781                 *            FLAGS             *
  782                 *******************************/
  783
  784save_flags :-
  785    feedback('~nFLAGS~n~n', []),
  786    (   current_flag(X),
  787        flag(X, V, V),
  788        feedback('~t~8|~w = ~w~n', [X, V]),
  789        '$add_directive_wic'(set_flag(X, V)),
  790        fail
  791    ;   true
  792    ).
  793
  794save_prompt :-
  795    feedback('~nPROMPT~n~n', []),
  796    prompt(Prompt, Prompt),
  797    '$add_directive_wic'(prompt(_, Prompt)).
  798
  799
  800                 /*******************************
  801                 *           IMPORTS            *
  802                 *******************************/
  803
  804%!  save_imports
  805%
  806%   Save  import  relations.  An  import  relation  is  saved  if  a
  807%   predicate is imported from a module that is not a default module
  808%   for the destination module. If  the   predicate  is  dynamic, we
  809%   always define the explicit import relation to make clear that an
  810%   assert must assert on the imported predicate.
  811
  812save_imports :-
  813    feedback('~nIMPORTS~n~n', []),
  814    (   predicate_property(M:H, imported_from(I)),
  815        \+ default_import(M, H, I),
  816        functor(H, F, A),
  817        feedback('~t~8|~w:~w/~d <-- ~w~n', [M, F, A, I]),
  818        '$add_directive_wic'(qsave:restore_import(M, I, F/A)),
  819        fail
  820    ;   true
  821    ).
  822
  823default_import(To, Head, From) :-
  824    '$get_predicate_attribute'(To:Head, (dynamic), 1),
  825    predicate_property(From:Head, exported),
  826    !,
  827    fail.
  828default_import(Into, _, From) :-
  829    default_module(Into, From).
  830
  831%!  restore_import(+TargetModule, +SourceModule, +PI) is det.
  832%
  833%   Restore import relation. This notably   deals  with imports from
  834%   the module =user=, avoiding a message  that the predicate is not
  835%   exported.
  836
  837restore_import(To, user, PI) :-
  838    !,
  839    export(user:PI),
  840    To:import(user:PI).
  841restore_import(To, From, PI) :-
  842    To:import(From:PI).
  843
  844                 /*******************************
  845                 *         PROLOG FLAGS         *
  846                 *******************************/
  847
  848save_prolog_flags(Options) :-
  849    feedback('~nPROLOG FLAGS~n~n', []),
  850    '$current_prolog_flag'(Flag, Value0, _Scope, write, Type),
  851    \+ no_save_flag(Flag),
  852    map_flag(Flag, Value0, Value, Options),
  853    feedback('~t~8|~w: ~w (type ~q)~n', [Flag, Value, Type]),
  854    '$add_directive_wic'(qsave:restore_prolog_flag(Flag, Value, Type)),
  855    fail.
  856save_prolog_flags(_).
  857
  858no_save_flag(argv).
  859no_save_flag(os_argv).
  860no_save_flag(access_level).
  861no_save_flag(tty_control).
  862no_save_flag(readline).
  863no_save_flag(associated_file).
  864no_save_flag(cpu_count).
  865no_save_flag(tmp_dir).
  866no_save_flag(file_name_case_handling).
  867no_save_flag(hwnd).                     % should be read-only, but comes
  868                                        % from user-code
  869map_flag(autoload, true, false, Options) :-
  870    option(class(runtime), Options, runtime),
  871    option(autoload(true), Options, true),
  872    !.
  873map_flag(_, Value, Value, _).
  874
  875
  876%!  restore_prolog_flag(+Name, +Value, +Type)
  877%
  878%   Deal  with  possibly   protected    flags   (debug_on_error  and
  879%   report_error are protected flags for the runtime kernel).
  880
  881restore_prolog_flag(Flag, Value, _Type) :-
  882    current_prolog_flag(Flag, Value),
  883    !.
  884restore_prolog_flag(Flag, Value, _Type) :-
  885    current_prolog_flag(Flag, _),
  886    !,
  887    catch(set_prolog_flag(Flag, Value), _, true).
  888restore_prolog_flag(Flag, Value, Type) :-
  889    create_prolog_flag(Flag, Value, [type(Type)]).
  890
  891
  892                 /*******************************
  893                 *           OPERATORS          *
  894                 *******************************/
  895
  896%!  save_operators(+Options) is det.
  897%
  898%   Save operators for all modules.   Operators for =system= are
  899%   not saved because these are read-only anyway.
  900
  901save_operators(Options) :-
  902    !,
  903    option(op(save), Options, save),
  904    feedback('~nOPERATORS~n', []),
  905    forall(current_module(M), save_module_operators(M)),
  906    feedback('~n', []).
  907save_operators(_).
  908
  909save_module_operators(system) :- !.
  910save_module_operators(M) :-
  911    forall('$local_op'(P,T,M:N),
  912           (   feedback('~n~t~8|~w ', [op(P,T,M:N)]),
  913               '$add_directive_wic'(op(P,T,M:N))
  914           )).
  915
  916
  917                 /*******************************
  918                 *       FORMAT PREDICATES      *
  919                 *******************************/
  920
  921save_format_predicates :-
  922    feedback('~nFORMAT PREDICATES~n', []),
  923    current_format_predicate(Code, Head),
  924    qualify_head(Head, QHead),
  925    D = format_predicate(Code, QHead),
  926    feedback('~n~t~8|~w ', [D]),
  927    '$add_directive_wic'(D),
  928    fail.
  929save_format_predicates.
  930
  931qualify_head(T, T) :-
  932    functor(T, :, 2),
  933    !.
  934qualify_head(T, user:T).
  935
  936
  937                 /*******************************
  938                 *       FOREIGN LIBRARIES      *
  939                 *******************************/
  940
  941%!  save_foreign_libraries(+Archive, +Options) is det.
  942%
  943%   Save current foreign libraries into the archive.
  944
  945save_foreign_libraries(RC, Options) :-
  946    option(foreign(save), Options),
  947    !,
  948    current_prolog_flag(arch, HostArch),
  949    feedback('~nHOST(~w) FOREIGN LIBRARIES~n', [HostArch]),
  950    save_foreign_libraries1(HostArch, RC, Options).
  951save_foreign_libraries(RC, Options) :-
  952    option(foreign(arch(Archs)), Options),
  953    !,
  954    forall(member(Arch, Archs),
  955           ( feedback('~n~w FOREIGN LIBRARIES~n', [Arch]),
  956             save_foreign_libraries1(Arch, RC, Options)
  957           )).
  958save_foreign_libraries(_, _).
  959
  960save_foreign_libraries1(Arch, RC, _Options) :-
  961    forall(current_foreign_library(FileSpec, _Predicates),
  962           ( find_foreign_library(Arch, FileSpec, EntryName, File, Time),
  963             term_to_atom(EntryName, Name),
  964             zipper_append_file(RC, Name, File, [time(Time)])
  965           )).
  966
  967%!  find_foreign_library(+Architecture, +FileSpec, -EntryName, -File, -Time)
  968%!								is det.
  969%
  970%   Find  the  shared  object  specified  by   FileSpec  for  the  named
  971%   Architecture. EntryName will be the  name   of  the  file within the
  972%   saved state archive. If posible, the   shared  object is stripped to
  973%   reduce its size. This  is  achieved   by  calling  =|strip  -o <tmp>
  974%   <shared-object>|=. Note that (if stripped) the  file is a Prolog tmp
  975%   file and will be deleted on halt.
  976%
  977%   @bug    Should perform OS search on failure
  978
  979find_foreign_library(Arch, FileSpec, shlib(Arch,Name), SharedObject, Time) :-
  980    FileSpec = foreign(Name),
  981    (   catch(arch_find_shlib(Arch, FileSpec, File),
  982              E,
  983              print_message(error, E)),
  984        exists_file(File)
  985    ->  true
  986    ;   throw(error(existence_error(architecture_shlib(Arch), FileSpec),_))
  987    ),
  988    time_file(File, Time),
  989    strip_file(File, SharedObject).
  990
  991%!  strip_file(+File, -Stripped) is det.
  992%
  993%   Try to strip File. Unify Stripped with   File if stripping fails for
  994%   some reason.
  995
  996strip_file(File, Stripped) :-
  997    absolute_file_name(path(strip), Strip,
  998                       [ access(execute),
  999                         file_errors(fail)
 1000                       ]),
 1001    tmp_file(shared, Stripped),
 1002    (   catch(do_strip_file(Strip, File, Stripped), E,
 1003              (print_message(warning, E), fail))
 1004    ->  true
 1005    ;   print_message(warning, qsave(strip_failed(File))),
 1006        fail
 1007    ),
 1008    !.
 1009strip_file(File, File).
 1010
 1011do_strip_file(Strip, File, Stripped) :-
 1012    format(atom(Cmd), '"~w" -x -o "~w" "~w"',
 1013           [Strip, Stripped, File]),
 1014    shell(Cmd),
 1015    exists_file(Stripped).
 1016
 1017%!  qsave:arch_shlib(+Architecture, +FileSpec, -File) is det.
 1018%
 1019%   This is a user defined hook called by qsave_program/2. It is used to
 1020%   find a shared library  for  the   specified  Architecture,  named by
 1021%   FileSpec. FileSpec is of  the   form  foreign(Name), a specification
 1022%   usable by absolute_file_name/2. The predicate should unify File with
 1023%   the absolute path for the  shared   library  that corresponds to the
 1024%   specified Architecture.
 1025%
 1026%   If  this  predicate  fails  to  find    a  file  for  the  specified
 1027%   architecture an `existence_error` is thrown.
 1028
 1029:- multifile arch_shlib/3. 1030
 1031arch_find_shlib(Arch, FileSpec, File) :-
 1032    arch_shlib(Arch, FileSpec, File),
 1033    !.
 1034arch_find_shlib(Arch, FileSpec, File) :-
 1035    current_prolog_flag(arch, Arch),
 1036    absolute_file_name(FileSpec,
 1037                       [ file_type(executable),
 1038                         access(read),
 1039                         file_errors(fail)
 1040                       ], File),
 1041    !.
 1042arch_find_shlib(Arch, foreign(Base), File) :-
 1043    current_prolog_flag(arch, Arch),
 1044    current_prolog_flag(windows, true),
 1045    current_prolog_flag(executable, WinExe),
 1046    prolog_to_os_filename(Exe, WinExe),
 1047    file_directory_name(Exe, BinDir),
 1048    file_name_extension(Base, dll, DllFile),
 1049    atomic_list_concat([BinDir, /, DllFile], File),
 1050    exists_file(File).
 1051
 1052
 1053                 /*******************************
 1054                 *             UTIL             *
 1055                 *******************************/
 1056
 1057open_map(Options) :-
 1058    option(map(Map), Options),
 1059    !,
 1060    open(Map, write, Fd),
 1061    asserta(verbose(Fd)).
 1062open_map(_) :-
 1063    retractall(verbose(_)).
 1064
 1065close_map :-
 1066    retract(verbose(Fd)),
 1067    close(Fd),
 1068    !.
 1069close_map.
 1070
 1071feedback(Fmt, Args) :-
 1072    verbose(Fd),
 1073    !,
 1074    format(Fd, Fmt, Args).
 1075feedback(_, _).
 1076
 1077
 1078check_options([]) :- !.
 1079check_options([Var|_]) :-
 1080    var(Var),
 1081    !,
 1082    throw(error(domain_error(save_options, Var), _)).
 1083check_options([Name=Value|T]) :-
 1084    !,
 1085    (   save_option(Name, Type, _Comment)
 1086    ->  (   must_be(Type, Value)
 1087        ->  check_options(T)
 1088        ;   throw(error(domain_error(Type, Value), _))
 1089        )
 1090    ;   throw(error(domain_error(save_option, Name), _))
 1091    ).
 1092check_options([Term|T]) :-
 1093    Term =.. [Name,Arg],
 1094    !,
 1095    check_options([Name=Arg|T]).
 1096check_options([Var|_]) :-
 1097    throw(error(domain_error(save_options, Var), _)).
 1098check_options(Opt) :-
 1099    throw(error(domain_error(list, Opt), _)).
 1100
 1101
 1102%!  zipper_append_file(+Zipper, +Name, +File, +Options) is det.
 1103%
 1104%   Append the content of File under Name to the open Zipper.
 1105
 1106zipper_append_file(_, Name, _, _) :-
 1107    saved_resource_file(Name),
 1108    !.
 1109zipper_append_file(_, _, File, _) :-
 1110    source_file(File),
 1111    !.
 1112zipper_append_file(Zipper, Name, File, Options) :-
 1113    (   option(time(_), Options)
 1114    ->  Options1 = Options
 1115    ;   time_file(File, Stamp),
 1116        Options1 = [time(Stamp)|Options]
 1117    ),
 1118    setup_call_cleanup(
 1119        open(File, read, In, [type(binary)]),
 1120        setup_call_cleanup(
 1121            zipper_open_new_file_in_zip(Zipper, Name, Out, Options1),
 1122            copy_stream_data(In, Out),
 1123            close(Out)),
 1124        close(In)),
 1125    assertz(saved_resource_file(Name)).
 1126
 1127%!  zipper_add_directory(+Zipper, +Name, +Dir, +Options) is det.
 1128%
 1129%   Add a directory entry. Dir  is  only   used  if  there  is no option
 1130%   time(Stamp).
 1131
 1132zipper_add_directory(Zipper, Name, Dir, Options) :-
 1133    (   option(time(Stamp), Options)
 1134    ->  true
 1135    ;   time_file(Dir, Stamp)
 1136    ),
 1137    atom_concat(Name, /, DirName),
 1138    (   saved_resource_file(DirName)
 1139    ->  true
 1140    ;   setup_call_cleanup(
 1141            zipper_open_new_file_in_zip(Zipper, DirName, Out,
 1142                                        [ method(store),
 1143                                          time(Stamp)
 1144                                        | Options
 1145                                        ]),
 1146            true,
 1147            close(Out)),
 1148        assertz(saved_resource_file(DirName))
 1149    ).
 1150
 1151add_parent_dirs(Zipper, Name, Dir, Options) :-
 1152    (   option(time(Stamp), Options)
 1153    ->  true
 1154    ;   time_file(Dir, Stamp)
 1155    ),
 1156    file_directory_name(Name, Parent),
 1157    (   Parent \== Name
 1158    ->  add_parent_dirs(Zipper, Parent, [time(Stamp)|Options])
 1159    ;   true
 1160    ).
 1161
 1162add_parent_dirs(_, '.', _) :-
 1163    !.
 1164add_parent_dirs(Zipper, Name, Options) :-
 1165    zipper_add_directory(Zipper, Name, _, Options),
 1166    file_directory_name(Name, Parent),
 1167    (   Parent \== Name
 1168    ->  add_parent_dirs(Zipper, Parent, Options)
 1169    ;   true
 1170    ).
 1171
 1172
 1173%!  zipper_append_directory(+Zipper, +Name, +Dir, +Options) is det.
 1174%
 1175%   Append the content of  Dir  below   Name  in  the  resource archive.
 1176%   Options:
 1177%
 1178%     - include(+Patterns)
 1179%     Only add entries that match an element from Patterns using
 1180%     wildcard_match/2.
 1181%     - exclude(+Patterns)
 1182%     Ignore entries that match an element from Patterns using
 1183%     wildcard_match/2.
 1184%
 1185%   @tbd Process .gitignore.  There also seem to exists other
 1186%   standards for this.
 1187
 1188zipper_append_directory(Zipper, Name, Dir, Options) :-
 1189    exists_directory(Dir),
 1190    !,
 1191    add_parent_dirs(Zipper, Name, Dir, Options),
 1192    zipper_add_directory(Zipper, Name, Dir, Options),
 1193    directory_files(Dir, Members),
 1194    forall(member(M, Members),
 1195           (   reserved(M)
 1196           ->  true
 1197           ;   ignored(M, Options)
 1198           ->  true
 1199           ;   atomic_list_concat([Dir,M], /, Entry),
 1200               atomic_list_concat([Name,M], /, Store),
 1201               catch(zipper_append_directory(Zipper, Store, Entry, Options),
 1202                     E,
 1203                     print_message(warning, E))
 1204           )).
 1205zipper_append_directory(Zipper, Name, File, Options) :-
 1206    zipper_append_file(Zipper, Name, File, Options).
 1207
 1208reserved(.).
 1209reserved(..).
 1210
 1211%!  ignored(+File, +Options) is semidet.
 1212%
 1213%   Ignore File if there is an  include(Patterns) option that does *not*
 1214%   match File or an exclude(Patterns) that does match File.
 1215
 1216ignored(File, Options) :-
 1217    option(include(Patterns), Options),
 1218    \+ ( (   is_list(Patterns)
 1219         ->  member(Pattern, Patterns)
 1220         ;   Pattern = Patterns
 1221         ),
 1222         glob_match(Pattern, File)
 1223       ),
 1224    !.
 1225ignored(File, Options) :-
 1226    option(exclude(Patterns), Options),
 1227    (   is_list(Patterns)
 1228    ->  member(Pattern, Patterns)
 1229    ;   Pattern = Patterns
 1230    ),
 1231    glob_match(Pattern, File),
 1232    !.
 1233
 1234glob_match(Pattern, File) :-
 1235    current_prolog_flag(file_name_case_handling, case_sensitive),
 1236    !,
 1237    wildcard_match(Pattern, File).
 1238glob_match(Pattern, File) :-
 1239    wildcard_match(Pattern, File, [case_sensitive(false)]).
 1240
 1241
 1242                /********************************
 1243                *     SAVED STATE GENERATION    *
 1244                *********************************/
 1245
 1246%!  qsave_toplevel
 1247%
 1248%   Called to handle `-c file` compilaton.
 1249
 1250:- public
 1251    qsave_toplevel/0. 1252
 1253qsave_toplevel :-
 1254    current_prolog_flag(os_argv, Argv),
 1255    qsave_options(Argv, Files, Options),
 1256    set_on_error(Options),
 1257    '$cmd_option_val'(compileout, Out),
 1258    user:consult(Files),
 1259    maybe_exit_on_errors,
 1260    qsave_program(Out, user:Options).
 1261
 1262set_on_error(Options) :-
 1263    option(on_error(_), Options), !.
 1264set_on_error(_Options) :-
 1265    set_prolog_flag(on_error, status).
 1266
 1267maybe_exit_on_errors :-
 1268    '$exit_code'(Code),
 1269    (   Code =\= 0
 1270    ->  halt
 1271    ;   true
 1272    ).
 1273
 1274qsave_options([], [], []).
 1275qsave_options([--|_], [], []) :-
 1276    !.
 1277qsave_options(['-c'|T0], Files, Options) :-
 1278    !,
 1279    argv_files(T0, T1, Files, FilesT),
 1280    qsave_options(T1, FilesT, Options).
 1281qsave_options([O|T0], Files, [Option|T]) :-
 1282    string_concat(--, Opt, O),
 1283    split_string(Opt, =, '', [NameS|Rest]),
 1284    split_string(NameS, '-', '', NameParts),
 1285    atomic_list_concat(NameParts, '_', Name),
 1286    qsave_option(Name, OptName, Rest, Value),
 1287    !,
 1288    Option =.. [OptName, Value],
 1289    qsave_options(T0, Files, T).
 1290qsave_options([_|T0], Files, T) :-
 1291    qsave_options(T0, Files, T).
 1292
 1293argv_files([], [], Files, Files).
 1294argv_files([H|T], [H|T], Files, Files) :-
 1295    sub_atom(H, 0, _, _, -),
 1296    !.
 1297argv_files([H|T0], T, [H|Files0], Files) :-
 1298    argv_files(T0, T, Files0, Files).
 1299
 1300%!  qsave_option(+Name, +ValueStrings, -Value) is semidet.
 1301
 1302qsave_option(Name, Name, [], true) :-
 1303    save_option(Name, boolean, _),
 1304    !.
 1305qsave_option(NoName, Name, [], false) :-
 1306    atom_concat('no_', Name, NoName),
 1307    save_option(Name, boolean, _),
 1308    !.
 1309qsave_option(Name, Name, ValueStrings, Value) :-
 1310    save_option(Name, Type, _),
 1311    !,
 1312    atomics_to_string(ValueStrings, "=", ValueString),
 1313    convert_option_value(Type, ValueString, Value).
 1314qsave_option(Name, Name, _Chars, _Value) :-
 1315    existence_error(save_option, Name).
 1316
 1317convert_option_value(integer, String, Value) :-
 1318    (   number_string(Value, String)
 1319    ->  true
 1320    ;   sub_string(String, 0, _, 1, SubString),
 1321        sub_string(String, _, 1, 0, Suffix0),
 1322        downcase_atom(Suffix0, Suffix),
 1323        number_string(Number, SubString),
 1324        suffix_multiplier(Suffix, Multiplier)
 1325    ->  Value is Number * Multiplier
 1326    ;   domain_error(integer, String)
 1327    ).
 1328convert_option_value(callable, String, Value) :-
 1329    term_string(Value, String).
 1330convert_option_value(atom, String, Value) :-
 1331    atom_string(Value, String).
 1332convert_option_value(boolean, String, Value) :-
 1333    atom_string(Value, String).
 1334convert_option_value(oneof(_), String, Value) :-
 1335    atom_string(Value, String).
 1336convert_option_value(ground, String, Value) :-
 1337    atom_string(Value, String).
 1338convert_option_value(qsave_foreign_option, "save", save).
 1339convert_option_value(qsave_foreign_option, StrArchList, arch(ArchList)) :-
 1340    split_string(StrArchList, ",", ", \t", StrArchList1),
 1341    maplist(atom_string, ArchList, StrArchList1).
 1342
 1343suffix_multiplier(b, 1).
 1344suffix_multiplier(k, 1024).
 1345suffix_multiplier(m, 1024 * 1024).
 1346suffix_multiplier(g, 1024 * 1024 * 1024).
 1347
 1348
 1349                 /*******************************
 1350                 *            MESSAGES          *
 1351                 *******************************/
 1352
 1353:- multifile prolog:message/3. 1354
 1355prolog:message(no_resource(Name, File)) -->
 1356    [ 'Could not find resource ~w on ~w or system resources'-
 1357      [Name, File] ].
 1358prolog:message(qsave(nondet)) -->
 1359    [ 'qsave_program/2 succeeded with a choice point'-[] ]