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-2020, University of Amsterdam
    7                              VU University Amsterdam
    8                              CWI, Amsterdam
    9    All rights reserved.
   10
   11    Redistribution and use in source and binary forms, with or without
   12    modification, are permitted provided that the following conditions
   13    are met:
   14
   15    1. Redistributions of source code must retain the above copyright
   16       notice, this list of conditions and the following disclaimer.
   17
   18    2. Redistributions in binary form must reproduce the above copyright
   19       notice, this list of conditions and the following disclaimer in
   20       the documentation and/or other materials provided with the
   21       distribution.
   22
   23    THIS SOFTWARE IS PROVIDED BY THE COPYRIGHT HOLDERS AND CONTRIBUTORS
   24    "AS IS" AND ANY EXPRESS OR IMPLIED WARRANTIES, INCLUDING, BUT NOT
   25    LIMITED TO, THE IMPLIED WARRANTIES OF MERCHANTABILITY AND FITNESS
   26    FOR A PARTICULAR PURPOSE ARE DISCLAIMED. IN NO EVENT SHALL THE
   27    COPYRIGHT OWNER OR CONTRIBUTORS BE LIABLE FOR ANY DIRECT, INDIRECT,
   28    INCIDENTAL, SPECIAL, EXEMPLARY, OR CONSEQUENTIAL DAMAGES (INCLUDING,
   29    BUT NOT LIMITED TO, PROCUREMENT OF SUBSTITUTE GOODS OR SERVICES;
   30    LOSS OF USE, DATA, OR PROFITS; OR BUSINESS INTERRUPTION) HOWEVER
   31    CAUSED AND ON ANY THEORY OF LIABILITY, WHETHER IN CONTRACT, STRICT
   32    LIABILITY, OR TORT (INCLUDING NEGLIGENCE OR OTHERWISE) ARISING IN
   33    ANY WAY OUT OF THE USE OF THIS SOFTWARE, EVEN IF ADVISED OF THE
   34    POSSIBILITY OF SUCH DAMAGE.
   35*/
   36
   37:- module(qsave,
   38          [ qsave_program/1,                    % +File
   39            qsave_program/2                     % +File, +Options
   40          ]).   41:- use_module(library(zip)).   42:- use_module(library(lists)).   43:- use_module(library(option)).   44:- use_module(library(error)).   45:- use_module(library(apply)).

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

*/

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

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

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