kibi-swipl-linux-x64-gnu 1.0.0

package/lib/swipl/library/qsave.pl

@@ -0,0 +1,1516 @@
+/*  Part of SWI-Prolog
+
+    Author:        Jan Wielemaker
+    E-mail:        J.Wielemaker@vu.nl
+    WWW:           https://www.swi-prolog.org
+    Copyright (c)  1995-2025, University of Amsterdam
+                              VU University Amsterdam
+                              CWI, Amsterdam
+                              SWI-Prolog Solutions b.v.
+    All rights reserved.
+
+    Redistribution and use in source and binary forms, with or without
+    modification, are permitted provided that the following conditions
+    are met:
+
+    1. Redistributions of source code must retain the above copyright
+       notice, this list of conditions and the following disclaimer.
+
+    2. Redistributions in binary form must reproduce the above copyright
+       notice, this list of conditions and the following disclaimer in
+       the documentation and/or other materials provided with the
+       distribution.
+
+    THIS SOFTWARE IS PROVIDED BY THE COPYRIGHT HOLDERS AND CONTRIBUTORS
+    "AS IS" AND ANY EXPRESS OR IMPLIED WARRANTIES, INCLUDING, BUT NOT
+    LIMITED TO, THE IMPLIED WARRANTIES OF MERCHANTABILITY AND FITNESS
+    FOR A PARTICULAR PURPOSE ARE DISCLAIMED. IN NO EVENT SHALL THE
+    COPYRIGHT OWNER OR CONTRIBUTORS BE LIABLE FOR ANY DIRECT, INDIRECT,
+    INCIDENTAL, SPECIAL, EXEMPLARY, OR CONSEQUENTIAL DAMAGES (INCLUDING,
+    BUT NOT LIMITED TO, PROCUREMENT OF SUBSTITUTE GOODS OR SERVICES;
+    LOSS OF USE, DATA, OR PROFITS; OR BUSINESS INTERRUPTION) HOWEVER
+    CAUSED AND ON ANY THEORY OF LIABILITY, WHETHER IN CONTRACT, STRICT
+    LIABILITY, OR TORT (INCLUDING NEGLIGENCE OR OTHERWISE) ARISING IN
+    ANY WAY OUT OF THE USE OF THIS SOFTWARE, EVEN IF ADVISED OF THE
+    POSSIBILITY OF SUCH DAMAGE.
+*/
+
+:- module(qsave,
+          [ qsave_program/1,                    % +File
+            qsave_program/2                     % +File, +Options
+          ]).
+:- use_module(library(zip)).
+:- use_module(library(lists)).
+:- use_module(library(option)).
+:- use_module(library(error)).
+:- use_module(library(apply)).
+:- autoload(library(shlib), [current_foreign_library/2]).
+:- autoload(library(prolog_autoload), [autoload_all/1]).
+
+/** <module> Save current program as a state or executable
+
+This library provides qsave_program/1  and   qsave_program/2,  which are
+also used by the commandline sequence below.
+
+  ==
+  swipl -o exe -c file.pl ...
+  ==
+*/
+
+:- meta_predicate
+    qsave_program(+, :).
+
+:- multifile error:has_type/2.
+error:has_type(qsave_foreign_option, Term) :-
+    is_of_type(oneof([save, no_save, copy]), Term),
+    !.
+error:has_type(qsave_foreign_option, arch(Archs)) :-
+    is_of_type(list(atom), Archs),
+    !.
+
+save_option(stack_limit, integer,
+            "Stack limit (bytes)").
+save_option(goal,        callable,
+            "Main initialization goal").
+save_option(toplevel,    callable,
+            "Toplevel goal").
+save_option(init_file,   atom,
+            "Application init file").
+save_option(pce,         boolean,
+            "Do (not) include the xpce graphics subsystem").
+save_option(packs,       boolean,
+            "Do (not) attach packs").
+save_option(class,       oneof([runtime,development,prolog]),
+            "Development state").
+save_option(op,          oneof([save,standard]),
+            "Save operators").
+save_option(autoload,    boolean,
+            "Resolve autoloadable predicates").
+save_option(map,         atom,
+            "File to report content of the state").
+save_option(home,        atom,
+            "Home directory to use for running SWI-Prolog").
+save_option(stand_alone, boolean,
+            "Add emulator at start").
+save_option(traditional, boolean,
+            "Use traditional mode").
+save_option(emulator,    ground,
+            "Emulator to use").
+save_option(foreign,     qsave_foreign_option,
+            "Include foreign code in state").
+save_option(obfuscate,   boolean,
+            "Obfuscate identifiers").
+save_option(verbose,     boolean,
+            "Be more verbose about the state creation").
+save_option(undefined,   oneof([ignore,error]),
+            "How to handle undefined predicates").
+save_option(on_error,    oneof([print,halt,status]),
+            "How to handle errors").
+save_option(on_warning,  oneof([print,halt,status]),
+            "How to handle warnings").
+save_option(zip,         boolean,
+            "If true, create a clean `.zip` file").
+
+term_expansion(save_pred_options,
+               (:- predicate_options(qsave_program/2, 2, Options))) :-
+    findall(O,
+            ( save_option(Name, Type, _),
+              O =.. [Name,Type]
+            ),
+            Options).
+
+save_pred_options.
+
+:- set_prolog_flag(generate_debug_info, false).
+
+:- dynamic
+    verbose/1,
+    saved_resource_file/1.
+:- volatile
+    verbose/1,                  % contains a stream-handle
+    saved_resource_file/1.
+
+%!  qsave_program(+File) is det.
+%!  qsave_program(+File, :Options) is det.
+%
+%   Make a saved state in file `File'.
+
+qsave_program(File) :-
+    qsave_program(File, []).
+
+qsave_program(FileBase, Options0) :-
+    meta_options(is_meta, Options0, Options1),
+    check_options(Options1),
+    exe_file(FileBase, File, Options1),
+    option(class(SaveClass), Options1, runtime),
+    qsave_init_file_option(SaveClass, Options1, Options),
+    prepare_entry_points(Options),
+    save_autoload(Options),
+    qsave_state(File, SaveClass, Options).
+
+qsave_state(File, SaveClass, Options) :-
+    system_specific_join(Join, Options),
+    !,
+    current_prolog_flag(pid, PID),
+    format(atom(ZipFile), '_swipl_state_~d.zip', [PID]),
+    qsave_state(ZipFile, SaveClass, [zip(true)|Options]),
+    emulator(Emulator, Options),
+    call_cleanup(
+        join_exe_and_state(Join, Emulator, ZipFile, File),
+        delete_file(ZipFile)).
+qsave_state(File, SaveClass, Options) :-
+    setup_call_cleanup(
+        open_map(Options),
+        ( prepare_state(Options),
+          create_prolog_flag(saved_program, true, []),
+          create_prolog_flag(saved_program_class, SaveClass, []),
+          delete_if_exists(File),    % truncate will crash a Prolog
+                                     % running on this state
+          setup_call_catcher_cleanup(
+              open(File, write, StateOut, [type(binary)]),
+              write_state(StateOut, SaveClass, File, Options),
+              Reason,
+              finalize_state(Reason, StateOut, File, Options))
+        ),
+        close_map),
+    cleanup.
+
+write_state(StateOut, SaveClass, ExeFile, Options) :-
+    make_header(StateOut, SaveClass, Options),
+    setup_call_cleanup(
+        zip_open_stream(StateOut, RC, []),
+        write_zip_state(RC, SaveClass, ExeFile, Options),
+        zip_close(RC, [comment('SWI-Prolog saved state')])),
+    flush_output(StateOut).
+
+write_zip_state(RC, SaveClass, ExeFile, Options) :-
+    save_options(RC, SaveClass, Options),
+    save_resources(RC, SaveClass),
+    lock_files(SaveClass),
+    save_program(RC, SaveClass, Options),
+    save_foreign_libraries(RC, ExeFile, Options).
+
+%!  finalize_state(+Status, +StateStream:stream, +File:atom, +Options)
+%!                 is det.
+%
+%   Fixpu the result. Normally closes StateStream   used  to create File
+%   and makes the file executable.
+
+finalize_state(exit, StateOut, _File, Options) :-
+    option(zip(true), Options),
+    !,
+    close(StateOut).
+finalize_state(exit, StateOut, File, _Options) :-
+    close(StateOut),
+    '$mark_executable'(File).
+finalize_state(!, StateOut, File, Options) :-
+    print_message(warning, qsave(nondet)),
+    finalize_state(exit, StateOut, File, Options).
+finalize_state(_, StateOut, File, _Options) :-
+    close(StateOut, [force(true)]),
+    catch(delete_file(File),
+          Error,
+          print_message(error, Error)).
+
+cleanup :-
+    retractall(saved_resource_file(_)).
+
+is_meta(goal).
+is_meta(toplevel).
+
+%!  exe_file(+Base, -Exe, +Options) is det.
+%
+%   True when Exe is the name of the  file we create. This adds ``.exe``
+%   to the given name on Windows.
+
+exe_file(Base, Exe, Options) :-
+    current_prolog_flag(windows, true),
+    option(stand_alone(true), Options, true),
+    file_name_extension(_, '', Base),
+    !,
+    file_name_extension(Base, exe, Exe).
+exe_file(Base, Exe, Options) :-
+    option(zip(true), Options),
+    file_name_extension(_, '', Base),
+    !,
+    file_name_extension(Base, zip, Exe).
+exe_file(Exe, Exe, _).
+
+delete_if_exists(File) :-
+    (   exists_file(File)
+    ->  delete_file(File)
+    ;   true
+    ).
+
+qsave_init_file_option(runtime, Options1, Options) :-
+    \+ option(init_file(_), Options1),
+    !,
+    Options = [init_file(none)|Options1].
+qsave_init_file_option(_, Options, Options).
+
+%!  system_specific_join(-How, +Options) is semidet.
+%
+%   Normally we create the saved state  as   a  header with the zip file
+%   containing the actual state on its back.  This is troublesome as the
+%   result looks like a normal  executable,   but  does  not satisfy the
+%   target system binary format. On some platforms  we can do better and
+%   add the state as an additional section   to the executable. This may
+%   fix issues using the executable with   tools to manage binaries such
+%   as strip(1) or gdb.
+%
+%   This predicate succeeds, indicating how to  perform the join, if the
+%   current platform supports this  feature.  After   the  zip  file  is
+%   created, join_exe_and_state/4 is called to join  the emulator to the
+%   zip file.
+
+system_specific_join(objcopy(Prog), Options) :-
+    current_prolog_flag(executable_format, elf),
+    option(stand_alone(true), Options),
+    \+ option(zip(true), Options),
+    absolute_file_name(path(objcopy), Prog,
+                       [ access(execute),
+                         file_errors(fail)
+                       ]).
+
+%!  join_exe_and_state(+How, +Emulator, +ZipFile, +Executable) is det.
+%
+%   Create Executable by combining Emulator  with ZipFile. Emulator must
+%   be a native binary.  Typically it is `swipl`.
+%
+%   Note that we use shell/1 rather than process_create/3. This would be
+%   easier, but we do not want dependencies  on foreign code that is not
+%   needed.
+
+join_exe_and_state(objcopy(Prog), Emulator, ZipFile, File) =>
+    copy_file(Emulator, File),
+    '$mark_executable'(File),
+    shell_quote(Prog, QProg),
+    shell_quote(ZipFile, QZipFile),
+    shell_quote(File, QFile),
+    format(string(Cmd),
+           '~w --add-section .zipdata=~w \c
+            --set-section-flags .zipdata=readonly,data \c
+            ~w',
+           [QProg, QZipFile, QFile]),
+    shell(Cmd).
+
+copy_file(From, To) :-
+    setup_call_cleanup(
+        open(To, write, Out, [type(binary)]),
+        setup_call_cleanup(
+            open(From, read, In, [type(binary)]),
+            copy_stream_data(In, Out),
+            close(In)),
+        close(Out)).
+
+%!  shell_quote(+Arg, -QArg) is det.
+%
+%   Quote argument against shell. Currently uses either single or double
+%   quotes and refuses names containing a single quote and a `$`. Should
+%   we ignore any name holding a quote or `$`?
+
+shell_quote(Arg, QArg) :-
+    sub_atom(Arg, _, _, _, '\''),
+    !,
+    (   (   sub_atom(Arg, _, _, _, '"')
+        ;   sub_atom(Arg, _, _, _, '$')
+        )
+    ->  domain_error(save_file, Arg)
+    ;   format(string(QArg), '"~w"', [Arg])
+    ).
+shell_quote(Arg, QArg) :-
+    format(string(QArg), '\'~w\'', [Arg]).
+
+
+                 /*******************************
+                 *           HEADER             *
+                 *******************************/
+
+%!  make_header(+Out:stream, +SaveClass, +Options) is det.
+%
+%   Write the header after which we add   the zip file. This is normally
+%   either ``swipl[.exe]`` or a shell script.
+
+make_header(_Out, _, Options) :-
+    option(zip(true), Options),
+    !.
+make_header(Out, _, Options) :-
+    stand_alone(Options),
+    !,
+    emulator(Emulator, Options),
+    setup_call_cleanup(
+        open(Emulator, read, In, [type(binary)]),
+        copy_stream_data(In, Out),
+        close(In)).
+make_header(Out, SaveClass, Options) :-
+    current_prolog_flag(unix, true),
+    !,
+    emulator(Emulator, Options),
+    current_prolog_flag(posix_shell, Shell),
+    format(Out, '#!~w~n', [Shell]),
+    format(Out, '# SWI-Prolog saved state~n', []),
+    (   SaveClass == runtime
+    ->  ArgSep = ' -- '
+    ;   ArgSep = ' '
+    ),
+    format(Out, 'exec ${SWIPL:-~w} -x "$0"~w"$@"~n~n', [Emulator, ArgSep]).
+make_header(_, _, _).
+
+stand_alone(Options) :-
+    (   current_prolog_flag(windows, true)
+    ->  DefStandAlone = true
+    ;   DefStandAlone = false
+    ),
+    option(stand_alone(true), Options, DefStandAlone).
+
+emulator(Emulator, Options) :-
+    (   option(emulator(OptVal), Options)
+    ->  absolute_file_name(OptVal, [access(read)], Emulator)
+    ;   current_prolog_flag(executable, Emulator)
+    ).
+
+
+
+                 /*******************************
+                 *           OPTIONS            *
+                 *******************************/
+
+min_stack(stack_limit, 100_000).
+
+convert_option(Stack, Val, NewVal, '~w') :-     % stack-sizes are in K-bytes
+    min_stack(Stack, Min),
+    !,
+    (   Val == 0
+    ->  NewVal = Val
+    ;   NewVal is max(Min, Val)
+    ).
+convert_option(toplevel, Callable, Callable, '~q') :- !.
+convert_option(_, Value, Value, '~w').
+
+doption(Name) :- min_stack(Name, _).
+doption(init_file).
+doption(system_init_file).
+doption(class).
+doption(home).
+doption(nosignals).
+
+%!  save_options(+ArchiveHandle, +SaveClass, +Options)
+%
+%   Save the options in the '$options'   resource. The home directory is
+%   saved for development  states  to  make   it  keep  refering  to the
+%   development home.
+%
+%   The script files (-s script) are not saved   at all. I think this is
+%   fine to avoid a save-script loading itself.
+
+save_options(RC, SaveClass, Options) :-
+    zipper_open_new_file_in_zip(RC, '$prolog/options.txt', Fd, []),
+    (   doption(OptionName),
+            (   OptTerm =.. [OptionName,OptionVal2],
+                option(OptTerm, Options)
+            ->  convert_option(OptionName, OptionVal2, OptionVal, FmtVal)
+            ;   '$cmd_option_val'(OptionName, OptionVal0),
+                save_option_value(SaveClass, OptionName, OptionVal0, OptionVal1),
+                OptionVal = OptionVal1,
+                FmtVal = '~w'
+            ),
+            atomics_to_string(['~w=', FmtVal, '~n'], Fmt),
+            format(Fd, Fmt, [OptionName, OptionVal]),
+        fail
+    ;   true
+    ),
+    save_init_goals(Fd, Options),
+    close(Fd).
+
+%!  save_option_value(+SaveClass, +OptionName, +OptionValue, -FinalValue)
+
+save_option_value(Class,   class, _,     Class) :- !.
+save_option_value(runtime, home,  _,     _) :- !, fail.
+save_option_value(_,       _,     Value, Value).
+
+%!  save_init_goals(+Stream, +Options)
+%
+%   Save initialization goals. If there  is   a  goal(Goal)  option, use
+%   that, else save the goals from '$cmd_option_val'/2.
+
+save_init_goals(Out, Options) :-
+    option(goal(Goal), Options),
+    !,
+    format(Out, 'goal=~q~n', [Goal]),
+    save_toplevel_goal(Out, halt, Options).
+save_init_goals(Out, Options) :-
+    '$cmd_option_val'(goals, Goals),
+    forall(member(Goal, Goals),
+           format(Out, 'goal=~w~n', [Goal])),
+    (   Goals == []
+    ->  DefToplevel = default
+    ;   DefToplevel = halt
+    ),
+    save_toplevel_goal(Out, DefToplevel, Options).
+
+save_toplevel_goal(Out, _Default, Options) :-
+    option(toplevel(Goal), Options),
+    !,
+    unqualify_reserved_goal(Goal, Goal1),
+    format(Out, 'toplevel=~q~n', [Goal1]).
+save_toplevel_goal(Out, _Default, _Options) :-
+    '$cmd_option_val'(toplevel, Toplevel),
+    Toplevel \== default,
+    !,
+    format(Out, 'toplevel=~w~n', [Toplevel]).
+save_toplevel_goal(Out, Default, _Options) :-
+    format(Out, 'toplevel=~q~n', [Default]).
+
+unqualify_reserved_goal(_:prolog, prolog) :- !.
+unqualify_reserved_goal(_:default, default) :- !.
+unqualify_reserved_goal(Goal, Goal).
+
+
+                 /*******************************
+                 *           RESOURCES          *
+                 *******************************/
+
+save_resources(_RC, development) :- !.
+save_resources(RC, _SaveClass) :-
+    feedback('~nRESOURCES~n~n', []),
+    copy_resources(RC),
+    forall(declared_resource(Name, FileSpec, Options),
+           save_resource(RC, Name, FileSpec, Options)).
+
+declared_resource(RcName, FileSpec, []) :-
+    current_predicate(_, M:resource(_,_)),
+    M:resource(Name, FileSpec),
+    mkrcname(M, Name, RcName).
+declared_resource(RcName, FileSpec, Options) :-
+    current_predicate(_, M:resource(_,_,_)),
+    M:resource(Name, A2, A3),
+    (   is_list(A3)
+    ->  FileSpec = A2,
+        Options = A3
+    ;   FileSpec = A3
+    ),
+    mkrcname(M, Name, RcName).
+
+%!  mkrcname(+Module, +NameSpec, -Name)
+%
+%   Turn a resource name term into a resource name atom.
+
+mkrcname(user, Name0, Name) :-
+    !,
+    path_segments_to_atom(Name0, Name).
+mkrcname(M, Name0, RcName) :-
+    path_segments_to_atom(Name0, Name),
+    atomic_list_concat([M, :, Name], RcName).
+
+path_segments_to_atom(Name0, Name) :-
+    phrase(segments_to_atom(Name0), Atoms),
+    atomic_list_concat(Atoms, /, Name).
+
+segments_to_atom(Var) -->
+    { var(Var), !,
+      instantiation_error(Var)
+    }.
+segments_to_atom(A/B) -->
+    !,
+    segments_to_atom(A),
+    segments_to_atom(B).
+segments_to_atom(A) -->
+    [A].
+
+%!  save_resource(+Zipper, +Name, +FileSpec, +Options) is det.
+%
+%   Add the content represented by FileSpec to Zipper under Name.
+
+save_resource(RC, Name, FileSpec, _Options) :-
+    absolute_file_name(FileSpec,
+                       [ access(read),
+                         file_errors(fail)
+                       ], File),
+    !,
+    feedback('~t~8|~w~t~32|~w~n',
+             [Name, File]),
+    zipper_append_file(RC, Name, File, []).
+save_resource(RC, Name, FileSpec, Options) :-
+    findall(Dir,
+            absolute_file_name(FileSpec, Dir,
+                               [ access(read),
+                                 file_type(directory),
+                                 file_errors(fail),
+                                 solutions(all)
+                               ]),
+            Dirs),
+    Dirs \== [],
+    !,
+    forall(member(Dir, Dirs),
+           ( feedback('~t~8|~w~t~32|~w~n',
+                      [Name, Dir]),
+             zipper_append_directory(RC, Name, Dir, Options))).
+save_resource(RC, Name, _, _Options) :-
+    '$rc_handle'(SystemRC),
+    copy_resource(SystemRC, RC, Name),
+    !.
+save_resource(_, Name, FileSpec, _Options) :-
+    print_message(warning,
+                  error(existence_error(resource,
+                                        resource(Name, FileSpec)),
+                        _)).
+
+copy_resources(ToRC) :-
+    '$rc_handle'(FromRC),
+    zipper_members(FromRC, List),
+    (   member(Name, List),
+        \+ declared_resource(Name, _, _),
+        \+ reserved_resource(Name),
+        copy_resource(FromRC, ToRC, Name),
+        fail
+    ;   true
+    ).
+
+reserved_resource('$prolog/state.qlf').
+reserved_resource('$prolog/options.txt').
+
+copy_resource(FromRC, ToRC, Name) :-
+    (   zipper_goto(FromRC, file(Name))
+    ->  true
+    ;   existence_error(resource, Name)
+    ),
+    zipper_file_info(FromRC, _Name, Attrs),
+    get_dict(time, Attrs, Time),
+    setup_call_cleanup(
+        zipper_open_current(FromRC, FdIn,
+                            [ type(binary),
+                              time(Time)
+                            ]),
+        setup_call_cleanup(
+            zipper_open_new_file_in_zip(ToRC, Name, FdOut, []),
+            ( feedback('~t~8|~w~t~24|~w~n',
+                       [Name, '<Copied from running state>']),
+              copy_stream_data(FdIn, FdOut)
+            ),
+            close(FdOut)),
+        close(FdIn)).
+
+
+		 /*******************************
+		 *           OBFUSCATE		*
+		 *******************************/
+
+%!  create_mapping(+Options) is det.
+%
+%   Call hook to obfuscate symbols.
+
+:- multifile prolog:obfuscate_identifiers/1.
+
+create_mapping(Options) :-
+    option(obfuscate(true), Options),
+    !,
+    (   predicate_property(prolog:obfuscate_identifiers(_), number_of_clauses(N)),
+        N > 0
+    ->  true
+    ;   use_module(library(obfuscate))
+    ),
+    (   catch(prolog:obfuscate_identifiers(Options), E,
+              print_message(error, E))
+    ->  true
+    ;   print_message(warning, failed(obfuscate_identifiers))
+    ).
+create_mapping(_).
+
+%!  lock_files(+SaveClass) is det.
+%
+%   When saving as `runtime`, lock all files  such that when running the
+%   program the system stops checking existence and modification time on
+%   the filesystem.
+%
+%   @tbd `system` is a poor name.  Maybe use `resource`?
+
+lock_files(runtime) :-
+    !,
+    '$set_source_files'(system).                % implies from_state
+lock_files(_) :-
+    '$set_source_files'(from_state).
+
+%!  save_program(+Zipper, +SaveClass, +Options) is det.
+%
+%   Save the program itself as virtual machine code to Zipper.
+
+save_program(RC, SaveClass, Options) :-
+    setup_call_cleanup(
+        ( zipper_open_new_file_in_zip(RC, '$prolog/state.qlf', StateFd,
+                                      [ zip64(true)
+                                      ]),
+          current_prolog_flag(access_level, OldLevel),
+          set_prolog_flag(access_level, system), % generate system modules
+          '$open_wic'(StateFd, Options)
+        ),
+        ( create_mapping(Options),
+          save_modules(SaveClass),
+          save_records,
+          save_flags,
+          save_prompt,
+          save_imports,
+          save_prolog_flags(Options),
+          save_operators(Options),
+          save_format_predicates
+        ),
+        ( '$close_wic',
+          set_prolog_flag(access_level, OldLevel),
+          close(StateFd)
+        )).
+
+
+                 /*******************************
+                 *            MODULES           *
+                 *******************************/
+
+save_modules(SaveClass) :-
+    forall(special_module(X),
+           save_module(X, SaveClass)),
+    forall((current_module(X), \+ special_module(X)),
+           save_module(X, SaveClass)).
+
+special_module(system).
+special_module(user).
+
+
+%!  prepare_entry_points(+Options)
+%
+%   Prepare  the  --goal=Goal  and  --toplevel=Goal  options.  Preparing
+%   implies autoloading the definition and declaring it _public_ such at
+%   it doesn't get obfuscated.
+
+prepare_entry_points(Options) :-
+    define_init_goal(Options),
+    define_toplevel_goal(Options).
+
+define_init_goal(Options) :-
+    option(goal(Goal), Options),
+    !,
+    entry_point(Goal).
+define_init_goal(_).
+
+define_toplevel_goal(Options) :-
+    option(toplevel(Goal), Options),
+    !,
+    entry_point(Goal).
+define_toplevel_goal(_).
+
+entry_point(Goal) :-
+    define_predicate(Goal),
+    (   \+ predicate_property(Goal, built_in),
+        \+ predicate_property(Goal, imported_from(_))
+    ->  goal_pi(Goal, PI),
+        public(PI)
+    ;   true
+    ).
+
+define_predicate(Head) :-
+    '$define_predicate'(Head),
+    !.   % autoloader
+define_predicate(Head) :-
+    strip_module(Head, _, Term),
+    functor(Term, Name, Arity),
+    throw(error(existence_error(procedure, Name/Arity), _)).
+
+goal_pi(M:G, QPI) :-
+    !,
+    strip_module(M:G, Module, Goal),
+    functor(Goal, Name, Arity),
+    QPI = Module:Name/Arity.
+goal_pi(Goal, Name/Arity) :-
+    functor(Goal, Name, Arity).
+
+%!  prepare_state(+Options) is det.
+%
+%   Prepare the executable by  running   the  `prepare_state` registered
+%   initialization hooks.
+
+prepare_state(_) :-
+    forall('$init_goal'(when(prepare_state), Goal, Ctx),
+           run_initialize(Goal, Ctx)).
+
+run_initialize(Goal, Ctx) :-
+    (   catch(Goal, E, true),
+        (   var(E)
+        ->  true
+        ;   throw(error(initialization_error(E, Goal, Ctx), _))
+        )
+    ;   throw(error(initialization_error(failed, Goal, Ctx), _))
+    ).
+
+
+                 /*******************************
+                 *            AUTOLOAD          *
+                 *******************************/
+
+%!  save_autoload(+Options) is det.
+%
+%   Resolve all autoload dependencies.
+%
+%   @error existence_error(procedures, List) if undefined(true) is
+%   in Options and there are undefined predicates.
+
+save_autoload(Options) :-
+    option(autoload(true),  Options, true),
+    !,
+    setup_call_cleanup(
+        current_prolog_flag(autoload, Old),
+        autoload_all(Options),
+        set_prolog_flag(autoload, Old)).
+save_autoload(_).
+
+
+                 /*******************************
+                 *             MODULES          *
+                 *******************************/
+
+%!  save_module(+Module, +SaveClass)
+%
+%   Saves a module
+
+save_module(M, SaveClass) :-
+    '$qlf_start_module'(M),
+    feedback('~n~nMODULE ~w~n', [M]),
+    save_unknown(M),
+    (   P = (M:_H),
+        current_predicate(_, P),
+        \+ predicate_property(P, imported_from(_)),
+        save_predicate(P, SaveClass),
+        fail
+    ;   '$qlf_end_part',
+        feedback('~n', [])
+    ).
+
+save_predicate(P, _SaveClass) :-
+    predicate_property(P, foreign),
+    !,
+    P = (M:H),
+    functor(H, Name, Arity),
+    feedback('~npre-defining foreign ~w/~d ', [Name, Arity]),
+    '$add_directive_wic'('$predefine_foreign'(M:Name/Arity)),
+    save_attributes(P).
+save_predicate(P, SaveClass) :-
+    P = (M:H),
+    functor(H, F, A),
+    feedback('~nsaving ~w/~d ', [F, A]),
+    (   (   H = resource(_,_)
+        ;   H = resource(_,_,_)
+        )
+    ->  (   SaveClass == development
+        ->  true
+        ;   save_attribute(P, (dynamic)),
+            (   M == user
+            ->  save_attribute(P, (multifile))
+            ),
+            feedback('(Skipped clauses)', []),
+            fail
+        )
+    ;   true
+    ),
+    (   no_save(P)
+    ->  true
+    ;   save_attributes(P),
+        \+ predicate_property(P, (volatile)),
+        (   nth_clause(P, _, Ref),
+            feedback('.', []),
+            '$qlf_assert_clause'(Ref, SaveClass),
+            fail
+        ;   true
+        )
+    ).
+
+no_save(P) :-
+    predicate_property(P, volatile),
+    \+ predicate_property(P, dynamic),
+    \+ predicate_property(P, multifile).
+
+pred_attrib(meta_predicate(Term), Head, meta_predicate(M:Term)) :-
+    !,
+    strip_module(Head, M, _).
+pred_attrib(Attrib, Head,
+            '$set_predicate_attribute'(M:Name/Arity, AttName, Val)) :-
+    attrib_name(Attrib, AttName, Val),
+    strip_module(Head, M, Term),
+    functor(Term, Name, Arity).
+
+attrib_name(dynamic,                dynamic,                true).
+attrib_name(incremental,            incremental,            true).
+attrib_name(volatile,               volatile,               true).
+attrib_name(thread_local,           thread_local,           true).
+attrib_name(multifile,              multifile,              true).
+attrib_name(public,                 public,                 true).
+attrib_name(transparent,            transparent,            true).
+attrib_name(discontiguous,          discontiguous,          true).
+attrib_name(notrace,                trace,                  false).
+attrib_name(show_childs,            hide_childs,            false).
+attrib_name(built_in,               system,                 true).
+attrib_name(nodebug,                hide_childs,            true).
+attrib_name(quasi_quotation_syntax, quasi_quotation_syntax, true).
+attrib_name(iso,                    iso,                    true).
+
+
+save_attribute(P, Attribute) :-
+    pred_attrib(Attribute, P, D),
+    (   Attribute == built_in       % no need if there are clauses
+    ->  (   predicate_property(P, number_of_clauses(0))
+        ->  true
+        ;   predicate_property(P, volatile)
+        )
+    ;   Attribute == (dynamic)      % no need if predicate is thread_local
+    ->  \+ predicate_property(P, thread_local)
+    ;   true
+    ),
+    '$add_directive_wic'(D),
+    feedback('(~w) ', [Attribute]).
+
+save_attributes(P) :-
+    (   predicate_property(P, Attribute),
+        save_attribute(P, Attribute),
+        fail
+    ;   true
+    ).
+
+%       Save status of the unknown flag
+
+save_unknown(M) :-
+    current_prolog_flag(M:unknown, Unknown),
+    (   Unknown == error
+    ->  true
+    ;   '$add_directive_wic'(set_prolog_flag(M:unknown, Unknown))
+    ).
+
+                 /*******************************
+                 *            RECORDS           *
+                 *******************************/
+
+save_records :-
+    feedback('~nRECORDS~n', []),
+    (   current_key(X),
+        X \== '$topvar',                        % do not safe toplevel variables
+        feedback('~n~t~8|~w ', [X]),
+        recorded(X, V, _),
+        feedback('.', []),
+        '$add_directive_wic'(recordz(X, V, _)),
+        fail
+    ;   true
+    ).
+
+
+                 /*******************************
+                 *            FLAGS             *
+                 *******************************/
+
+save_flags :-
+    feedback('~nFLAGS~n~n', []),
+    (   current_flag(X),
+        flag(X, V, V),
+        feedback('~t~8|~w = ~w~n', [X, V]),
+        '$add_directive_wic'(set_flag(X, V)),
+        fail
+    ;   true
+    ).
+
+save_prompt :-
+    feedback('~nPROMPT~n~n', []),
+    prompt(Prompt, Prompt),
+    '$add_directive_wic'(prompt(_, Prompt)).
+
+
+                 /*******************************
+                 *           IMPORTS            *
+                 *******************************/
+
+%!  save_imports
+%
+%   Save  import  relations.  An  import  relation  is  saved  if  a
+%   predicate is imported from a module that is not a default module
+%   for the destination module. If  the   predicate  is  dynamic, we
+%   always define the explicit import relation to make clear that an
+%   assert must assert on the imported predicate.
+
+save_imports :-
+    feedback('~nIMPORTS~n~n', []),
+    (   predicate_property(M:H, imported_from(I)),
+        \+ default_import(M, H, I),
+        functor(H, F, A),
+        feedback('~t~8|~w:~w/~d <-- ~w~n', [M, F, A, I]),
+        '$add_directive_wic'(qsave:restore_import(M, I, F/A)),
+        fail
+    ;   true
+    ).
+
+default_import(To, Head, From) :-
+    '$get_predicate_attribute'(To:Head, (dynamic), 1),
+    predicate_property(From:Head, exported),
+    !,
+    fail.
+default_import(Into, _, From) :-
+    default_module(Into, From).
+
+%!  restore_import(+TargetModule, +SourceModule, +PI) is det.
+%
+%   Restore import relation. This notably   deals  with imports from
+%   the module =user=, avoiding a message  that the predicate is not
+%   exported.
+
+restore_import(To, user, PI) :-
+    !,
+    export(user:PI),
+    To:import(user:PI).
+restore_import(To, From, PI) :-
+    To:import(From:PI).
+
+                 /*******************************
+                 *         PROLOG FLAGS         *
+                 *******************************/
+
+save_prolog_flags(Options) :-
+    feedback('~nPROLOG FLAGS~n~n', []),
+    '$current_prolog_flag'(Flag, Value0, _Scope, write, Type),
+    \+ no_save_flag(Flag),
+    map_flag(Flag, Value0, Value, Options),
+    feedback('~t~8|~w: ~w (type ~q)~n', [Flag, Value, Type]),
+    '$add_directive_wic'(qsave:restore_prolog_flag(Flag, Value, Type)),
+    fail.
+save_prolog_flags(_).
+
+no_save_flag(argv).
+no_save_flag(os_argv).
+no_save_flag(access_level).
+no_save_flag(tty_control).
+no_save_flag(readline).
+no_save_flag(associated_file).
+no_save_flag(cpu_count).
+no_save_flag(tmp_dir).
+no_save_flag(file_name_case_handling).
+no_save_flag(hwnd).                     % should be read-only, but comes
+                                        % from user-code
+map_flag(autoload, true, false, Options) :-
+    option(class(runtime), Options, runtime),
+    option(autoload(true), Options, true),
+    !.
+map_flag(_, Value, Value, _).
+
+
+%!  restore_prolog_flag(+Name, +Value, +Type)
+%
+%   Deal  with  possibly   protected    flags   (debug_on_error  and
+%   report_error are protected flags for the runtime kernel).
+
+restore_prolog_flag(Flag, Value, _Type) :-
+    current_prolog_flag(Flag, Value),
+    !.
+restore_prolog_flag(Flag, Value, _Type) :-
+    current_prolog_flag(Flag, _),
+    !,
+    catch(set_prolog_flag(Flag, Value), _, true).
+restore_prolog_flag(Flag, Value, Type) :-
+    create_prolog_flag(Flag, Value, [type(Type)]).
+
+
+                 /*******************************
+                 *           OPERATORS          *
+                 *******************************/
+
+%!  save_operators(+Options) is det.
+%
+%   Save operators for all modules.   Operators for =system= are
+%   not saved because these are read-only anyway.
+
+save_operators(Options) :-
+    !,
+    option(op(save), Options, save),
+    feedback('~nOPERATORS~n', []),
+    forall(current_module(M), save_module_operators(M)),
+    feedback('~n', []).
+save_operators(_).
+
+save_module_operators(system) :- !.
+save_module_operators(M) :-
+    forall('$local_op'(P,T,M:N),
+           (   feedback('~n~t~8|~w ', [op(P,T,M:N)]),
+               '$add_directive_wic'(op(P,T,M:N))
+           )).
+
+
+                 /*******************************
+                 *       FORMAT PREDICATES      *
+                 *******************************/
+
+save_format_predicates :-
+    feedback('~nFORMAT PREDICATES~n', []),
+    current_format_predicate(Code, Head),
+    qualify_head(Head, QHead),
+    D = format_predicate(Code, QHead),
+    feedback('~n~t~8|~w ', [D]),
+    '$add_directive_wic'(D),
+    fail.
+save_format_predicates.
+
+qualify_head(T, T) :-
+    functor(T, :, 2),
+    !.
+qualify_head(T, user:T).
+
+
+                 /*******************************
+                 *       FOREIGN LIBRARIES      *
+                 *******************************/
+
+%!  save_foreign_libraries(+Archive, +ExeFile, +Options) is det.
+%
+%   Save current foreign libraries into the archive.
+
+save_foreign_libraries(RC, _, Options) :-
+    option(foreign(save), Options),
+    !,
+    current_prolog_flag(arch, HostArch),
+    feedback('~nHOST(~w) FOREIGN LIBRARIES~n', [HostArch]),
+    save_foreign_libraries1(HostArch, RC, Options).
+save_foreign_libraries(RC, _, Options) :-
+    option(foreign(arch(Archs)), Options),
+    !,
+    forall(member(Arch, Archs),
+           ( feedback('~n~w FOREIGN LIBRARIES~n', [Arch]),
+             save_foreign_libraries1(Arch, RC, Options)
+           )).
+save_foreign_libraries(_RC, ExeFile, Options) :-
+    option(foreign(copy), Options),
+    !,
+    copy_foreign_libraries(ExeFile, Options).
+save_foreign_libraries(_, _, _).
+
+save_foreign_libraries1(Arch, RC, _Options) :-
+    forall(current_foreign_library(FileSpec, _Predicates),
+           ( find_foreign_library(Arch, FileSpec, EntryName, File, Time),
+             term_to_atom(EntryName, Name),
+             zipper_append_file(RC, Name, File, [time(Time)])
+           )).
+
+%!  copy_foreign_libraries(+Exe, +Options) is det.
+%
+%   Copy all required foreign libraries   to  an installation directory.
+%   This is currently only implemented  for   Windows,  copying all .dll
+%   files to the directory where the executable is created.
+
+:- if(current_prolog_flag(windows, true)).
+copy_foreign_libraries(ExeFile, _Options) :-
+    !,
+    file_directory_name(ExeFile, Dir),
+    win_process_modules(Modules),
+    include(prolog_dll, Modules, PrologDLLs),
+    maplist(copy_dll(Dir), PrologDLLs).
+:- endif.
+copy_foreign_libraries(_ExeFile, _Options) :-
+    print_message(warning, qsave(copy_foreign_libraries)).
+
+prolog_dll(DLL) :-
+    file_base_name(DLL, File),
+    absolute_file_name(foreign(File), Abs,
+                       [ solutions(all) ]),
+	same_file(DLL, Abs),
+    !.
+
+copy_dll(Dest, DLL) :-
+    print_message(informational, copy_foreign_library(DLL, Dest)),
+    copy_file(DLL, Dest).
+
+
+%!  find_foreign_library(+Architecture, +FileSpec, -EntryName, -File, -Time)
+%!								is det.
+%
+%   Find  the  shared  object  specified  by   FileSpec  for  the  named
+%   Architecture. EntryName will be the  name   of  the  file within the
+%   saved state archive. If posible, the   shared  object is stripped to
+%   reduce its size. This  is  achieved   by  calling  =|strip  -o <tmp>
+%   <shared-object>|=. Note that (if stripped) the  file is a Prolog tmp
+%   file and will be deleted on halt.
+%
+%   @bug    Should perform OS search on failure
+
+find_foreign_library(Arch, FileSpec, shlib(Arch,Name), SharedObject, Time) :-
+    FileSpec = foreign(Name),
+    (   catch(arch_find_shlib(Arch, FileSpec, File),
+              E,
+              print_message(error, E)),
+        exists_file(File)
+    ->  true
+    ;   throw(error(existence_error(architecture_shlib(Arch), FileSpec),_))
+    ),
+    time_file(File, Time),
+    strip_file(File, SharedObject).
+
+%!  strip_file(+File, -Stripped) is det.
+%
+%   Try to strip File. Unify Stripped with   File if stripping fails for
+%   some reason.
+
+strip_file(File, Stripped) :-
+    absolute_file_name(path(strip), Strip,
+                       [ access(execute),
+                         file_errors(fail)
+                       ]),
+    tmp_file(shared, Stripped),
+    (   catch(do_strip_file(Strip, File, Stripped), E,
+              (print_message(warning, E), fail))
+    ->  true
+    ;   print_message(warning, qsave(strip_failed(File))),
+        fail
+    ),
+    !.
+strip_file(File, File).
+
+do_strip_file(Strip, File, Stripped) :-
+    format(atom(Cmd), '"~w" -x -o "~w" "~w"',
+           [Strip, Stripped, File]),
+    shell(Cmd),
+    exists_file(Stripped).
+
+%!  qsave:arch_shlib(+Architecture, +FileSpec, -File) is det.
+%
+%   This is a user defined hook called by qsave_program/2. It is used to
+%   find a shared library  for  the   specified  Architecture,  named by
+%   FileSpec. FileSpec is of  the   form  foreign(Name), a specification
+%   usable by absolute_file_name/2. The predicate should unify File with
+%   the absolute path for the  shared   library  that corresponds to the
+%   specified Architecture.
+%
+%   If  this  predicate  fails  to  find    a  file  for  the  specified
+%   architecture an `existence_error` is thrown.
+
+:- multifile arch_shlib/3.
+
+arch_find_shlib(Arch, FileSpec, File) :-
+    arch_shlib(Arch, FileSpec, File),
+    !.
+arch_find_shlib(Arch, FileSpec, File) :-
+    current_prolog_flag(arch, Arch),
+    absolute_file_name(FileSpec,
+                       [ file_type(executable),
+                         access(read),
+                         file_errors(fail)
+                       ], File),
+    !.
+arch_find_shlib(Arch, foreign(Base), File) :-
+    current_prolog_flag(arch, Arch),
+    current_prolog_flag(windows, true),
+    current_prolog_flag(executable, WinExe),
+    prolog_to_os_filename(Exe, WinExe),
+    file_directory_name(Exe, BinDir),
+    file_name_extension(Base, dll, DllFile),
+    atomic_list_concat([BinDir, /, DllFile], File),
+    exists_file(File).
+
+
+                 /*******************************
+                 *             UTIL             *
+                 *******************************/
+
+open_map(Options) :-
+    option(map(Map), Options),
+    !,
+    open(Map, write, Fd),
+    asserta(verbose(Fd)).
+open_map(_) :-
+    retractall(verbose(_)).
+
+close_map :-
+    retract(verbose(Fd)),
+    close(Fd),
+    !.
+close_map.
+
+feedback(Fmt, Args) :-
+    verbose(Fd),
+    !,
+    format(Fd, Fmt, Args).
+feedback(_, _).
+
+
+check_options([]) :- !.
+check_options([Var|_]) :-
+    var(Var),
+    !,
+    throw(error(domain_error(save_options, Var), _)).
+check_options([Name=Value|T]) :-
+    !,
+    (   save_option(Name, Type, _Comment)
+    ->  (   must_be(Type, Value)
+        ->  check_options(T)
+        ;   throw(error(domain_error(Type, Value), _))
+        )
+    ;   throw(error(domain_error(save_option, Name), _))
+    ).
+check_options([Term|T]) :-
+    Term =.. [Name,Arg],
+    !,
+    check_options([Name=Arg|T]).
+check_options([Var|_]) :-
+    throw(error(domain_error(save_options, Var), _)).
+check_options(Opt) :-
+    throw(error(domain_error(list, Opt), _)).
+
+
+%!  zipper_append_file(+Zipper, +Name, +File, +Options) is det.
+%
+%   Append the content of File under Name to the open Zipper.
+
+zipper_append_file(_, Name, _, _) :-
+    saved_resource_file(Name),
+    !.
+zipper_append_file(_, _, File, _) :-
+    source_file(File),
+    !.
+zipper_append_file(Zipper, Name, File, Options) :-
+    (   option(time(_), Options)
+    ->  Options1 = Options
+    ;   time_file(File, Stamp),
+        Options1 = [time(Stamp)|Options]
+    ),
+    setup_call_cleanup(
+        open(File, read, In, [type(binary)]),
+        setup_call_cleanup(
+            zipper_open_new_file_in_zip(Zipper, Name, Out, Options1),
+            copy_stream_data(In, Out),
+            close(Out)),
+        close(In)),
+    assertz(saved_resource_file(Name)).
+
+%!  zipper_add_directory(+Zipper, +Name, +Dir, +Options) is det.
+%
+%   Add a directory entry. Dir  is  only   used  if  there  is no option
+%   time(Stamp).
+
+zipper_add_directory(Zipper, Name, Dir, Options) :-
+    (   option(time(Stamp), Options)
+    ->  true
+    ;   time_file(Dir, Stamp)
+    ),
+    atom_concat(Name, /, DirName),
+    (   saved_resource_file(DirName)
+    ->  true
+    ;   setup_call_cleanup(
+            zipper_open_new_file_in_zip(Zipper, DirName, Out,
+                                        [ method(store),
+                                          time(Stamp)
+                                        | Options
+                                        ]),
+            true,
+            close(Out)),
+        assertz(saved_resource_file(DirName))
+    ).
+
+add_parent_dirs(Zipper, Name, Dir, Options) :-
+    (   option(time(Stamp), Options)
+    ->  true
+    ;   time_file(Dir, Stamp)
+    ),
+    file_directory_name(Name, Parent),
+    (   Parent \== Name
+    ->  add_parent_dirs(Zipper, Parent, [time(Stamp)|Options])
+    ;   true
+    ).
+
+add_parent_dirs(_, '.', _) :-
+    !.
+add_parent_dirs(Zipper, Name, Options) :-
+    zipper_add_directory(Zipper, Name, _, Options),
+    file_directory_name(Name, Parent),
+    (   Parent \== Name
+    ->  add_parent_dirs(Zipper, Parent, Options)
+    ;   true
+    ).
+
+
+%!  zipper_append_directory(+Zipper, +Name, +Dir, +Options) is det.
+%
+%   Append the content of  Dir  below   Name  in  the  resource archive.
+%   Options:
+%
+%     - include(+Patterns)
+%     Only add entries that match an element from Patterns using
+%     wildcard_match/2.
+%     - exclude(+Patterns)
+%     Ignore entries that match an element from Patterns using
+%     wildcard_match/2.
+%
+%   @tbd Process .gitignore.  There also seem to exists other
+%   standards for this.
+
+zipper_append_directory(Zipper, Name, Dir, Options) :-
+    exists_directory(Dir),
+    !,
+    add_parent_dirs(Zipper, Name, Dir, Options),
+    zipper_add_directory(Zipper, Name, Dir, Options),
+    directory_files(Dir, Members),
+    forall(member(M, Members),
+           (   reserved(M)
+           ->  true
+           ;   ignored(M, Options)
+           ->  true
+           ;   atomic_list_concat([Dir,M], /, Entry),
+               atomic_list_concat([Name,M], /, Store),
+               catch(zipper_append_directory(Zipper, Store, Entry, Options),
+                     E,
+                     print_message(warning, E))
+           )).
+zipper_append_directory(Zipper, Name, File, Options) :-
+    zipper_append_file(Zipper, Name, File, Options).
+
+reserved(.).
+reserved(..).
+
+%!  ignored(+File, +Options) is semidet.
+%
+%   Ignore File if there is an  include(Patterns) option that does *not*
+%   match File or an exclude(Patterns) that does match File.
+
+ignored(File, Options) :-
+    option(include(Patterns), Options),
+    \+ ( (   is_list(Patterns)
+         ->  member(Pattern, Patterns)
+         ;   Pattern = Patterns
+         ),
+         glob_match(Pattern, File)
+       ),
+    !.
+ignored(File, Options) :-
+    option(exclude(Patterns), Options),
+    (   is_list(Patterns)
+    ->  member(Pattern, Patterns)
+    ;   Pattern = Patterns
+    ),
+    glob_match(Pattern, File),
+    !.
+
+glob_match(Pattern, File) :-
+    current_prolog_flag(file_name_case_handling, case_sensitive),
+    !,
+    wildcard_match(Pattern, File).
+glob_match(Pattern, File) :-
+    wildcard_match(Pattern, File, [case_sensitive(false)]).
+
+
+                /********************************
+                *     SAVED STATE GENERATION    *
+                *********************************/
+
+%!  qsave_toplevel
+%
+%   Called to handle `-c file` compilaton.
+
+:- public
+    qsave_toplevel/0.
+
+qsave_toplevel :-
+    current_prolog_flag(os_argv, Argv),
+    qsave_options(Argv, Files, Options),
+    set_on_error(Options),
+    '$cmd_option_val'(compileout, Out),
+    user:consult(Files),
+    maybe_exit_on_errors,
+    qsave_program(Out, user:Options).
+
+set_on_error(Options) :-
+    option(on_error(_), Options), !.
+set_on_error(_Options) :-
+    set_prolog_flag(on_error, status).
+
+maybe_exit_on_errors :-
+    '$exit_code'(Code),
+    (   Code =\= 0
+    ->  halt
+    ;   true
+    ).
+
+qsave_options([], [], []).
+qsave_options([--|_], [], []) :-
+    !.
+qsave_options(['-c'|T0], Files, Options) :-
+    !,
+    argv_files(T0, T1, Files, FilesT),
+    qsave_options(T1, FilesT, Options).
+qsave_options([O|T0], Files, [Option|T]) :-
+    string_concat(--, Opt, O),
+    split_string(Opt, =, '', [NameS|Rest]),
+    split_string(NameS, '-', '', NameParts),
+    atomic_list_concat(NameParts, '_', Name),
+    qsave_option(Name, OptName, Rest, Value),
+    !,
+    Option =.. [OptName, Value],
+    qsave_options(T0, Files, T).
+qsave_options([_|T0], Files, T) :-
+    qsave_options(T0, Files, T).
+
+argv_files([], [], Files, Files).
+argv_files([H|T], [H|T], Files, Files) :-
+    sub_atom(H, 0, _, _, -),
+    !.
+argv_files([H|T0], T, [H|Files0], Files) :-
+    argv_files(T0, T, Files0, Files).
+
+%!  qsave_option(+Name, +ValueStrings, -Value) is semidet.
+
+qsave_option(Name, Name, [], true) :-
+    save_option(Name, boolean, _),
+    !.
+qsave_option(NoName, Name, [], false) :-
+    atom_concat('no_', Name, NoName),
+    save_option(Name, boolean, _),
+    !.
+qsave_option(Name, Name, ValueStrings, Value) :-
+    save_option(Name, Type, _),
+    !,
+    atomics_to_string(ValueStrings, "=", ValueString),
+    convert_option_value(Type, ValueString, Value).
+qsave_option(Name, Name, _Chars, _Value) :-
+    existence_error(save_option, Name).
+
+convert_option_value(integer, String, Value) =>
+    (   number_string(Value, String)
+    ->  true
+    ;   sub_string(String, 0, _, 1, SubString),
+        sub_string(String, _, 1, 0, Suffix0),
+        downcase_atom(Suffix0, Suffix),
+        number_string(Number, SubString),
+        suffix_multiplier(Suffix, Multiplier)
+    ->  Value is Number * Multiplier
+    ;   domain_error(integer, String)
+    ).
+convert_option_value(callable, String, Value) =>
+    term_string(Value, String).
+convert_option_value(atom, String, Value) =>
+    atom_string(Value, String).
+convert_option_value(boolean, String, Value) =>
+    atom_string(Value, String).
+convert_option_value(oneof(_), String, Value) =>
+    atom_string(Value, String).
+convert_option_value(ground, String, Value) =>
+    atom_string(Value, String).
+convert_option_value(qsave_foreign_option, "save", Value) =>
+    Value = save.
+convert_option_value(qsave_foreign_option, "copy", Value) =>
+    Value = copy.
+convert_option_value(qsave_foreign_option, StrArchList, arch(ArchList)) =>
+    split_string(StrArchList, ",", ", \t", StrArchList1),
+    maplist(atom_string, ArchList, StrArchList1).
+
+suffix_multiplier(b, 1).
+suffix_multiplier(k, 1024).
+suffix_multiplier(m, 1024 * 1024).
+suffix_multiplier(g, 1024 * 1024 * 1024).
+
+
+                 /*******************************
+                 *            MESSAGES          *
+                 *******************************/
+
+:- multifile prolog:message/3.
+
+prolog:message(no_resource(Name, File)) -->
+    [ 'Could not find resource ~w on ~w or system resources'-
+      [Name, File] ].
+prolog:message(qsave(nondet)) -->
+    [ 'qsave_program/2 succeeded with a choice point'-[] ].
+prolog:message(copy_foreign_library(Lib,Dir)) -->
+    [ 'Copying ~w to ~w'-[Lib, Dir] ].