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(color_term).              % depends on the terminal we run on
  980no_save_flag(hyperlink_term).          % idem
  981no_save_flag(associated_file).
  982no_save_flag(cpu_count).
  983no_save_flag(tmp_dir).
  984no_save_flag(file_name_case_handling).
  985no_save_flag(hwnd).                     % should be read-only, but comes
  986                                        % from user-code
  987map_flag(autoload, true, false, Options) :-
  988    option(class(runtime), Options, runtime),
  989    option(autoload(true), Options, true),
  990    !.
  991map_flag(_, Value, Value, _).
  992
  993
  994%!  restore_prolog_flag(+Name, +Value, +Type)
  995%
  996%   Deal  with  possibly   protected    flags   (debug_on_error  and
  997%   report_error are protected flags for the runtime kernel).
  998
  999restore_prolog_flag(Flag, Value, _Type) :-
 1000    current_prolog_flag(Flag, Value),
 1001    !.
 1002restore_prolog_flag(Flag, Value, _Type) :-
 1003    current_prolog_flag(Flag, _),
 1004    !,
 1005    catch(set_prolog_flag(Flag, Value), _, true).
 1006restore_prolog_flag(Flag, Value, Type) :-
 1007    create_prolog_flag(Flag, Value, [type(Type)]).
 1008
 1009
 1010                 /*******************************
 1011                 *           OPERATORS          *
 1012                 *******************************/
 1013
 1014%!  save_operators(+Options) is det.
 1015%
 1016%   Save operators for all modules.   Operators for =system= are
 1017%   not saved because these are read-only anyway.
 1018
 1019save_operators(Options) :-
 1020    !,
 1021    option(op(save), Options, save),
 1022    feedback('~nOPERATORS~n', []),
 1023    forall(current_module(M), save_module_operators(M)),
 1024    feedback('~n', []).
 1025save_operators(_).
 1026
 1027save_module_operators(system) :- !.
 1028save_module_operators(M) :-
 1029    forall('$local_op'(P,T,M:N),
 1030           (   feedback('~n~t~8|~w ', [op(P,T,M:N)]),
 1031               '$add_directive_wic'(op(P,T,M:N))
 1032           )).
 1033
 1034
 1035                 /*******************************
 1036                 *       FORMAT PREDICATES      *
 1037                 *******************************/
 1038
 1039save_format_predicates :-
 1040    feedback('~nFORMAT PREDICATES~n', []),
 1041    current_format_predicate(Code, Head),
 1042    qualify_head(Head, QHead),
 1043    D = format_predicate(Code, QHead),
 1044    feedback('~n~t~8|~w ', [D]),
 1045    '$add_directive_wic'(D),
 1046    fail.
 1047save_format_predicates.
 1048
 1049qualify_head(T, T) :-
 1050    functor(T, :, 2),
 1051    !.
 1052qualify_head(T, user:T).
 1053
 1054
 1055                 /*******************************
 1056                 *       FOREIGN LIBRARIES      *
 1057                 *******************************/
 1058
 1059%!  save_foreign_libraries(+Archive, +ExeFile, +Options) is det.
 1060%
 1061%   Save current foreign libraries into the archive.
 1062
 1063save_foreign_libraries(RC, _, Options) :-
 1064    option(foreign(save), Options),
 1065    !,
 1066    current_prolog_flag(arch, HostArch),
 1067    feedback('~nHOST(~w) FOREIGN LIBRARIES~n', [HostArch]),
 1068    save_foreign_libraries1(HostArch, RC, Options).
 1069save_foreign_libraries(RC, _, Options) :-
 1070    option(foreign(arch(Archs)), Options),
 1071    !,
 1072    forall(member(Arch, Archs),
 1073           ( feedback('~n~w FOREIGN LIBRARIES~n', [Arch]),
 1074             save_foreign_libraries1(Arch, RC, Options)
 1075           )).
 1076save_foreign_libraries(_RC, ExeFile, Options) :-
 1077    option(foreign(copy), Options),
 1078    !,
 1079    copy_foreign_libraries(ExeFile, Options).
 1080save_foreign_libraries(_, _, _).
 1081
 1082save_foreign_libraries1(Arch, RC, _Options) :-
 1083    forall(current_foreign_library(FileSpec, _Predicates),
 1084           ( find_foreign_library(Arch, FileSpec, EntryName, File, Time),
 1085             term_to_atom(EntryName, Name),
 1086             zipper_append_file(RC, Name, File, [time(Time)])
 1087           )).
 1088
 1089%!  copy_foreign_libraries(+Exe, +Options) is det.
 1090%
 1091%   Copy all required foreign libraries   to  an installation directory.
 1092%   This is currently only implemented  for   Windows,  copying all .dll
 1093%   files to the directory where the executable is created.
 1094
 1095:- if(current_prolog_flag(windows, true)). 1096copy_foreign_libraries(ExeFile, _Options) :-
 1097    !,
 1098    file_directory_name(ExeFile, Dir),
 1099    win_process_modules(Modules),
 1100    include(prolog_dll, Modules, PrologDLLs),
 1101    maplist(copy_dll(Dir), PrologDLLs).
 1102:- endif. 1103copy_foreign_libraries(_ExeFile, _Options) :-
 1104    print_message(warning, qsave(copy_foreign_libraries)).
 1105
 1106prolog_dll(DLL) :-
 1107    file_base_name(DLL, File),
 1108    absolute_file_name(foreign(File), Abs,
 1109                       [ solutions(all) ]),
 1110	same_file(DLL, Abs),
 1111    !.
 1112
 1113copy_dll(Dest, DLL) :-
 1114    print_message(informational, copy_foreign_library(DLL, Dest)),
 1115    copy_file(DLL, Dest).
 1116
 1117
 1118%!  find_foreign_library(+Architecture, +FileSpec, -EntryName, -File, -Time)
 1119%!								is det.
 1120%
 1121%   Find  the  shared  object  specified  by   FileSpec  for  the  named
 1122%   Architecture. EntryName will be the  name   of  the  file within the
 1123%   saved state archive. If posible, the   shared  object is stripped to
 1124%   reduce its size. This  is  achieved   by  calling  =|strip  -o <tmp>
 1125%   <shared-object>|=. Note that (if stripped) the  file is a Prolog tmp
 1126%   file and will be deleted on halt.
 1127%
 1128%   @bug    Should perform OS search on failure
 1129
 1130find_foreign_library(Arch, FileSpec, shlib(Arch,Name), SharedObject, Time) :-
 1131    FileSpec = foreign(Name),
 1132    (   catch(arch_find_shlib(Arch, FileSpec, File),
 1133              E,
 1134              print_message(error, E)),
 1135        exists_file(File)
 1136    ->  true
 1137    ;   throw(error(existence_error(architecture_shlib(Arch), FileSpec),_))
 1138    ),
 1139    time_file(File, Time),
 1140    strip_file(File, SharedObject).
 1141
 1142%!  strip_file(+File, -Stripped) is det.
 1143%
 1144%   Try to strip File. Unify Stripped with   File if stripping fails for
 1145%   some reason.
 1146
 1147strip_file(File, Stripped) :-
 1148    absolute_file_name(path(strip), Strip,
 1149                       [ access(execute),
 1150                         file_errors(fail)
 1151                       ]),
 1152    tmp_file(shared, Stripped),
 1153    (   catch(do_strip_file(Strip, File, Stripped), E,
 1154              (print_message(warning, E), fail))
 1155    ->  true
 1156    ;   print_message(warning, qsave(strip_failed(File))),
 1157        fail
 1158    ),
 1159    !.
 1160strip_file(File, File).
 1161
 1162do_strip_file(Strip, File, Stripped) :-
 1163    format(atom(Cmd), '"~w" -x -o "~w" "~w"',
 1164           [Strip, Stripped, File]),
 1165    shell(Cmd),
 1166    exists_file(Stripped).
 1167
 1168%!  qsave:arch_shlib(+Architecture, +FileSpec, -File) is det.
 1169%
 1170%   This is a user defined hook called by qsave_program/2. It is used to
 1171%   find a shared library  for  the   specified  Architecture,  named by
 1172%   FileSpec. FileSpec is of  the   form  foreign(Name), a specification
 1173%   usable by absolute_file_name/2. The predicate should unify File with
 1174%   the absolute path for the  shared   library  that corresponds to the
 1175%   specified Architecture.
 1176%
 1177%   If  this  predicate  fails  to  find    a  file  for  the  specified
 1178%   architecture an `existence_error` is thrown.
 1179
 1180:- multifile arch_shlib/3. 1181
 1182arch_find_shlib(Arch, FileSpec, File) :-
 1183    arch_shlib(Arch, FileSpec, File),
 1184    !.
 1185arch_find_shlib(Arch, FileSpec, File) :-
 1186    current_prolog_flag(arch, Arch),
 1187    absolute_file_name(FileSpec,
 1188                       [ file_type(executable),
 1189                         access(read),
 1190                         file_errors(fail)
 1191                       ], File),
 1192    !.
 1193arch_find_shlib(Arch, foreign(Base), File) :-
 1194    current_prolog_flag(arch, Arch),
 1195    current_prolog_flag(windows, true),
 1196    current_prolog_flag(executable, WinExe),
 1197    prolog_to_os_filename(Exe, WinExe),
 1198    file_directory_name(Exe, BinDir),
 1199    file_name_extension(Base, dll, DllFile),
 1200    atomic_list_concat([BinDir, /, DllFile], File),
 1201    exists_file(File).
 1202
 1203
 1204                 /*******************************
 1205                 *             UTIL             *
 1206                 *******************************/
 1207
 1208open_map(Options) :-
 1209    option(map(Map), Options),
 1210    !,
 1211    open(Map, write, Fd),
 1212    asserta(verbose(Fd)).
 1213open_map(_) :-
 1214    retractall(verbose(_)).
 1215
 1216close_map :-
 1217    retract(verbose(Fd)),
 1218    close(Fd),
 1219    !.
 1220close_map.
 1221
 1222feedback(Fmt, Args) :-
 1223    verbose(Fd),
 1224    !,
 1225    format(Fd, Fmt, Args).
 1226feedback(_, _).
 1227
 1228
 1229check_options([]) :- !.
 1230check_options([Var|_]) :-
 1231    var(Var),
 1232    !,
 1233    throw(error(domain_error(save_options, Var), _)).
 1234check_options([Name=Value|T]) :-
 1235    !,
 1236    (   save_option(Name, Type, _Comment)
 1237    ->  (   must_be(Type, Value)
 1238        ->  check_options(T)
 1239        ;   throw(error(domain_error(Type, Value), _))
 1240        )
 1241    ;   throw(error(domain_error(save_option, Name), _))
 1242    ).
 1243check_options([Term|T]) :-
 1244    Term =.. [Name,Arg],
 1245    !,
 1246    check_options([Name=Arg|T]).
 1247check_options([Var|_]) :-
 1248    throw(error(domain_error(save_options, Var), _)).
 1249check_options(Opt) :-
 1250    throw(error(domain_error(list, Opt), _)).
 1251
 1252
 1253%!  zipper_append_file(+Zipper, +Name, +File, +Options) is det.
 1254%
 1255%   Append the content of File under Name to the open Zipper.
 1256
 1257zipper_append_file(_, Name, _, _) :-
 1258    saved_resource_file(Name),
 1259    !.
 1260zipper_append_file(_, _, File, _) :-
 1261    source_file(File),
 1262    !.
 1263zipper_append_file(Zipper, Name, File, Options) :-
 1264    (   option(time(_), Options)
 1265    ->  Options1 = Options
 1266    ;   time_file(File, Stamp),
 1267        Options1 = [time(Stamp)|Options]
 1268    ),
 1269    setup_call_cleanup(
 1270        open(File, read, In, [type(binary)]),
 1271        setup_call_cleanup(
 1272            zipper_open_new_file_in_zip(Zipper, Name, Out, Options1),
 1273            copy_stream_data(In, Out),
 1274            close(Out)),
 1275        close(In)),
 1276    assertz(saved_resource_file(Name)).
 1277
 1278%!  zipper_add_directory(+Zipper, +Name, +Dir, +Options) is det.
 1279%
 1280%   Add a directory entry. Dir  is  only   used  if  there  is no option
 1281%   time(Stamp).
 1282
 1283zipper_add_directory(Zipper, Name, Dir, Options) :-
 1284    (   option(time(Stamp), Options)
 1285    ->  true
 1286    ;   time_file(Dir, Stamp)
 1287    ),
 1288    atom_concat(Name, /, DirName),
 1289    (   saved_resource_file(DirName)
 1290    ->  true
 1291    ;   setup_call_cleanup(
 1292            zipper_open_new_file_in_zip(Zipper, DirName, Out,
 1293                                        [ method(store),
 1294                                          time(Stamp)
 1295                                        | Options
 1296                                        ]),
 1297            true,
 1298            close(Out)),
 1299        assertz(saved_resource_file(DirName))
 1300    ).
 1301
 1302add_parent_dirs(Zipper, Name, Dir, Options) :-
 1303    (   option(time(Stamp), Options)
 1304    ->  true
 1305    ;   time_file(Dir, Stamp)
 1306    ),
 1307    file_directory_name(Name, Parent),
 1308    (   Parent \== Name
 1309    ->  add_parent_dirs(Zipper, Parent, [time(Stamp)|Options])
 1310    ;   true
 1311    ).
 1312
 1313add_parent_dirs(_, '.', _) :-
 1314    !.
 1315add_parent_dirs(Zipper, Name, Options) :-
 1316    zipper_add_directory(Zipper, Name, _, Options),
 1317    file_directory_name(Name, Parent),
 1318    (   Parent \== Name
 1319    ->  add_parent_dirs(Zipper, Parent, Options)
 1320    ;   true
 1321    ).
 1322
 1323
 1324%!  zipper_append_directory(+Zipper, +Name, +Dir, +Options) is det.
 1325%
 1326%   Append the content of  Dir  below   Name  in  the  resource archive.
 1327%   Options:
 1328%
 1329%     - include(+Patterns)
 1330%     Only add entries that match an element from Patterns using
 1331%     wildcard_match/2.
 1332%     - exclude(+Patterns)
 1333%     Ignore entries that match an element from Patterns using
 1334%     wildcard_match/2.
 1335%
 1336%   @tbd Process .gitignore.  There also seem to exists other
 1337%   standards for this.
 1338
 1339zipper_append_directory(Zipper, Name, Dir, Options) :-
 1340    exists_directory(Dir),
 1341    !,
 1342    add_parent_dirs(Zipper, Name, Dir, Options),
 1343    zipper_add_directory(Zipper, Name, Dir, Options),
 1344    directory_files(Dir, Members),
 1345    forall(member(M, Members),
 1346           (   reserved(M)
 1347           ->  true
 1348           ;   ignored(M, Options)
 1349           ->  true
 1350           ;   atomic_list_concat([Dir,M], /, Entry),
 1351               atomic_list_concat([Name,M], /, Store),
 1352               catch(zipper_append_directory(Zipper, Store, Entry, Options),
 1353                     E,
 1354                     print_message(warning, E))
 1355           )).
 1356zipper_append_directory(Zipper, Name, File, Options) :-
 1357    zipper_append_file(Zipper, Name, File, Options).
 1358
 1359reserved(.).
 1360reserved(..).
 1361
 1362%!  ignored(+File, +Options) is semidet.
 1363%
 1364%   Ignore File if there is an  include(Patterns) option that does *not*
 1365%   match File or an exclude(Patterns) that does match File.
 1366
 1367ignored(File, Options) :-
 1368    option(include(Patterns), Options),
 1369    \+ ( (   is_list(Patterns)
 1370         ->  member(Pattern, Patterns)
 1371         ;   Pattern = Patterns
 1372         ),
 1373         glob_match(Pattern, File)
 1374       ),
 1375    !.
 1376ignored(File, Options) :-
 1377    option(exclude(Patterns), Options),
 1378    (   is_list(Patterns)
 1379    ->  member(Pattern, Patterns)
 1380    ;   Pattern = Patterns
 1381    ),
 1382    glob_match(Pattern, File),
 1383    !.
 1384
 1385glob_match(Pattern, File) :-
 1386    current_prolog_flag(file_name_case_handling, case_sensitive),
 1387    !,
 1388    wildcard_match(Pattern, File).
 1389glob_match(Pattern, File) :-
 1390    wildcard_match(Pattern, File, [case_sensitive(false)]).
 1391
 1392
 1393                /********************************
 1394                *     SAVED STATE GENERATION    *
 1395                *********************************/
 1396
 1397%!  qsave_toplevel
 1398%
 1399%   Called to handle `-c file` compilaton.
 1400
 1401:- public
 1402    qsave_toplevel/0. 1403
 1404qsave_toplevel :-
 1405    current_prolog_flag(os_argv, Argv),
 1406    qsave_options(Argv, Files, Options),
 1407    set_on_error(Options),
 1408    '$cmd_option_val'(compileout, Out),
 1409    user:consult(Files),
 1410    maybe_exit_on_errors,
 1411    qsave_program(Out, user:Options).
 1412
 1413set_on_error(Options) :-
 1414    option(on_error(_), Options), !.
 1415set_on_error(_Options) :-
 1416    set_prolog_flag(on_error, status).
 1417
 1418maybe_exit_on_errors :-
 1419    '$exit_code'(Code),
 1420    (   Code =\= 0
 1421    ->  halt
 1422    ;   true
 1423    ).
 1424
 1425qsave_options([], [], []).
 1426qsave_options([--|_], [], []) :-
 1427    !.
 1428qsave_options(['-c'|T0], Files, Options) :-
 1429    !,
 1430    argv_files(T0, T1, Files, FilesT),
 1431    qsave_options(T1, FilesT, Options).
 1432qsave_options([O|T0], Files, [Option|T]) :-
 1433    string_concat(--, Opt, O),
 1434    split_string(Opt, =, '', [NameS|Rest]),
 1435    split_string(NameS, '-', '', NameParts),
 1436    atomic_list_concat(NameParts, '_', Name),
 1437    qsave_option(Name, OptName, Rest, Value),
 1438    !,
 1439    Option =.. [OptName, Value],
 1440    qsave_options(T0, Files, T).
 1441qsave_options([_|T0], Files, T) :-
 1442    qsave_options(T0, Files, T).
 1443
 1444argv_files([], [], Files, Files).
 1445argv_files([H|T], [H|T], Files, Files) :-
 1446    sub_atom(H, 0, _, _, -),
 1447    !.
 1448argv_files([H|T0], T, [H|Files0], Files) :-
 1449    argv_files(T0, T, Files0, Files).
 1450
 1451%!  qsave_option(+Name, +ValueStrings, -Value) is semidet.
 1452
 1453qsave_option(Name, Name, [], true) :-
 1454    save_option(Name, boolean, _),
 1455    !.
 1456qsave_option(NoName, Name, [], false) :-
 1457    atom_concat('no_', Name, NoName),
 1458    save_option(Name, boolean, _),
 1459    !.
 1460qsave_option(Name, Name, ValueStrings, Value) :-
 1461    save_option(Name, Type, _),
 1462    !,
 1463    atomics_to_string(ValueStrings, "=", ValueString),
 1464    convert_option_value(Type, ValueString, Value).
 1465qsave_option(Name, Name, _Chars, _Value) :-
 1466    existence_error(save_option, Name).
 1467
 1468convert_option_value(integer, String, Value) =>
 1469    (   number_string(Value, String)
 1470    ->  true
 1471    ;   sub_string(String, 0, _, 1, SubString),
 1472        sub_string(String, _, 1, 0, Suffix0),
 1473        downcase_atom(Suffix0, Suffix),
 1474        number_string(Number, SubString),
 1475        suffix_multiplier(Suffix, Multiplier)
 1476    ->  Value is Number * Multiplier
 1477    ;   domain_error(integer, String)
 1478    ).
 1479convert_option_value(callable, String, Value) =>
 1480    term_string(Value, String).
 1481convert_option_value(atom, String, Value) =>
 1482    atom_string(Value, String).
 1483convert_option_value(boolean, String, Value) =>
 1484    atom_string(Value, String).
 1485convert_option_value(oneof(_), String, Value) =>
 1486    atom_string(Value, String).
 1487convert_option_value(ground, String, Value) =>
 1488    atom_string(Value, String).
 1489convert_option_value(qsave_foreign_option, "save", Value) =>
 1490    Value = save.
 1491convert_option_value(qsave_foreign_option, "copy", Value) =>
 1492    Value = copy.
 1493convert_option_value(qsave_foreign_option, StrArchList, arch(ArchList)) =>
 1494    split_string(StrArchList, ",", ", \t", StrArchList1),
 1495    maplist(atom_string, ArchList, StrArchList1).
 1496
 1497suffix_multiplier(b, 1).
 1498suffix_multiplier(k, 1024).
 1499suffix_multiplier(m, 1024 * 1024).
 1500suffix_multiplier(g, 1024 * 1024 * 1024).
 1501
 1502
 1503                 /*******************************
 1504                 *            MESSAGES          *
 1505                 *******************************/
 1506
 1507:- multifile prolog:message/3. 1508
 1509prolog:message(no_resource(Name, File)) -->
 1510    [ 'Could not find resource ~w on ~w or system resources'-
 1511      [Name, File] ].
 1512prolog:message(qsave(nondet)) -->
 1513    [ 'qsave_program/2 succeeded with a choice point'-[] ].
 1514prolog:message(copy_foreign_library(Lib,Dir)) -->
 1515    [ 'Copying ~w to ~w'-[Lib, Dir] ]