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