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