View source with raw comments or as raw
    1/*  Part of SWI-Prolog
    2
    3    Author:        Jan Wielemaker
    4    E-mail:        J.Wielemaker@vu.nl
    5    WWW:           http://www.swi-prolog.org
    6    Copyright (c)  1995-2022, 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]).

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 ...

*/

   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]), Term),
   66    !.
   67error:has_type(qsave_foreign_option, arch(Archs)) :-
   68    is_of_type(list(atom), Archs),
   69    !.
   70
   71save_option(stack_limit, integer,
   72            "Stack limit (bytes)").
   73save_option(goal,        callable,
   74            "Main initialization goal").
   75save_option(toplevel,    callable,
   76            "Toplevel goal").
   77save_option(init_file,   atom,
   78            "Application init file").
   79save_option(pce,         boolean,
   80            "Do (not) include the xpce graphics subsystem").
   81save_option(packs,       boolean,
   82            "Do (not) attach packs").
   83save_option(class,       oneof([runtime,development,prolog]),
   84            "Development state").
   85save_option(op,          oneof([save,standard]),
   86            "Save operators").
   87save_option(autoload,    boolean,
   88            "Resolve autoloadable predicates").
   89save_option(map,         atom,
   90            "File to report content of the state").
   91save_option(stand_alone, boolean,
   92            "Add emulator at start").
   93save_option(traditional, boolean,
   94            "Use traditional mode").
   95save_option(emulator,    ground,
   96            "Emulator to use").
   97save_option(foreign,     qsave_foreign_option,
   98            "Include foreign code in state").
   99save_option(obfuscate,   boolean,
  100            "Obfuscate identifiers").
  101save_option(verbose,     boolean,
  102            "Be more verbose about the state creation").
  103save_option(undefined,   oneof([ignore,error]),
  104            "How to handle undefined predicates").
  105save_option(on_error,    oneof([print,halt,status]),
  106            "How to handle errors").
  107save_option(on_warning,  oneof([print,halt,status]),
  108            "How to handle warnings").
  109
  110term_expansion(save_pred_options,
  111               (:- predicate_options(qsave_program/2, 2, Options))) :-
  112    findall(O,
  113            ( save_option(Name, Type, _),
  114              O =.. [Name,Type]
  115            ),
  116            Options).
  117
  118save_pred_options.
  119
  120:- set_prolog_flag(generate_debug_info, false).  121
  122:- dynamic
  123    verbose/1,
  124    saved_resource_file/1.  125:- volatile
  126    verbose/1,                  % contains a stream-handle
  127    saved_resource_file/1.
 qsave_program(+File) is det
 qsave_program(+File, :Options) is det
Make a saved state in file `File'.
  134qsave_program(File) :-
  135    qsave_program(File, []).
  136
  137qsave_program(FileBase, Options0) :-
  138    meta_options(is_meta, Options0, Options1),
  139    check_options(Options1),
  140    exe_file(FileBase, File, Options1),
  141    option(class(SaveClass), Options1, runtime),
  142    qsave_init_file_option(SaveClass, Options1, Options),
  143    prepare_entry_points(Options),
  144    save_autoload(Options),
  145    setup_call_cleanup(
  146        open_map(Options),
  147        ( prepare_state(Options),
  148          create_prolog_flag(saved_program, true, []),
  149          create_prolog_flag(saved_program_class, SaveClass, []),
  150          delete_if_exists(File),    % truncate will crash a Prolog
  151                                     % running on this state
  152          setup_call_catcher_cleanup(
  153              open(File, write, StateOut, [type(binary)]),
  154              write_state(StateOut, SaveClass, Options),
  155              Reason,
  156              finalize_state(Reason, StateOut, File))
  157        ),
  158        close_map),
  159    cleanup,
  160    !.
  161
  162write_state(StateOut, SaveClass, Options) :-
  163    make_header(StateOut, SaveClass, Options),
  164    setup_call_cleanup(
  165        zip_open_stream(StateOut, RC, []),
  166        write_zip_state(RC, SaveClass, Options),
  167        zip_close(RC, [comment('SWI-Prolog saved state')])),
  168    flush_output(StateOut).
  169
  170write_zip_state(RC, SaveClass, Options) :-
  171    save_options(RC, SaveClass, Options),
  172    save_resources(RC, SaveClass),
  173    lock_files(SaveClass),
  174    save_program(RC, SaveClass, Options),
  175    save_foreign_libraries(RC, Options).
  176
  177finalize_state(exit, StateOut, File) :-
  178    close(StateOut),
  179    '$mark_executable'(File).
  180finalize_state(!, StateOut, File) :-
  181    print_message(warning, qsave(nondet)),
  182    finalize_state(exit, StateOut, File).
  183finalize_state(_, StateOut, File) :-
  184    close(StateOut, [force(true)]),
  185    catch(delete_file(File),
  186          Error,
  187          print_message(error, Error)).
  188
  189cleanup :-
  190    retractall(saved_resource_file(_)).
  191
  192is_meta(goal).
  193is_meta(toplevel).
  194
  195exe_file(Base, Exe, Options) :-
  196    current_prolog_flag(windows, true),
  197    option(stand_alone(true), Options, true),
  198    file_name_extension(_, '', Base),
  199    !,
  200    file_name_extension(Base, exe, Exe).
  201exe_file(Exe, Exe, _).
  202
  203delete_if_exists(File) :-
  204    (   exists_file(File)
  205    ->  delete_file(File)
  206    ;   true
  207    ).
  208
  209qsave_init_file_option(runtime, Options1, Options) :-
  210    \+ option(init_file(_), Options1),
  211    !,
  212    Options = [init_file(none)|Options1].
  213qsave_init_file_option(_, Options, Options).
  214
  215
  216                 /*******************************
  217                 *           HEADER             *
  218                 *******************************/
 make_header(+Out:stream, +SaveClass, +Options) is det
  222make_header(Out, _, Options) :-
  223    stand_alone(Options),
  224    !,
  225    emulator(Emulator, Options),
  226    setup_call_cleanup(
  227        open(Emulator, read, In, [type(binary)]),
  228        copy_stream_data(In, Out),
  229        close(In)).
  230make_header(Out, SaveClass, Options) :-
  231    current_prolog_flag(unix, true),
  232    !,
  233    emulator(Emulator, Options),
  234    current_prolog_flag(posix_shell, Shell),
  235    format(Out, '#!~w~n', [Shell]),
  236    format(Out, '# SWI-Prolog saved state~n', []),
  237    (   SaveClass == runtime
  238    ->  ArgSep = ' -- '
  239    ;   ArgSep = ' '
  240    ),
  241    format(Out, 'exec ${SWIPL:-~w} -x "$0"~w"$@"~n~n', [Emulator, ArgSep]).
  242make_header(_, _, _).
  243
  244stand_alone(Options) :-
  245    (   current_prolog_flag(windows, true)
  246    ->  DefStandAlone = true
  247    ;   DefStandAlone = false
  248    ),
  249    option(stand_alone(true), Options, DefStandAlone).
  250
  251emulator(Emulator, Options) :-
  252    (   option(emulator(OptVal), Options)
  253    ->  absolute_file_name(OptVal, [access(read)], Emulator)
  254    ;   current_prolog_flag(executable, Emulator)
  255    ).
  256
  257
  258
  259                 /*******************************
  260                 *           OPTIONS            *
  261                 *******************************/
  262
  263min_stack(stack_limit, 100_000).
  264
  265convert_option(Stack, Val, NewVal, '~w') :-     % stack-sizes are in K-bytes
  266    min_stack(Stack, Min),
  267    !,
  268    (   Val == 0
  269    ->  NewVal = Val
  270    ;   NewVal is max(Min, Val)
  271    ).
  272convert_option(toplevel, Callable, Callable, '~q') :- !.
  273convert_option(_, Value, Value, '~w').
  274
  275doption(Name) :- min_stack(Name, _).
  276doption(init_file).
  277doption(system_init_file).
  278doption(class).
  279doption(home).
  280doption(nosignals).
 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.

  291save_options(RC, SaveClass, Options) :-
  292    zipper_open_new_file_in_zip(RC, '$prolog/options.txt', Fd, []),
  293    (   doption(OptionName),
  294            (   OptTerm =.. [OptionName,OptionVal2],
  295                option(OptTerm, Options)
  296            ->  convert_option(OptionName, OptionVal2, OptionVal, FmtVal)
  297            ;   '$cmd_option_val'(OptionName, OptionVal0),
  298                save_option_value(SaveClass, OptionName, OptionVal0, OptionVal1),
  299                OptionVal = OptionVal1,
  300                FmtVal = '~w'
  301            ),
  302            atomics_to_string(['~w=', FmtVal, '~n'], Fmt),
  303            format(Fd, Fmt, [OptionName, OptionVal]),
  304        fail
  305    ;   true
  306    ),
  307    save_init_goals(Fd, Options),
  308    close(Fd).
 save_option_value(+SaveClass, +OptionName, +OptionValue, -FinalValue)
  312save_option_value(Class,   class, _,     Class) :- !.
  313save_option_value(runtime, home,  _,     _) :- !, fail.
  314save_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.
  321save_init_goals(Out, Options) :-
  322    option(goal(Goal), Options),
  323    !,
  324    format(Out, 'goal=~q~n', [Goal]),
  325    save_toplevel_goal(Out, halt, Options).
  326save_init_goals(Out, Options) :-
  327    '$cmd_option_val'(goals, Goals),
  328    forall(member(Goal, Goals),
  329           format(Out, 'goal=~w~n', [Goal])),
  330    (   Goals == []
  331    ->  DefToplevel = default
  332    ;   DefToplevel = halt
  333    ),
  334    save_toplevel_goal(Out, DefToplevel, Options).
  335
  336save_toplevel_goal(Out, _Default, Options) :-
  337    option(toplevel(Goal), Options),
  338    !,
  339    unqualify_reserved_goal(Goal, Goal1),
  340    format(Out, 'toplevel=~q~n', [Goal1]).
  341save_toplevel_goal(Out, _Default, _Options) :-
  342    '$cmd_option_val'(toplevel, Toplevel),
  343    Toplevel \== default,
  344    !,
  345    format(Out, 'toplevel=~w~n', [Toplevel]).
  346save_toplevel_goal(Out, Default, _Options) :-
  347    format(Out, 'toplevel=~q~n', [Default]).
  348
  349unqualify_reserved_goal(_:prolog, prolog) :- !.
  350unqualify_reserved_goal(_:default, default) :- !.
  351unqualify_reserved_goal(Goal, Goal).
  352
  353
  354                 /*******************************
  355                 *           RESOURCES          *
  356                 *******************************/
  357
  358save_resources(_RC, development) :- !.
  359save_resources(RC, _SaveClass) :-
  360    feedback('~nRESOURCES~n~n', []),
  361    copy_resources(RC),
  362    forall(declared_resource(Name, FileSpec, Options),
  363           save_resource(RC, Name, FileSpec, Options)).
  364
  365declared_resource(RcName, FileSpec, []) :-
  366    current_predicate(_, M:resource(_,_)),
  367    M:resource(Name, FileSpec),
  368    mkrcname(M, Name, RcName).
  369declared_resource(RcName, FileSpec, Options) :-
  370    current_predicate(_, M:resource(_,_,_)),
  371    M:resource(Name, A2, A3),
  372    (   is_list(A3)
  373    ->  FileSpec = A2,
  374        Options = A3
  375    ;   FileSpec = A3
  376    ),
  377    mkrcname(M, Name, RcName).
 mkrcname(+Module, +NameSpec, -Name)
Turn a resource name term into a resource name atom.
  383mkrcname(user, Name0, Name) :-
  384    !,
  385    path_segments_to_atom(Name0, Name).
  386mkrcname(M, Name0, RcName) :-
  387    path_segments_to_atom(Name0, Name),
  388    atomic_list_concat([M, :, Name], RcName).
  389
  390path_segments_to_atom(Name0, Name) :-
  391    phrase(segments_to_atom(Name0), Atoms),
  392    atomic_list_concat(Atoms, /, Name).
  393
  394segments_to_atom(Var) -->
  395    { var(Var), !,
  396      instantiation_error(Var)
  397    }.
  398segments_to_atom(A/B) -->
  399    !,
  400    segments_to_atom(A),
  401    segments_to_atom(B).
  402segments_to_atom(A) -->
  403    [A].
 save_resource(+Zipper, +Name, +FileSpec, +Options) is det
Add the content represented by FileSpec to Zipper under Name.
  409save_resource(RC, Name, FileSpec, _Options) :-
  410    absolute_file_name(FileSpec,
  411                       [ access(read),
  412                         file_errors(fail)
  413                       ], File),
  414    !,
  415    feedback('~t~8|~w~t~32|~w~n',
  416             [Name, File]),
  417    zipper_append_file(RC, Name, File, []).
  418save_resource(RC, Name, FileSpec, Options) :-
  419    findall(Dir,
  420            absolute_file_name(FileSpec, Dir,
  421                               [ access(read),
  422                                 file_type(directory),
  423                                 file_errors(fail),
  424                                 solutions(all)
  425                               ]),
  426            Dirs),
  427    Dirs \== [],
  428    !,
  429    forall(member(Dir, Dirs),
  430           ( feedback('~t~8|~w~t~32|~w~n',
  431                      [Name, Dir]),
  432             zipper_append_directory(RC, Name, Dir, Options))).
  433save_resource(RC, Name, _, _Options) :-
  434    '$rc_handle'(SystemRC),
  435    copy_resource(SystemRC, RC, Name),
  436    !.
  437save_resource(_, Name, FileSpec, _Options) :-
  438    print_message(warning,
  439                  error(existence_error(resource,
  440                                        resource(Name, FileSpec)),
  441                        _)).
  442
  443copy_resources(ToRC) :-
  444    '$rc_handle'(FromRC),
  445    zipper_members(FromRC, List),
  446    (   member(Name, List),
  447        \+ declared_resource(Name, _, _),
  448        \+ reserved_resource(Name),
  449        copy_resource(FromRC, ToRC, Name),
  450        fail
  451    ;   true
  452    ).
  453
  454reserved_resource('$prolog/state.qlf').
  455reserved_resource('$prolog/options.txt').
  456
  457copy_resource(FromRC, ToRC, Name) :-
  458    (   zipper_goto(FromRC, file(Name))
  459    ->  true
  460    ;   existence_error(resource, Name)
  461    ),
  462    zipper_file_info(FromRC, _Name, Attrs),
  463    get_dict(time, Attrs, Time),
  464    setup_call_cleanup(
  465        zipper_open_current(FromRC, FdIn,
  466                            [ type(binary),
  467                              time(Time)
  468                            ]),
  469        setup_call_cleanup(
  470            zipper_open_new_file_in_zip(ToRC, Name, FdOut, []),
  471            ( feedback('~t~8|~w~t~24|~w~n',
  472                       [Name, '<Copied from running state>']),
  473              copy_stream_data(FdIn, FdOut)
  474            ),
  475            close(FdOut)),
  476        close(FdIn)).
  477
  478
  479		 /*******************************
  480		 *           OBFUSCATE		*
  481		 *******************************/
 create_mapping(+Options) is det
Call hook to obfuscate symbols.
  487:- multifile prolog:obfuscate_identifiers/1.  488
  489create_mapping(Options) :-
  490    option(obfuscate(true), Options),
  491    !,
  492    (   predicate_property(prolog:obfuscate_identifiers(_), number_of_clauses(N)),
  493        N > 0
  494    ->  true
  495    ;   use_module(library(obfuscate))
  496    ),
  497    (   catch(prolog:obfuscate_identifiers(Options), E,
  498              print_message(error, E))
  499    ->  true
  500    ;   print_message(warning, failed(obfuscate_identifiers))
  501    ).
  502create_mapping(_).
 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.
To be done
- system is a poor name. Maybe use resource?
  512lock_files(runtime) :-
  513    !,
  514    '$set_source_files'(system).                % implies from_state
  515lock_files(_) :-
  516    '$set_source_files'(from_state).
 save_program(+Zipper, +SaveClass, +Options) is det
Save the program itself as virtual machine code to Zipper.
  522save_program(RC, SaveClass, Options) :-
  523    setup_call_cleanup(
  524        ( zipper_open_new_file_in_zip(RC, '$prolog/state.qlf', StateFd,
  525                                      [ zip64(true)
  526                                      ]),
  527          current_prolog_flag(access_level, OldLevel),
  528          set_prolog_flag(access_level, system), % generate system modules
  529          '$open_wic'(StateFd, Options)
  530        ),
  531        ( create_mapping(Options),
  532          save_modules(SaveClass),
  533          save_records,
  534          save_flags,
  535          save_prompt,
  536          save_imports,
  537          save_prolog_flags(Options),
  538          save_operators(Options),
  539          save_format_predicates
  540        ),
  541        ( '$close_wic',
  542          set_prolog_flag(access_level, OldLevel),
  543          close(StateFd)
  544        )).
  545
  546
  547                 /*******************************
  548                 *            MODULES           *
  549                 *******************************/
  550
  551save_modules(SaveClass) :-
  552    forall(special_module(X),
  553           save_module(X, SaveClass)),
  554    forall((current_module(X), \+ special_module(X)),
  555           save_module(X, SaveClass)).
  556
  557special_module(system).
  558special_module(user).
 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.
  567prepare_entry_points(Options) :-
  568    define_init_goal(Options),
  569    define_toplevel_goal(Options).
  570
  571define_init_goal(Options) :-
  572    option(goal(Goal), Options),
  573    !,
  574    entry_point(Goal).
  575define_init_goal(_).
  576
  577define_toplevel_goal(Options) :-
  578    option(toplevel(Goal), Options),
  579    !,
  580    entry_point(Goal).
  581define_toplevel_goal(_).
  582
  583entry_point(Goal) :-
  584    define_predicate(Goal),
  585    (   \+ predicate_property(Goal, built_in),
  586        \+ predicate_property(Goal, imported_from(_))
  587    ->  goal_pi(Goal, PI),
  588        public(PI)
  589    ;   true
  590    ).
  591
  592define_predicate(Head) :-
  593    '$define_predicate'(Head),
  594    !.   % autoloader
  595define_predicate(Head) :-
  596    strip_module(Head, _, Term),
  597    functor(Term, Name, Arity),
  598    throw(error(existence_error(procedure, Name/Arity), _)).
  599
  600goal_pi(M:G, QPI) :-
  601    !,
  602    strip_module(M:G, Module, Goal),
  603    functor(Goal, Name, Arity),
  604    QPI = Module:Name/Arity.
  605goal_pi(Goal, Name/Arity) :-
  606    functor(Goal, Name, Arity).
 prepare_state(+Options) is det
Prepare the executable by running the prepare_state registered initialization hooks.
  613prepare_state(_) :-
  614    forall('$init_goal'(when(prepare_state), Goal, Ctx),
  615           run_initialize(Goal, Ctx)).
  616
  617run_initialize(Goal, Ctx) :-
  618    (   catch(Goal, E, true),
  619        (   var(E)
  620        ->  true
  621        ;   throw(error(initialization_error(E, Goal, Ctx), _))
  622        )
  623    ;   throw(error(initialization_error(failed, Goal, Ctx), _))
  624    ).
  625
  626
  627                 /*******************************
  628                 *            AUTOLOAD          *
  629                 *******************************/
 save_autoload(+Options) is det
Resolve all autoload dependencies.
Errors
- existence_error(procedures, List) if undefined(true) is in Options and there are undefined predicates.
  638save_autoload(Options) :-
  639    option(autoload(true),  Options, true),
  640    !,
  641    setup_call_cleanup(
  642        current_prolog_flag(autoload, Old),
  643        autoload_all(Options),
  644        set_prolog_flag(autoload, Old)).
  645save_autoload(_).
  646
  647
  648                 /*******************************
  649                 *             MODULES          *
  650                 *******************************/
 save_module(+Module, +SaveClass)
Saves a module
  656save_module(M, SaveClass) :-
  657    '$qlf_start_module'(M),
  658    feedback('~n~nMODULE ~w~n', [M]),
  659    save_unknown(M),
  660    (   P = (M:_H),
  661        current_predicate(_, P),
  662        \+ predicate_property(P, imported_from(_)),
  663        save_predicate(P, SaveClass),
  664        fail
  665    ;   '$qlf_end_part',
  666        feedback('~n', [])
  667    ).
  668
  669save_predicate(P, _SaveClass) :-
  670    predicate_property(P, foreign),
  671    !,
  672    P = (M:H),
  673    functor(H, Name, Arity),
  674    feedback('~npre-defining foreign ~w/~d ', [Name, Arity]),
  675    '$add_directive_wic'('$predefine_foreign'(M:Name/Arity)),
  676    save_attributes(P).
  677save_predicate(P, SaveClass) :-
  678    P = (M:H),
  679    functor(H, F, A),
  680    feedback('~nsaving ~w/~d ', [F, A]),
  681    (   (   H = resource(_,_)
  682        ;   H = resource(_,_,_)
  683        )
  684    ->  (   SaveClass == development
  685        ->  true
  686        ;   save_attribute(P, (dynamic)),
  687            (   M == user
  688            ->  save_attribute(P, (multifile))
  689            ),
  690            feedback('(Skipped clauses)', []),
  691            fail
  692        )
  693    ;   true
  694    ),
  695    (   no_save(P)
  696    ->  true
  697    ;   save_attributes(P),
  698        \+ predicate_property(P, (volatile)),
  699        (   nth_clause(P, _, Ref),
  700            feedback('.', []),
  701            '$qlf_assert_clause'(Ref, SaveClass),
  702            fail
  703        ;   true
  704        )
  705    ).
  706
  707no_save(P) :-
  708    predicate_property(P, volatile),
  709    \+ predicate_property(P, dynamic),
  710    \+ predicate_property(P, multifile).
  711
  712pred_attrib(meta_predicate(Term), Head, meta_predicate(M:Term)) :-
  713    !,
  714    strip_module(Head, M, _).
  715pred_attrib(Attrib, Head,
  716            '$set_predicate_attribute'(M:Name/Arity, AttName, Val)) :-
  717    attrib_name(Attrib, AttName, Val),
  718    strip_module(Head, M, Term),
  719    functor(Term, Name, Arity).
  720
  721attrib_name(dynamic,                dynamic,                true).
  722attrib_name(volatile,               volatile,               true).
  723attrib_name(thread_local,           thread_local,           true).
  724attrib_name(multifile,              multifile,              true).
  725attrib_name(public,                 public,                 true).
  726attrib_name(transparent,            transparent,            true).
  727attrib_name(discontiguous,          discontiguous,          true).
  728attrib_name(notrace,                trace,                  false).
  729attrib_name(show_childs,            hide_childs,            false).
  730attrib_name(built_in,               system,                 true).
  731attrib_name(nodebug,                hide_childs,            true).
  732attrib_name(quasi_quotation_syntax, quasi_quotation_syntax, true).
  733attrib_name(iso,                    iso,                    true).
  734
  735
  736save_attribute(P, Attribute) :-
  737    pred_attrib(Attribute, P, D),
  738    (   Attribute == built_in       % no need if there are clauses
  739    ->  (   predicate_property(P, number_of_clauses(0))
  740        ->  true
  741        ;   predicate_property(P, volatile)
  742        )
  743    ;   Attribute == (dynamic)      % no need if predicate is thread_local
  744    ->  \+ predicate_property(P, thread_local)
  745    ;   true
  746    ),
  747    '$add_directive_wic'(D),
  748    feedback('(~w) ', [Attribute]).
  749
  750save_attributes(P) :-
  751    (   predicate_property(P, Attribute),
  752        save_attribute(P, Attribute),
  753        fail
  754    ;   true
  755    ).
  756
  757%       Save status of the unknown flag
  758
  759save_unknown(M) :-
  760    current_prolog_flag(M:unknown, Unknown),
  761    (   Unknown == error
  762    ->  true
  763    ;   '$add_directive_wic'(set_prolog_flag(M:unknown, Unknown))
  764    ).
  765
  766                 /*******************************
  767                 *            RECORDS           *
  768                 *******************************/
  769
  770save_records :-
  771    feedback('~nRECORDS~n', []),
  772    (   current_key(X),
  773        X \== '$topvar',                        % do not safe toplevel variables
  774        feedback('~n~t~8|~w ', [X]),
  775        recorded(X, V, _),
  776        feedback('.', []),
  777        '$add_directive_wic'(recordz(X, V, _)),
  778        fail
  779    ;   true
  780    ).
  781
  782
  783                 /*******************************
  784                 *            FLAGS             *
  785                 *******************************/
  786
  787save_flags :-
  788    feedback('~nFLAGS~n~n', []),
  789    (   current_flag(X),
  790        flag(X, V, V),
  791        feedback('~t~8|~w = ~w~n', [X, V]),
  792        '$add_directive_wic'(set_flag(X, V)),
  793        fail
  794    ;   true
  795    ).
  796
  797save_prompt :-
  798    feedback('~nPROMPT~n~n', []),
  799    prompt(Prompt, Prompt),
  800    '$add_directive_wic'(prompt(_, Prompt)).
  801
  802
  803                 /*******************************
  804                 *           IMPORTS            *
  805                 *******************************/
 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.
  815save_imports :-
  816    feedback('~nIMPORTS~n~n', []),
  817    (   predicate_property(M:H, imported_from(I)),
  818        \+ default_import(M, H, I),
  819        functor(H, F, A),
  820        feedback('~t~8|~w:~w/~d <-- ~w~n', [M, F, A, I]),
  821        '$add_directive_wic'(qsave:restore_import(M, I, F/A)),
  822        fail
  823    ;   true
  824    ).
  825
  826default_import(To, Head, From) :-
  827    '$get_predicate_attribute'(To:Head, (dynamic), 1),
  828    predicate_property(From:Head, exported),
  829    !,
  830    fail.
  831default_import(Into, _, From) :-
  832    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.
  840restore_import(To, user, PI) :-
  841    !,
  842    export(user:PI),
  843    To:import(user:PI).
  844restore_import(To, From, PI) :-
  845    To:import(From:PI).
  846
  847                 /*******************************
  848                 *         PROLOG FLAGS         *
  849                 *******************************/
  850
  851save_prolog_flags(Options) :-
  852    feedback('~nPROLOG FLAGS~n~n', []),
  853    '$current_prolog_flag'(Flag, Value0, _Scope, write, Type),
  854    \+ no_save_flag(Flag),
  855    map_flag(Flag, Value0, Value, Options),
  856    feedback('~t~8|~w: ~w (type ~q)~n', [Flag, Value, Type]),
  857    '$add_directive_wic'(qsave:restore_prolog_flag(Flag, Value, Type)),
  858    fail.
  859save_prolog_flags(_).
  860
  861no_save_flag(argv).
  862no_save_flag(os_argv).
  863no_save_flag(access_level).
  864no_save_flag(tty_control).
  865no_save_flag(readline).
  866no_save_flag(associated_file).
  867no_save_flag(cpu_count).
  868no_save_flag(tmp_dir).
  869no_save_flag(file_name_case_handling).
  870no_save_flag(hwnd).                     % should be read-only, but comes
  871                                        % from user-code
  872map_flag(autoload, true, false, Options) :-
  873    option(class(runtime), Options, runtime),
  874    option(autoload(true), Options, true),
  875    !.
  876map_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).
  884restore_prolog_flag(Flag, Value, _Type) :-
  885    current_prolog_flag(Flag, Value),
  886    !.
  887restore_prolog_flag(Flag, Value, _Type) :-
  888    current_prolog_flag(Flag, _),
  889    !,
  890    catch(set_prolog_flag(Flag, Value), _, true).
  891restore_prolog_flag(Flag, Value, Type) :-
  892    create_prolog_flag(Flag, Value, [type(Type)]).
  893
  894
  895                 /*******************************
  896                 *           OPERATORS          *
  897                 *******************************/
 save_operators(+Options) is det
Save operators for all modules. Operators for system are not saved because these are read-only anyway.
  904save_operators(Options) :-
  905    !,
  906    option(op(save), Options, save),
  907    feedback('~nOPERATORS~n', []),
  908    forall(current_module(M), save_module_operators(M)),
  909    feedback('~n', []).
  910save_operators(_).
  911
  912save_module_operators(system) :- !.
  913save_module_operators(M) :-
  914    forall('$local_op'(P,T,M:N),
  915           (   feedback('~n~t~8|~w ', [op(P,T,M:N)]),
  916               '$add_directive_wic'(op(P,T,M:N))
  917           )).
  918
  919
  920                 /*******************************
  921                 *       FORMAT PREDICATES      *
  922                 *******************************/
  923
  924save_format_predicates :-
  925    feedback('~nFORMAT PREDICATES~n', []),
  926    current_format_predicate(Code, Head),
  927    qualify_head(Head, QHead),
  928    D = format_predicate(Code, QHead),
  929    feedback('~n~t~8|~w ', [D]),
  930    '$add_directive_wic'(D),
  931    fail.
  932save_format_predicates.
  933
  934qualify_head(T, T) :-
  935    functor(T, :, 2),
  936    !.
  937qualify_head(T, user:T).
  938
  939
  940                 /*******************************
  941                 *       FOREIGN LIBRARIES      *
  942                 *******************************/
 save_foreign_libraries(+Archive, +Options) is det
Save current foreign libraries into the archive.
  948save_foreign_libraries(RC, Options) :-
  949    option(foreign(save), Options),
  950    !,
  951    current_prolog_flag(arch, HostArch),
  952    feedback('~nHOST(~w) FOREIGN LIBRARIES~n', [HostArch]),
  953    save_foreign_libraries1(HostArch, RC, Options).
  954save_foreign_libraries(RC, Options) :-
  955    option(foreign(arch(Archs)), Options),
  956    !,
  957    forall(member(Arch, Archs),
  958           ( feedback('~n~w FOREIGN LIBRARIES~n', [Arch]),
  959             save_foreign_libraries1(Arch, RC, Options)
  960           )).
  961save_foreign_libraries(_, _).
  962
  963save_foreign_libraries1(Arch, RC, _Options) :-
  964    forall(current_foreign_library(FileSpec, _Predicates),
  965           ( find_foreign_library(Arch, FileSpec, EntryName, File, Time),
  966             term_to_atom(EntryName, Name),
  967             zipper_append_file(RC, Name, File, [time(Time)])
  968           )).
 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
  982find_foreign_library(Arch, FileSpec, shlib(Arch,Name), SharedObject, Time) :-
  983    FileSpec = foreign(Name),
  984    (   catch(arch_find_shlib(Arch, FileSpec, File),
  985              E,
  986              print_message(error, E)),
  987        exists_file(File)
  988    ->  true
  989    ;   throw(error(existence_error(architecture_shlib(Arch), FileSpec),_))
  990    ),
  991    time_file(File, Time),
  992    strip_file(File, SharedObject).
 strip_file(+File, -Stripped) is det
Try to strip File. Unify Stripped with File if stripping fails for some reason.
  999strip_file(File, Stripped) :-
 1000    absolute_file_name(path(strip), Strip,
 1001                       [ access(execute),
 1002                         file_errors(fail)
 1003                       ]),
 1004    tmp_file(shared, Stripped),
 1005    (   catch(do_strip_file(Strip, File, Stripped), E,
 1006              (print_message(warning, E), fail))
 1007    ->  true
 1008    ;   print_message(warning, qsave(strip_failed(File))),
 1009        fail
 1010    ),
 1011    !.
 1012strip_file(File, File).
 1013
 1014do_strip_file(Strip, File, Stripped) :-
 1015    format(atom(Cmd), '"~w" -x -o "~w" "~w"',
 1016           [Strip, Stripped, File]),
 1017    shell(Cmd),
 1018    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.

 1032:- multifile arch_shlib/3. 1033
 1034arch_find_shlib(Arch, FileSpec, File) :-
 1035    arch_shlib(Arch, FileSpec, File),
 1036    !.
 1037arch_find_shlib(Arch, FileSpec, File) :-
 1038    current_prolog_flag(arch, Arch),
 1039    absolute_file_name(FileSpec,
 1040                       [ file_type(executable),
 1041                         access(read),
 1042                         file_errors(fail)
 1043                       ], File),
 1044    !.
 1045arch_find_shlib(Arch, foreign(Base), File) :-
 1046    current_prolog_flag(arch, Arch),
 1047    current_prolog_flag(windows, true),
 1048    current_prolog_flag(executable, WinExe),
 1049    prolog_to_os_filename(Exe, WinExe),
 1050    file_directory_name(Exe, BinDir),
 1051    file_name_extension(Base, dll, DllFile),
 1052    atomic_list_concat([BinDir, /, DllFile], File),
 1053    exists_file(File).
 1054
 1055
 1056                 /*******************************
 1057                 *             UTIL             *
 1058                 *******************************/
 1059
 1060open_map(Options) :-
 1061    option(map(Map), Options),
 1062    !,
 1063    open(Map, write, Fd),
 1064    asserta(verbose(Fd)).
 1065open_map(_) :-
 1066    retractall(verbose(_)).
 1067
 1068close_map :-
 1069    retract(verbose(Fd)),
 1070    close(Fd),
 1071    !.
 1072close_map.
 1073
 1074feedback(Fmt, Args) :-
 1075    verbose(Fd),
 1076    !,
 1077    format(Fd, Fmt, Args).
 1078feedback(_, _).
 1079
 1080
 1081check_options([]) :- !.
 1082check_options([Var|_]) :-
 1083    var(Var),
 1084    !,
 1085    throw(error(domain_error(save_options, Var), _)).
 1086check_options([Name=Value|T]) :-
 1087    !,
 1088    (   save_option(Name, Type, _Comment)
 1089    ->  (   must_be(Type, Value)
 1090        ->  check_options(T)
 1091        ;   throw(error(domain_error(Type, Value), _))
 1092        )
 1093    ;   throw(error(domain_error(save_option, Name), _))
 1094    ).
 1095check_options([Term|T]) :-
 1096    Term =.. [Name,Arg],
 1097    !,
 1098    check_options([Name=Arg|T]).
 1099check_options([Var|_]) :-
 1100    throw(error(domain_error(save_options, Var), _)).
 1101check_options(Opt) :-
 1102    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.
 1109zipper_append_file(_, Name, _, _) :-
 1110    saved_resource_file(Name),
 1111    !.
 1112zipper_append_file(_, _, File, _) :-
 1113    source_file(File),
 1114    !.
 1115zipper_append_file(Zipper, Name, File, Options) :-
 1116    (   option(time(_), Options)
 1117    ->  Options1 = Options
 1118    ;   time_file(File, Stamp),
 1119        Options1 = [time(Stamp)|Options]
 1120    ),
 1121    setup_call_cleanup(
 1122        open(File, read, In, [type(binary)]),
 1123        setup_call_cleanup(
 1124            zipper_open_new_file_in_zip(Zipper, Name, Out, Options1),
 1125            copy_stream_data(In, Out),
 1126            close(Out)),
 1127        close(In)),
 1128    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).
 1135zipper_add_directory(Zipper, Name, Dir, Options) :-
 1136    (   option(time(Stamp), Options)
 1137    ->  true
 1138    ;   time_file(Dir, Stamp)
 1139    ),
 1140    atom_concat(Name, /, DirName),
 1141    (   saved_resource_file(DirName)
 1142    ->  true
 1143    ;   setup_call_cleanup(
 1144            zipper_open_new_file_in_zip(Zipper, DirName, Out,
 1145                                        [ method(store),
 1146                                          time(Stamp)
 1147                                        | Options
 1148                                        ]),
 1149            true,
 1150            close(Out)),
 1151        assertz(saved_resource_file(DirName))
 1152    ).
 1153
 1154add_parent_dirs(Zipper, Name, Dir, Options) :-
 1155    (   option(time(Stamp), Options)
 1156    ->  true
 1157    ;   time_file(Dir, Stamp)
 1158    ),
 1159    file_directory_name(Name, Parent),
 1160    (   Parent \== Name
 1161    ->  add_parent_dirs(Zipper, Parent, [time(Stamp)|Options])
 1162    ;   true
 1163    ).
 1164
 1165add_parent_dirs(_, '.', _) :-
 1166    !.
 1167add_parent_dirs(Zipper, Name, Options) :-
 1168    zipper_add_directory(Zipper, Name, _, Options),
 1169    file_directory_name(Name, Parent),
 1170    (   Parent \== Name
 1171    ->  add_parent_dirs(Zipper, Parent, Options)
 1172    ;   true
 1173    ).
 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.
To be done
- Process .gitignore. There also seem to exists other standards for this.
 1191zipper_append_directory(Zipper, Name, Dir, Options) :-
 1192    exists_directory(Dir),
 1193    !,
 1194    add_parent_dirs(Zipper, Name, Dir, Options),
 1195    zipper_add_directory(Zipper, Name, Dir, Options),
 1196    directory_files(Dir, Members),
 1197    forall(member(M, Members),
 1198           (   reserved(M)
 1199           ->  true
 1200           ;   ignored(M, Options)
 1201           ->  true
 1202           ;   atomic_list_concat([Dir,M], /, Entry),
 1203               atomic_list_concat([Name,M], /, Store),
 1204               catch(zipper_append_directory(Zipper, Store, Entry, Options),
 1205                     E,
 1206                     print_message(warning, E))
 1207           )).
 1208zipper_append_directory(Zipper, Name, File, Options) :-
 1209    zipper_append_file(Zipper, Name, File, Options).
 1210
 1211reserved(.).
 1212reserved(..).
 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.
 1219ignored(File, Options) :-
 1220    option(include(Patterns), Options),
 1221    \+ ( (   is_list(Patterns)
 1222         ->  member(Pattern, Patterns)
 1223         ;   Pattern = Patterns
 1224         ),
 1225         glob_match(Pattern, File)
 1226       ),
 1227    !.
 1228ignored(File, Options) :-
 1229    option(exclude(Patterns), Options),
 1230    (   is_list(Patterns)
 1231    ->  member(Pattern, Patterns)
 1232    ;   Pattern = Patterns
 1233    ),
 1234    glob_match(Pattern, File),
 1235    !.
 1236
 1237glob_match(Pattern, File) :-
 1238    current_prolog_flag(file_name_case_handling, case_sensitive),
 1239    !,
 1240    wildcard_match(Pattern, File).
 1241glob_match(Pattern, File) :-
 1242    wildcard_match(Pattern, File, [case_sensitive(false)]).
 1243
 1244
 1245                /********************************
 1246                *     SAVED STATE GENERATION    *
 1247                *********************************/
 qsave_toplevel
Called to handle `-c file` compilaton.
 1253:- public
 1254    qsave_toplevel/0. 1255
 1256qsave_toplevel :-
 1257    current_prolog_flag(os_argv, Argv),
 1258    qsave_options(Argv, Files, Options),
 1259    set_on_error(Options),
 1260    '$cmd_option_val'(compileout, Out),
 1261    user:consult(Files),
 1262    maybe_exit_on_errors,
 1263    qsave_program(Out, user:Options).
 1264
 1265set_on_error(Options) :-
 1266    option(on_error(_), Options), !.
 1267set_on_error(_Options) :-
 1268    set_prolog_flag(on_error, status).
 1269
 1270maybe_exit_on_errors :-
 1271    '$exit_code'(Code),
 1272    (   Code =\= 0
 1273    ->  halt
 1274    ;   true
 1275    ).
 1276
 1277qsave_options([], [], []).
 1278qsave_options([--|_], [], []) :-
 1279    !.
 1280qsave_options(['-c'|T0], Files, Options) :-
 1281    !,
 1282    argv_files(T0, T1, Files, FilesT),
 1283    qsave_options(T1, FilesT, Options).
 1284qsave_options([O|T0], Files, [Option|T]) :-
 1285    string_concat(--, Opt, O),
 1286    split_string(Opt, =, '', [NameS|Rest]),
 1287    split_string(NameS, '-', '', NameParts),
 1288    atomic_list_concat(NameParts, '_', Name),
 1289    qsave_option(Name, OptName, Rest, Value),
 1290    !,
 1291    Option =.. [OptName, Value],
 1292    qsave_options(T0, Files, T).
 1293qsave_options([_|T0], Files, T) :-
 1294    qsave_options(T0, Files, T).
 1295
 1296argv_files([], [], Files, Files).
 1297argv_files([H|T], [H|T], Files, Files) :-
 1298    sub_atom(H, 0, _, _, -),
 1299    !.
 1300argv_files([H|T0], T, [H|Files0], Files) :-
 1301    argv_files(T0, T, Files0, Files).
 qsave_option(+Name, +ValueStrings, -Value) is semidet
 1305qsave_option(Name, Name, [], true) :-
 1306    save_option(Name, boolean, _),
 1307    !.
 1308qsave_option(NoName, Name, [], false) :-
 1309    atom_concat('no_', Name, NoName),
 1310    save_option(Name, boolean, _),
 1311    !.
 1312qsave_option(Name, Name, ValueStrings, Value) :-
 1313    save_option(Name, Type, _),
 1314    !,
 1315    atomics_to_string(ValueStrings, "=", ValueString),
 1316    convert_option_value(Type, ValueString, Value).
 1317qsave_option(Name, Name, _Chars, _Value) :-
 1318    existence_error(save_option, Name).
 1319
 1320convert_option_value(integer, String, Value) :-
 1321    (   number_string(Value, String)
 1322    ->  true
 1323    ;   sub_string(String, 0, _, 1, SubString),
 1324        sub_string(String, _, 1, 0, Suffix0),
 1325        downcase_atom(Suffix0, Suffix),
 1326        number_string(Number, SubString),
 1327        suffix_multiplier(Suffix, Multiplier)
 1328    ->  Value is Number * Multiplier
 1329    ;   domain_error(integer, String)
 1330    ).
 1331convert_option_value(callable, String, Value) :-
 1332    term_string(Value, String).
 1333convert_option_value(atom, String, Value) :-
 1334    atom_string(Value, String).
 1335convert_option_value(boolean, String, Value) :-
 1336    atom_string(Value, String).
 1337convert_option_value(oneof(_), String, Value) :-
 1338    atom_string(Value, String).
 1339convert_option_value(ground, String, Value) :-
 1340    atom_string(Value, String).
 1341convert_option_value(qsave_foreign_option, "save", save).
 1342convert_option_value(qsave_foreign_option, StrArchList, arch(ArchList)) :-
 1343    split_string(StrArchList, ",", ", \t", StrArchList1),
 1344    maplist(atom_string, ArchList, StrArchList1).
 1345
 1346suffix_multiplier(b, 1).
 1347suffix_multiplier(k, 1024).
 1348suffix_multiplier(m, 1024 * 1024).
 1349suffix_multiplier(g, 1024 * 1024 * 1024).
 1350
 1351
 1352                 /*******************************
 1353                 *            MESSAGES          *
 1354                 *******************************/
 1355
 1356:- multifile prolog:message/3. 1357
 1358prolog:message(no_resource(Name, File)) -->
 1359    [ 'Could not find resource ~w on ~w or system resources'-
 1360      [Name, File] ].
 1361prolog:message(qsave(nondet)) -->
 1362    [ 'qsave_program/2 succeeded with a choice point'-[] ]