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    setup_call_cleanup(
  578        zipper_open_current(FromRC, FdIn,
  579                            [ type(binary)
  580                            ]),
  581        setup_call_cleanup(
  582            zipper_open_new_file_in_zip(ToRC, Name, FdOut, []),
  583            ( feedback('~t~8|~w~t~24|~w~n',
  584                       [Name, '<Copied from running state>']),
  585              copy_stream_data(FdIn, FdOut)
  586            ),
  587            close(FdOut)),
  588        close(FdIn)).
  589
  590
  591		 /*******************************
  592		 *           OBFUSCATE		*
  593		 *******************************/
  594
  595%!  create_mapping(+Options) is det.
  596%
  597%   Call hook to obfuscate symbols.
  598
  599:- multifile prolog:obfuscate_identifiers/1.  600
  601create_mapping(Options) :-
  602    option(obfuscate(true), Options),
  603    !,
  604    (   predicate_property(prolog:obfuscate_identifiers(_), number_of_clauses(N)),
  605        N > 0
  606    ->  true
  607    ;   use_module(library(obfuscate))
  608    ),
  609    (   catch(prolog:obfuscate_identifiers(Options), E,
  610              print_message(error, E))
  611    ->  true
  612    ;   print_message(warning, failed(obfuscate_identifiers))
  613    ).
  614create_mapping(_).
  615
  616%!  lock_files(+SaveClass) is det.
  617%
  618%   When saving as `runtime`, lock all files  such that when running the
  619%   program the system stops checking existence and modification time on
  620%   the filesystem.
  621%
  622%   @tbd `system` is a poor name.  Maybe use `resource`?
  623
  624lock_files(runtime) :-
  625    !,
  626    '$set_source_files'(system).                % implies from_state
  627lock_files(_) :-
  628    '$set_source_files'(from_state).
  629
  630%!  save_program(+Zipper, +SaveClass, +Options) is det.
  631%
  632%   Save the program itself as virtual machine code to Zipper.
  633
  634save_program(RC, SaveClass, Options) :-
  635    setup_call_cleanup(
  636        ( zipper_open_new_file_in_zip(RC, '$prolog/state.qlf', StateFd,
  637                                      [ zip64(true)
  638                                      ]),
  639          current_prolog_flag(access_level, OldLevel),
  640          set_prolog_flag(access_level, system), % generate system modules
  641          '$open_wic'(StateFd, Options)
  642        ),
  643        ( create_mapping(Options),
  644          save_modules(SaveClass),
  645          save_records,
  646          save_flags,
  647          save_prompt,
  648          save_imports,
  649          save_prolog_flags(Options),
  650          save_operators(Options),
  651          save_format_predicates
  652        ),
  653        ( '$close_wic',
  654          set_prolog_flag(access_level, OldLevel),
  655          close(StateFd)
  656        )).
  657
  658
  659                 /*******************************
  660                 *            MODULES           *
  661                 *******************************/
  662
  663save_modules(SaveClass) :-
  664    forall(special_module(X),
  665           save_module(X, SaveClass)),
  666    forall((current_module(X), \+ special_module(X)),
  667           save_module(X, SaveClass)).
  668
  669special_module(system).
  670special_module(user).
  671
  672
  673%!  prepare_entry_points(+Options)
  674%
  675%   Prepare  the  --goal=Goal  and  --toplevel=Goal  options.  Preparing
  676%   implies autoloading the definition and declaring it _public_ such at
  677%   it doesn't get obfuscated.
  678
  679prepare_entry_points(Options) :-
  680    define_init_goal(Options),
  681    define_toplevel_goal(Options).
  682
  683define_init_goal(Options) :-
  684    option(goal(Goal), Options),
  685    !,
  686    entry_point(Goal).
  687define_init_goal(_).
  688
  689define_toplevel_goal(Options) :-
  690    option(toplevel(Goal), Options),
  691    !,
  692    entry_point(Goal).
  693define_toplevel_goal(_).
  694
  695entry_point(Goal) :-
  696    define_predicate(Goal),
  697    (   \+ predicate_property(Goal, built_in),
  698        \+ predicate_property(Goal, imported_from(_))
  699    ->  goal_pi(Goal, PI),
  700        public(PI)
  701    ;   true
  702    ).
  703
  704define_predicate(Head) :-
  705    '$define_predicate'(Head),
  706    !.   % autoloader
  707define_predicate(Head) :-
  708    strip_module(Head, _, Term),
  709    functor(Term, Name, Arity),
  710    throw(error(existence_error(procedure, Name/Arity), _)).
  711
  712goal_pi(M:G, QPI) :-
  713    !,
  714    strip_module(M:G, Module, Goal),
  715    functor(Goal, Name, Arity),
  716    QPI = Module:Name/Arity.
  717goal_pi(Goal, Name/Arity) :-
  718    functor(Goal, Name, Arity).
  719
  720%!  prepare_state(+Options) is det.
  721%
  722%   Prepare the executable by  running   the  `prepare_state` registered
  723%   initialization hooks.
  724
  725prepare_state(_) :-
  726    forall('$init_goal'(when(prepare_state), Goal, Ctx),
  727           run_initialize(Goal, Ctx)).
  728
  729run_initialize(Goal, Ctx) :-
  730    (   catch(Goal, E, true),
  731        (   var(E)
  732        ->  true
  733        ;   throw(error(initialization_error(E, Goal, Ctx), _))
  734        )
  735    ;   throw(error(initialization_error(failed, Goal, Ctx), _))
  736    ).
  737
  738
  739                 /*******************************
  740                 *            AUTOLOAD          *
  741                 *******************************/
  742
  743%!  save_autoload(+Options) is det.
  744%
  745%   Resolve all autoload dependencies.
  746%
  747%   @error existence_error(procedures, List) if undefined(true) is
  748%   in Options and there are undefined predicates.
  749
  750save_autoload(Options) :-
  751    option(autoload(true),  Options, true),
  752    !,
  753    setup_call_cleanup(
  754        current_prolog_flag(autoload, Old),
  755        autoload_all(Options),
  756        set_prolog_flag(autoload, Old)).
  757save_autoload(_).
  758
  759
  760                 /*******************************
  761                 *             MODULES          *
  762                 *******************************/
  763
  764%!  save_module(+Module, +SaveClass)
  765%
  766%   Saves a module
  767
  768save_module(M, SaveClass) :-
  769    '$qlf_start_module'(M),
  770    feedback('~n~nMODULE ~w~n', [M]),
  771    save_unknown(M),
  772    (   P = (M:_H),
  773        current_predicate(_, P),
  774        \+ predicate_property(P, imported_from(_)),
  775        save_predicate(P, SaveClass),
  776        fail
  777    ;   '$qlf_end_part',
  778        feedback('~n', [])
  779    ).
  780
  781save_predicate(P, _SaveClass) :-
  782    predicate_property(P, foreign),
  783    !,
  784    P = (M:H),
  785    functor(H, Name, Arity),
  786    feedback('~npre-defining foreign ~w/~d ', [Name, Arity]),
  787    '$add_directive_wic'('$predefine_foreign'(M:Name/Arity)),
  788    save_attributes(P).
  789save_predicate(P, SaveClass) :-
  790    P = (M:H),
  791    functor(H, F, A),
  792    feedback('~nsaving ~w/~d ', [F, A]),
  793    (   (   H = resource(_,_)
  794        ;   H = resource(_,_,_)
  795        )
  796    ->  (   SaveClass == development
  797        ->  true
  798        ;   save_attribute(P, (dynamic)),
  799            (   M == user
  800            ->  save_attribute(P, (multifile))
  801            ),
  802            feedback('(Skipped clauses)', []),
  803            fail
  804        )
  805    ;   true
  806    ),
  807    (   no_save(P)
  808    ->  true
  809    ;   save_attributes(P),
  810        \+ predicate_property(P, (volatile)),
  811        (   nth_clause(P, _, Ref),
  812            feedback('.', []),
  813            '$qlf_assert_clause'(Ref, SaveClass),
  814            fail
  815        ;   true
  816        )
  817    ).
  818
  819no_save(P) :-
  820    predicate_property(P, volatile),
  821    \+ predicate_property(P, dynamic),
  822    \+ predicate_property(P, multifile).
  823
  824pred_attrib(meta_predicate(Term), Head, meta_predicate(M:Term)) :-
  825    !,
  826    strip_module(Head, M, _).
  827pred_attrib(Attrib, Head,
  828            '$set_predicate_attribute'(M:Name/Arity, AttName, Val)) :-
  829    attrib_name(Attrib, AttName, Val),
  830    strip_module(Head, M, Term),
  831    functor(Term, Name, Arity).
  832
  833attrib_name(dynamic,                dynamic,                true).
  834attrib_name(incremental,            incremental,            true).
  835attrib_name(volatile,               volatile,               true).
  836attrib_name(thread_local,           thread_local,           true).
  837attrib_name(multifile,              multifile,              true).
  838attrib_name(public,                 public,                 true).
  839attrib_name(transparent,            transparent,            true).
  840attrib_name(discontiguous,          discontiguous,          true).
  841attrib_name(notrace,                trace,                  false).
  842attrib_name(show_childs,            hide_childs,            false).
  843attrib_name(built_in,               system,                 true).
  844attrib_name(nodebug,                hide_childs,            true).
  845attrib_name(quasi_quotation_syntax, quasi_quotation_syntax, true).
  846attrib_name(iso,                    iso,                    true).
  847
  848
  849save_attribute(P, Attribute) :-
  850    pred_attrib(Attribute, P, D),
  851    (   Attribute == built_in       % no need if there are clauses
  852    ->  (   predicate_property(P, number_of_clauses(0))
  853        ->  true
  854        ;   predicate_property(P, volatile)
  855        )
  856    ;   Attribute == (dynamic)      % no need if predicate is thread_local
  857    ->  \+ predicate_property(P, thread_local)
  858    ;   true
  859    ),
  860    '$add_directive_wic'(D),
  861    feedback('(~w) ', [Attribute]).
  862
  863save_attributes(P) :-
  864    (   predicate_property(P, Attribute),
  865        save_attribute(P, Attribute),
  866        fail
  867    ;   true
  868    ).
  869
  870%       Save status of the unknown flag
  871
  872save_unknown(M) :-
  873    current_prolog_flag(M:unknown, Unknown),
  874    (   Unknown == error
  875    ->  true
  876    ;   '$add_directive_wic'(set_prolog_flag(M:unknown, Unknown))
  877    ).
  878
  879                 /*******************************
  880                 *            RECORDS           *
  881                 *******************************/
  882
  883save_records :-
  884    feedback('~nRECORDS~n', []),
  885    (   current_key(X),
  886        X \== '$topvar',                        % do not safe toplevel variables
  887        feedback('~n~t~8|~w ', [X]),
  888        recorded(X, V, _),
  889        feedback('.', []),
  890        '$add_directive_wic'(recordz(X, V, _)),
  891        fail
  892    ;   true
  893    ).
  894
  895
  896                 /*******************************
  897                 *            FLAGS             *
  898                 *******************************/
  899
  900save_flags :-
  901    feedback('~nFLAGS~n~n', []),
  902    (   current_flag(X),
  903        flag(X, V, V),
  904        feedback('~t~8|~w = ~w~n', [X, V]),
  905        '$add_directive_wic'(set_flag(X, V)),
  906        fail
  907    ;   true
  908    ).
  909
  910save_prompt :-
  911    feedback('~nPROMPT~n~n', []),
  912    prompt(Prompt, Prompt),
  913    '$add_directive_wic'(prompt(_, Prompt)).
  914
  915
  916                 /*******************************
  917                 *           IMPORTS            *
  918                 *******************************/
  919
  920%!  save_imports
  921%
  922%   Save  import  relations.  An  import  relation  is  saved  if  a
  923%   predicate is imported from a module that is not a default module
  924%   for the destination module. If  the   predicate  is  dynamic, we
  925%   always define the explicit import relation to make clear that an
  926%   assert must assert on the imported predicate.
  927
  928save_imports :-
  929    feedback('~nIMPORTS~n~n', []),
  930    (   predicate_property(M:H, imported_from(I)),
  931        \+ default_import(M, H, I),
  932        functor(H, F, A),
  933        feedback('~t~8|~w:~w/~d <-- ~w~n', [M, F, A, I]),
  934        '$add_directive_wic'(qsave:restore_import(M, I, F/A)),
  935        fail
  936    ;   true
  937    ).
  938
  939default_import(To, Head, From) :-
  940    '$get_predicate_attribute'(To:Head, (dynamic), 1),
  941    predicate_property(From:Head, exported),
  942    !,
  943    fail.
  944default_import(Into, _, From) :-
  945    default_module(Into, From).
  946
  947%!  restore_import(+TargetModule, +SourceModule, +PI) is det.
  948%
  949%   Restore import relation. This notably   deals  with imports from
  950%   the module =user=, avoiding a message  that the predicate is not
  951%   exported.
  952
  953restore_import(To, user, PI) :-
  954    !,
  955    export(user:PI),
  956    To:import(user:PI).
  957restore_import(To, From, PI) :-
  958    To:import(From:PI).
  959
  960                 /*******************************
  961                 *         PROLOG FLAGS         *
  962                 *******************************/
  963
  964save_prolog_flags(Options) :-
  965    feedback('~nPROLOG FLAGS~n~n', []),
  966    '$current_prolog_flag'(Flag, Value0, _Scope, write, Type),
  967    \+ no_save_flag(Flag),
  968    map_flag(Flag, Value0, Value, Options),
  969    feedback('~t~8|~w: ~w (type ~q)~n', [Flag, Value, Type]),
  970    '$add_directive_wic'(qsave:restore_prolog_flag(Flag, Value, Type)),
  971    fail.
  972save_prolog_flags(_).
  973
  974no_save_flag(argv).
  975no_save_flag(os_argv).
  976no_save_flag(access_level).
  977no_save_flag(tty_control).
  978no_save_flag(readline).
  979no_save_flag(associated_file).
  980no_save_flag(cpu_count).
  981no_save_flag(tmp_dir).
  982no_save_flag(file_name_case_handling).
  983no_save_flag(hwnd).                     % should be read-only, but comes
  984                                        % from user-code
  985map_flag(autoload, true, false, Options) :-
  986    option(class(runtime), Options, runtime),
  987    option(autoload(true), Options, true),
  988    !.
  989map_flag(_, Value, Value, _).
  990
  991
  992%!  restore_prolog_flag(+Name, +Value, +Type)
  993%
  994%   Deal  with  possibly   protected    flags   (debug_on_error  and
  995%   report_error are protected flags for the runtime kernel).
  996
  997restore_prolog_flag(Flag, Value, _Type) :-
  998    current_prolog_flag(Flag, Value),
  999    !.
 1000restore_prolog_flag(Flag, Value, _Type) :-
 1001    current_prolog_flag(Flag, _),
 1002    !,
 1003    catch(set_prolog_flag(Flag, Value), _, true).
 1004restore_prolog_flag(Flag, Value, Type) :-
 1005    create_prolog_flag(Flag, Value, [type(Type)]).
 1006
 1007
 1008                 /*******************************
 1009                 *           OPERATORS          *
 1010                 *******************************/
 1011
 1012%!  save_operators(+Options) is det.
 1013%
 1014%   Save operators for all modules.   Operators for =system= are
 1015%   not saved because these are read-only anyway.
 1016
 1017save_operators(Options) :-
 1018    !,
 1019    option(op(save), Options, save),
 1020    feedback('~nOPERATORS~n', []),
 1021    forall(current_module(M), save_module_operators(M)),
 1022    feedback('~n', []).
 1023save_operators(_).
 1024
 1025save_module_operators(system) :- !.
 1026save_module_operators(M) :-
 1027    forall('$local_op'(P,T,M:N),
 1028           (   feedback('~n~t~8|~w ', [op(P,T,M:N)]),
 1029               '$add_directive_wic'(op(P,T,M:N))
 1030           )).
 1031
 1032
 1033                 /*******************************
 1034                 *       FORMAT PREDICATES      *
 1035                 *******************************/
 1036
 1037save_format_predicates :-
 1038    feedback('~nFORMAT PREDICATES~n', []),
 1039    current_format_predicate(Code, Head),
 1040    qualify_head(Head, QHead),
 1041    D = format_predicate(Code, QHead),
 1042    feedback('~n~t~8|~w ', [D]),
 1043    '$add_directive_wic'(D),
 1044    fail.
 1045save_format_predicates.
 1046
 1047qualify_head(T, T) :-
 1048    functor(T, :, 2),
 1049    !.
 1050qualify_head(T, user:T).
 1051
 1052
 1053                 /*******************************
 1054                 *       FOREIGN LIBRARIES      *
 1055                 *******************************/
 1056
 1057%!  save_foreign_libraries(+Archive, +ExeFile, +Options) is det.
 1058%
 1059%   Save current foreign libraries into the archive.
 1060
 1061save_foreign_libraries(RC, _, Options) :-
 1062    option(foreign(save), Options),
 1063    !,
 1064    current_prolog_flag(arch, HostArch),
 1065    feedback('~nHOST(~w) FOREIGN LIBRARIES~n', [HostArch]),
 1066    save_foreign_libraries1(HostArch, RC, Options).
 1067save_foreign_libraries(RC, _, Options) :-
 1068    option(foreign(arch(Archs)), Options),
 1069    !,
 1070    forall(member(Arch, Archs),
 1071           ( feedback('~n~w FOREIGN LIBRARIES~n', [Arch]),
 1072             save_foreign_libraries1(Arch, RC, Options)
 1073           )).
 1074save_foreign_libraries(_RC, ExeFile, Options) :-
 1075    option(foreign(copy), Options),
 1076    !,
 1077    copy_foreign_libraries(ExeFile, Options).
 1078save_foreign_libraries(_, _, _).
 1079
 1080save_foreign_libraries1(Arch, RC, _Options) :-
 1081    forall(current_foreign_library(FileSpec, _Predicates),
 1082           ( find_foreign_library(Arch, FileSpec, EntryName, File, Time),
 1083             term_to_atom(EntryName, Name),
 1084             zipper_append_file(RC, Name, File, [time(Time)])
 1085           )).
 1086
 1087%!  copy_foreign_libraries(+Exe, +Options) is det.
 1088%
 1089%   Copy all required foreign libraries   to  an installation directory.
 1090%   This is currently only implemented  for   Windows,  copying all .dll
 1091%   files to the directory where the executable is created.
 1092
 1093:- if(current_prolog_flag(windows, true)). 1094copy_foreign_libraries(ExeFile, _Options) :-
 1095    !,
 1096    file_directory_name(ExeFile, Dir),
 1097    win_process_modules(Modules),
 1098    include(prolog_dll, Modules, PrologDLLs),
 1099    maplist(copy_dll(Dir), PrologDLLs).
 1100:- endif. 1101copy_foreign_libraries(_ExeFile, _Options) :-
 1102    print_message(warning, qsave(copy_foreign_libraries)).
 1103
 1104prolog_dll(DLL) :-
 1105    file_base_name(DLL, File),
 1106    absolute_file_name(foreign(File), Abs,
 1107                       [ solutions(all) ]),
 1108	same_file(DLL, Abs),
 1109    !.
 1110
 1111copy_dll(Dest, DLL) :-
 1112    print_message(informational, copy_foreign_library(DLL, Dest)),
 1113    copy_file(DLL, Dest).
 1114
 1115
 1116%!  find_foreign_library(+Architecture, +FileSpec, -EntryName, -File, -Time)
 1117%!								is det.
 1118%
 1119%   Find  the  shared  object  specified  by   FileSpec  for  the  named
 1120%   Architecture. EntryName will be the  name   of  the  file within the
 1121%   saved state archive. If posible, the   shared  object is stripped to
 1122%   reduce its size. This  is  achieved   by  calling  =|strip  -o <tmp>
 1123%   <shared-object>|=. Note that (if stripped) the  file is a Prolog tmp
 1124%   file and will be deleted on halt.
 1125%
 1126%   @bug    Should perform OS search on failure
 1127
 1128find_foreign_library(Arch, FileSpec, shlib(Arch,Name), SharedObject, Time) :-
 1129    FileSpec = foreign(Name),
 1130    (   catch(arch_find_shlib(Arch, FileSpec, File),
 1131              E,
 1132              print_message(error, E)),
 1133        exists_file(File)
 1134    ->  true
 1135    ;   throw(error(existence_error(architecture_shlib(Arch), FileSpec),_))
 1136    ),
 1137    time_file(File, Time),
 1138    strip_file(File, SharedObject).
 1139
 1140%!  strip_file(+File, -Stripped) is det.
 1141%
 1142%   Try to strip File. Unify Stripped with   File if stripping fails for
 1143%   some reason.
 1144
 1145strip_file(File, Stripped) :-
 1146    absolute_file_name(path(strip), Strip,
 1147                       [ access(execute),
 1148                         file_errors(fail)
 1149                       ]),
 1150    tmp_file(shared, Stripped),
 1151    (   catch(do_strip_file(Strip, File, Stripped), E,
 1152              (print_message(warning, E), fail))
 1153    ->  true
 1154    ;   print_message(warning, qsave(strip_failed(File))),
 1155        fail
 1156    ),
 1157    !.
 1158strip_file(File, File).
 1159
 1160do_strip_file(Strip, File, Stripped) :-
 1161    format(atom(Cmd), '"~w" -x -o "~w" "~w"',
 1162           [Strip, Stripped, File]),
 1163    shell(Cmd),
 1164    exists_file(Stripped).
 1165
 1166%!  qsave:arch_shlib(+Architecture, +FileSpec, -File) is det.
 1167%
 1168%   This is a user defined hook called by qsave_program/2. It is used to
 1169%   find a shared library  for  the   specified  Architecture,  named by
 1170%   FileSpec. FileSpec is of  the   form  foreign(Name), a specification
 1171%   usable by absolute_file_name/2. The predicate should unify File with
 1172%   the absolute path for the  shared   library  that corresponds to the
 1173%   specified Architecture.
 1174%
 1175%   If  this  predicate  fails  to  find    a  file  for  the  specified
 1176%   architecture an `existence_error` is thrown.
 1177
 1178:- multifile arch_shlib/3. 1179
 1180arch_find_shlib(Arch, FileSpec, File) :-
 1181    arch_shlib(Arch, FileSpec, File),
 1182    !.
 1183arch_find_shlib(Arch, FileSpec, File) :-
 1184    current_prolog_flag(arch, Arch),
 1185    absolute_file_name(FileSpec,
 1186                       [ file_type(executable),
 1187                         access(read),
 1188                         file_errors(fail)
 1189                       ], File),
 1190    !.
 1191arch_find_shlib(Arch, foreign(Base), File) :-
 1192    current_prolog_flag(arch, Arch),
 1193    current_prolog_flag(windows, true),
 1194    current_prolog_flag(executable, WinExe),
 1195    prolog_to_os_filename(Exe, WinExe),
 1196    file_directory_name(Exe, BinDir),
 1197    file_name_extension(Base, dll, DllFile),
 1198    atomic_list_concat([BinDir, /, DllFile], File),
 1199    exists_file(File).
 1200
 1201
 1202                 /*******************************
 1203                 *             UTIL             *
 1204                 *******************************/
 1205
 1206open_map(Options) :-
 1207    option(map(Map), Options),
 1208    !,
 1209    open(Map, write, Fd),
 1210    asserta(verbose(Fd)).
 1211open_map(_) :-
 1212    retractall(verbose(_)).
 1213
 1214close_map :-
 1215    retract(verbose(Fd)),
 1216    close(Fd),
 1217    !.
 1218close_map.
 1219
 1220feedback(Fmt, Args) :-
 1221    verbose(Fd),
 1222    !,
 1223    format(Fd, Fmt, Args).
 1224feedback(_, _).
 1225
 1226
 1227check_options([]) :- !.
 1228check_options([Var|_]) :-
 1229    var(Var),
 1230    !,
 1231    throw(error(domain_error(save_options, Var), _)).
 1232check_options([Name=Value|T]) :-
 1233    !,
 1234    (   save_option(Name, Type, _Comment)
 1235    ->  (   must_be(Type, Value)
 1236        ->  check_options(T)
 1237        ;   throw(error(domain_error(Type, Value), _))
 1238        )
 1239    ;   throw(error(domain_error(save_option, Name), _))
 1240    ).
 1241check_options([Term|T]) :-
 1242    Term =.. [Name,Arg],
 1243    !,
 1244    check_options([Name=Arg|T]).
 1245check_options([Var|_]) :-
 1246    throw(error(domain_error(save_options, Var), _)).
 1247check_options(Opt) :-
 1248    throw(error(domain_error(list, Opt), _)).
 1249
 1250
 1251%!  zipper_append_file(+Zipper, +Name, +File, +Options) is det.
 1252%
 1253%   Append the content of File under Name to the open Zipper.
 1254
 1255zipper_append_file(_, Name, _, _) :-
 1256    saved_resource_file(Name),
 1257    !.
 1258zipper_append_file(_, _, File, _) :-
 1259    source_file(File),
 1260    !.
 1261zipper_append_file(Zipper, Name, File, Options) :-
 1262    (   option(time(_), Options)
 1263    ->  Options1 = Options
 1264    ;   time_file(File, Stamp),
 1265        Options1 = [time(Stamp)|Options]
 1266    ),
 1267    setup_call_cleanup(
 1268        open(File, read, In, [type(binary)]),
 1269        setup_call_cleanup(
 1270            zipper_open_new_file_in_zip(Zipper, Name, Out, Options1),
 1271            copy_stream_data(In, Out),
 1272            close(Out)),
 1273        close(In)),
 1274    assertz(saved_resource_file(Name)).
 1275
 1276%!  zipper_add_directory(+Zipper, +Name, +Dir, +Options) is det.
 1277%
 1278%   Add a directory entry. Dir  is  only   used  if  there  is no option
 1279%   time(Stamp).
 1280
 1281zipper_add_directory(Zipper, Name, Dir, Options) :-
 1282    (   option(time(Stamp), Options)
 1283    ->  true
 1284    ;   time_file(Dir, Stamp)
 1285    ),
 1286    atom_concat(Name, /, DirName),
 1287    (   saved_resource_file(DirName)
 1288    ->  true
 1289    ;   setup_call_cleanup(
 1290            zipper_open_new_file_in_zip(Zipper, DirName, Out,
 1291                                        [ method(store),
 1292                                          time(Stamp)
 1293                                        | Options
 1294                                        ]),
 1295            true,
 1296            close(Out)),
 1297        assertz(saved_resource_file(DirName))
 1298    ).
 1299
 1300add_parent_dirs(Zipper, Name, Dir, Options) :-
 1301    (   option(time(Stamp), Options)
 1302    ->  true
 1303    ;   time_file(Dir, Stamp)
 1304    ),
 1305    file_directory_name(Name, Parent),
 1306    (   Parent \== Name
 1307    ->  add_parent_dirs(Zipper, Parent, [time(Stamp)|Options])
 1308    ;   true
 1309    ).
 1310
 1311add_parent_dirs(_, '.', _) :-
 1312    !.
 1313add_parent_dirs(Zipper, Name, Options) :-
 1314    zipper_add_directory(Zipper, Name, _, Options),
 1315    file_directory_name(Name, Parent),
 1316    (   Parent \== Name
 1317    ->  add_parent_dirs(Zipper, Parent, Options)
 1318    ;   true
 1319    ).
 1320
 1321
 1322%!  zipper_append_directory(+Zipper, +Name, +Dir, +Options) is det.
 1323%
 1324%   Append the content of  Dir  below   Name  in  the  resource archive.
 1325%   Options:
 1326%
 1327%     - include(+Patterns)
 1328%     Only add entries that match an element from Patterns using
 1329%     wildcard_match/2.
 1330%     - exclude(+Patterns)
 1331%     Ignore entries that match an element from Patterns using
 1332%     wildcard_match/2.
 1333%
 1334%   @tbd Process .gitignore.  There also seem to exists other
 1335%   standards for this.
 1336
 1337zipper_append_directory(Zipper, Name, Dir, Options) :-
 1338    exists_directory(Dir),
 1339    !,
 1340    add_parent_dirs(Zipper, Name, Dir, Options),
 1341    zipper_add_directory(Zipper, Name, Dir, Options),
 1342    directory_files(Dir, Members),
 1343    forall(member(M, Members),
 1344           (   reserved(M)
 1345           ->  true
 1346           ;   ignored(M, Options)
 1347           ->  true
 1348           ;   atomic_list_concat([Dir,M], /, Entry),
 1349               atomic_list_concat([Name,M], /, Store),
 1350               catch(zipper_append_directory(Zipper, Store, Entry, Options),
 1351                     E,
 1352                     print_message(warning, E))
 1353           )).
 1354zipper_append_directory(Zipper, Name, File, Options) :-
 1355    zipper_append_file(Zipper, Name, File, Options).
 1356
 1357reserved(.).
 1358reserved(..).
 1359
 1360%!  ignored(+File, +Options) is semidet.
 1361%
 1362%   Ignore File if there is an  include(Patterns) option that does *not*
 1363%   match File or an exclude(Patterns) that does match File.
 1364
 1365ignored(File, Options) :-
 1366    option(include(Patterns), Options),
 1367    \+ ( (   is_list(Patterns)
 1368         ->  member(Pattern, Patterns)
 1369         ;   Pattern = Patterns
 1370         ),
 1371         glob_match(Pattern, File)
 1372       ),
 1373    !.
 1374ignored(File, Options) :-
 1375    option(exclude(Patterns), Options),
 1376    (   is_list(Patterns)
 1377    ->  member(Pattern, Patterns)
 1378    ;   Pattern = Patterns
 1379    ),
 1380    glob_match(Pattern, File),
 1381    !.
 1382
 1383glob_match(Pattern, File) :-
 1384    current_prolog_flag(file_name_case_handling, case_sensitive),
 1385    !,
 1386    wildcard_match(Pattern, File).
 1387glob_match(Pattern, File) :-
 1388    wildcard_match(Pattern, File, [case_sensitive(false)]).
 1389
 1390
 1391                /********************************
 1392                *     SAVED STATE GENERATION    *
 1393                *********************************/
 1394
 1395%!  qsave_toplevel
 1396%
 1397%   Called to handle `-c file` compilaton.
 1398
 1399:- public
 1400    qsave_toplevel/0. 1401
 1402qsave_toplevel :-
 1403    current_prolog_flag(os_argv, Argv),
 1404    qsave_options(Argv, Files, Options),
 1405    set_on_error(Options),
 1406    '$cmd_option_val'(compileout, Out),
 1407    user:consult(Files),
 1408    maybe_exit_on_errors,
 1409    qsave_program(Out, user:Options).
 1410
 1411set_on_error(Options) :-
 1412    option(on_error(_), Options), !.
 1413set_on_error(_Options) :-
 1414    set_prolog_flag(on_error, status).
 1415
 1416maybe_exit_on_errors :-
 1417    '$exit_code'(Code),
 1418    (   Code =\= 0
 1419    ->  halt
 1420    ;   true
 1421    ).
 1422
 1423qsave_options([], [], []).
 1424qsave_options([--|_], [], []) :-
 1425    !.
 1426qsave_options(['-c'|T0], Files, Options) :-
 1427    !,
 1428    argv_files(T0, T1, Files, FilesT),
 1429    qsave_options(T1, FilesT, Options).
 1430qsave_options([O|T0], Files, [Option|T]) :-
 1431    string_concat(--, Opt, O),
 1432    split_string(Opt, =, '', [NameS|Rest]),
 1433    split_string(NameS, '-', '', NameParts),
 1434    atomic_list_concat(NameParts, '_', Name),
 1435    qsave_option(Name, OptName, Rest, Value),
 1436    !,
 1437    Option =.. [OptName, Value],
 1438    qsave_options(T0, Files, T).
 1439qsave_options([_|T0], Files, T) :-
 1440    qsave_options(T0, Files, T).
 1441
 1442argv_files([], [], Files, Files).
 1443argv_files([H|T], [H|T], Files, Files) :-
 1444    sub_atom(H, 0, _, _, -),
 1445    !.
 1446argv_files([H|T0], T, [H|Files0], Files) :-
 1447    argv_files(T0, T, Files0, Files).
 1448
 1449%!  qsave_option(+Name, +ValueStrings, -Value) is semidet.
 1450
 1451qsave_option(Name, Name, [], true) :-
 1452    save_option(Name, boolean, _),
 1453    !.
 1454qsave_option(NoName, Name, [], false) :-
 1455    atom_concat('no_', Name, NoName),
 1456    save_option(Name, boolean, _),
 1457    !.
 1458qsave_option(Name, Name, ValueStrings, Value) :-
 1459    save_option(Name, Type, _),
 1460    !,
 1461    atomics_to_string(ValueStrings, "=", ValueString),
 1462    convert_option_value(Type, ValueString, Value).
 1463qsave_option(Name, Name, _Chars, _Value) :-
 1464    existence_error(save_option, Name).
 1465
 1466convert_option_value(integer, String, Value) =>
 1467    (   number_string(Value, String)
 1468    ->  true
 1469    ;   sub_string(String, 0, _, 1, SubString),
 1470        sub_string(String, _, 1, 0, Suffix0),
 1471        downcase_atom(Suffix0, Suffix),
 1472        number_string(Number, SubString),
 1473        suffix_multiplier(Suffix, Multiplier)
 1474    ->  Value is Number * Multiplier
 1475    ;   domain_error(integer, String)
 1476    ).
 1477convert_option_value(callable, String, Value) =>
 1478    term_string(Value, String).
 1479convert_option_value(atom, String, Value) =>
 1480    atom_string(Value, String).
 1481convert_option_value(boolean, String, Value) =>
 1482    atom_string(Value, String).
 1483convert_option_value(oneof(_), String, Value) =>
 1484    atom_string(Value, String).
 1485convert_option_value(ground, String, Value) =>
 1486    atom_string(Value, String).
 1487convert_option_value(qsave_foreign_option, "save", Value) =>
 1488    Value = save.
 1489convert_option_value(qsave_foreign_option, "copy", Value) =>
 1490    Value = copy.
 1491convert_option_value(qsave_foreign_option, StrArchList, arch(ArchList)) =>
 1492    split_string(StrArchList, ",", ", \t", StrArchList1),
 1493    maplist(atom_string, ArchList, StrArchList1).
 1494
 1495suffix_multiplier(b, 1).
 1496suffix_multiplier(k, 1024).
 1497suffix_multiplier(m, 1024 * 1024).
 1498suffix_multiplier(g, 1024 * 1024 * 1024).
 1499
 1500
 1501                 /*******************************
 1502                 *            MESSAGES          *
 1503                 *******************************/
 1504
 1505:- multifile prolog:message/3. 1506
 1507prolog:message(no_resource(Name, File)) -->
 1508    [ 'Could not find resource ~w on ~w or system resources'-
 1509      [Name, File] ].
 1510prolog:message(qsave(nondet)) -->
 1511    [ 'qsave_program/2 succeeded with a choice point'-[] ].
 1512prolog:message(copy_foreign_library(Lib,Dir)) -->
 1513    [ 'Copying ~w to ~w'-[Lib, Dir] ]