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-2019, 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(lists)).   42:- use_module(library(option)).   43:- use_module(library(error)).   44:- 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 ...

*/

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

  277save_options(RC, SaveClass, Options) :-
  278    zipper_open_new_file_in_zip(RC, '$prolog/options.txt', Fd, []),
  279    (   doption(OptionName),
  280            '$cmd_option_val'(OptionName, OptionVal0),
  281            save_option_value(SaveClass, OptionName, OptionVal0, OptionVal1),
  282            OptTerm =.. [OptionName,OptionVal2],
  283            (   option(OptTerm, Options)
  284            ->  convert_option(OptionName, OptionVal2, OptionVal, FmtVal)
  285            ;   OptionVal = OptionVal1,
  286                FmtVal = '~w'
  287            ),
  288            atomics_to_string(['~w=', FmtVal, '~n'], Fmt),
  289            format(Fd, Fmt, [OptionName, OptionVal]),
  290        fail
  291    ;   true
  292    ),
  293    save_init_goals(Fd, Options),
  294    close(Fd).
 save_option_value(+SaveClass, +OptionName, +OptionValue, -FinalValue)
  298save_option_value(Class,   class, _,     Class) :- !.
  299save_option_value(runtime, home,  _,     _) :- !, fail.
  300save_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.
  307save_init_goals(Out, Options) :-
  308    option(goal(Goal), Options),
  309    !,
  310    format(Out, 'goal=~q~n', [Goal]),
  311    save_toplevel_goal(Out, halt, Options).
  312save_init_goals(Out, Options) :-
  313    '$cmd_option_val'(goals, Goals),
  314    forall(member(Goal, Goals),
  315           format(Out, 'goal=~w~n', [Goal])),
  316    (   Goals == []
  317    ->  DefToplevel = default
  318    ;   DefToplevel = halt
  319    ),
  320    save_toplevel_goal(Out, DefToplevel, Options).
  321
  322save_toplevel_goal(Out, _Default, Options) :-
  323    option(toplevel(Goal), Options),
  324    !,
  325    unqualify_reserved_goal(Goal, Goal1),
  326    format(Out, 'toplevel=~q~n', [Goal1]).
  327save_toplevel_goal(Out, _Default, _Options) :-
  328    '$cmd_option_val'(toplevel, Toplevel),
  329    Toplevel \== default,
  330    !,
  331    format(Out, 'toplevel=~w~n', [Toplevel]).
  332save_toplevel_goal(Out, Default, _Options) :-
  333    format(Out, 'toplevel=~q~n', [Default]).
  334
  335unqualify_reserved_goal(_:prolog, prolog) :- !.
  336unqualify_reserved_goal(_:default, default) :- !.
  337unqualify_reserved_goal(Goal, Goal).
  338
  339
  340                 /*******************************
  341                 *           RESOURCES          *
  342                 *******************************/
  343
  344save_resources(_RC, development) :- !.
  345save_resources(RC, _SaveClass) :-
  346    feedback('~nRESOURCES~n~n', []),
  347    copy_resources(RC),
  348    forall(declared_resource(Name, FileSpec, Options),
  349           save_resource(RC, Name, FileSpec, Options)).
  350
  351declared_resource(RcName, FileSpec, []) :-
  352    current_predicate(_, M:resource(_,_)),
  353    M:resource(Name, FileSpec),
  354    mkrcname(M, Name, RcName).
  355declared_resource(RcName, FileSpec, Options) :-
  356    current_predicate(_, M:resource(_,_,_)),
  357    M:resource(Name, A2, A3),
  358    (   is_list(A3)
  359    ->  FileSpec = A2,
  360        Options = A3
  361    ;   FileSpec = A3
  362    ),
  363    mkrcname(M, Name, RcName).
 mkrcname(+Module, +NameSpec, -Name)
Turn a resource name term into a resource name atom.
  369mkrcname(user, Name0, Name) :-
  370    !,
  371    path_segments_to_atom(Name0, Name).
  372mkrcname(M, Name0, RcName) :-
  373    path_segments_to_atom(Name0, Name),
  374    atomic_list_concat([M, :, Name], RcName).
  375
  376path_segments_to_atom(Name0, Name) :-
  377    phrase(segments_to_atom(Name0), Atoms),
  378    atomic_list_concat(Atoms, /, Name).
  379
  380segments_to_atom(Var) -->
  381    { var(Var), !,
  382      instantiation_error(Var)
  383    }.
  384segments_to_atom(A/B) -->
  385    !,
  386    segments_to_atom(A),
  387    segments_to_atom(B).
  388segments_to_atom(A) -->
  389    [A].
 save_resource(+Zipper, +Name, +FileSpec, +Options) is det
Add the content represented by FileSpec to Zipper under Name.
  395save_resource(RC, Name, FileSpec, _Options) :-
  396    absolute_file_name(FileSpec,
  397                       [ access(read),
  398                         file_errors(fail)
  399                       ], File),
  400    !,
  401    feedback('~t~8|~w~t~32|~w~n',
  402             [Name, File]),
  403    zipper_append_file(RC, Name, File, []).
  404save_resource(RC, Name, FileSpec, Options) :-
  405    findall(Dir,
  406            absolute_file_name(FileSpec, Dir,
  407                               [ access(read),
  408                                 file_type(directory),
  409                                 file_errors(fail),
  410                                 solutions(all)
  411                               ]),
  412            Dirs),
  413    Dirs \== [],
  414    !,
  415    forall(member(Dir, Dirs),
  416           ( feedback('~t~8|~w~t~32|~w~n',
  417                      [Name, Dir]),
  418             zipper_append_directory(RC, Name, Dir, Options))).
  419save_resource(RC, Name, _, _Options) :-
  420    '$rc_handle'(SystemRC),
  421    copy_resource(SystemRC, RC, Name),
  422    !.
  423save_resource(_, Name, FileSpec, _Options) :-
  424    print_message(warning,
  425                  error(existence_error(resource,
  426                                        resource(Name, FileSpec)),
  427                        _)).
  428
  429copy_resources(ToRC) :-
  430    '$rc_handle'(FromRC),
  431    zipper_members(FromRC, List),
  432    (   member(Name, List),
  433        \+ declared_resource(Name, _, _),
  434        \+ reserved_resource(Name),
  435        copy_resource(FromRC, ToRC, Name),
  436        fail
  437    ;   true
  438    ).
  439
  440reserved_resource('$prolog/state.qlf').
  441reserved_resource('$prolog/options.txt').
  442
  443copy_resource(FromRC, ToRC, Name) :-
  444    (   zipper_goto(FromRC, file(Name))
  445    ->  true
  446    ;   existence_error(resource, Name)
  447    ),
  448    zipper_file_info(FromRC, _Name, Attrs),
  449    get_dict(time, Attrs, Time),
  450    setup_call_cleanup(
  451        zipper_open_current(FromRC, FdIn,
  452                            [ type(binary),
  453                              time(Time)
  454                            ]),
  455        setup_call_cleanup(
  456            zipper_open_new_file_in_zip(ToRC, Name, FdOut, []),
  457            ( feedback('~t~8|~w~t~24|~w~n',
  458                       [Name, '<Copied from running state>']),
  459              copy_stream_data(FdIn, FdOut)
  460            ),
  461            close(FdOut)),
  462        close(FdIn)).
  463
  464
  465		 /*******************************
  466		 *           OBFUSCATE		*
  467		 *******************************/
 create_mapping(+Options) is det
Call hook to obfuscate symbols.
  473:- multifile prolog:obfuscate_identifiers/1.  474
  475create_mapping(Options) :-
  476    option(obfuscate(true), Options),
  477    !,
  478    (   predicate_property(prolog:obfuscate_identifiers(_), number_of_clauses(N)),
  479        N > 0
  480    ->  true
  481    ;   use_module(library(obfuscate))
  482    ),
  483    (   catch(prolog:obfuscate_identifiers(Options), E,
  484              print_message(error, E))
  485    ->  true
  486    ;   print_message(warning, failed(obfuscate_identifiers))
  487    ).
  488create_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?
  498lock_files(runtime) :-
  499    !,
  500    '$set_source_files'(system).                % implies from_state
  501lock_files(_) :-
  502    '$set_source_files'(from_state).
 save_program(+Zipper, +SaveClass, +Options) is det
Save the program itself as virtual machine code to Zipper.
  508save_program(RC, SaveClass, Options) :-
  509    zipper_open_new_file_in_zip(RC, '$prolog/state.qlf', StateFd, []),
  510    setup_call_cleanup(
  511        ( current_prolog_flag(access_level, OldLevel),
  512          set_prolog_flag(access_level, system), % generate system modules
  513          '$open_wic'(StateFd, Options)
  514        ),
  515        ( create_mapping(Options),
  516          save_modules(SaveClass),
  517          save_records,
  518          save_flags,
  519          save_prompt,
  520          save_imports,
  521          save_prolog_flags,
  522          save_operators(Options),
  523          save_format_predicates
  524        ),
  525        ( '$close_wic',
  526          set_prolog_flag(access_level, OldLevel)
  527        )),
  528    close(StateFd).
  529
  530
  531                 /*******************************
  532                 *            MODULES           *
  533                 *******************************/
  534
  535save_modules(SaveClass) :-
  536    forall(special_module(X),
  537           save_module(X, SaveClass)),
  538    forall((current_module(X), \+ special_module(X)),
  539           save_module(X, SaveClass)).
  540
  541special_module(system).
  542special_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.
  551prepare_entry_points(Options) :-
  552    define_init_goal(Options),
  553    define_toplevel_goal(Options).
  554
  555define_init_goal(Options) :-
  556    option(goal(Goal), Options),
  557    !,
  558    entry_point(Goal).
  559define_init_goal(_).
  560
  561define_toplevel_goal(Options) :-
  562    option(toplevel(Goal), Options),
  563    !,
  564    entry_point(Goal).
  565define_toplevel_goal(_).
  566
  567entry_point(Goal) :-
  568    define_predicate(Goal),
  569    (   \+ predicate_property(Goal, built_in),
  570        \+ predicate_property(Goal, imported_from(_))
  571    ->  goal_pi(Goal, PI),
  572        public(PI)
  573    ;   true
  574    ).
  575
  576define_predicate(Head) :-
  577    '$define_predicate'(Head),
  578    !.   % autoloader
  579define_predicate(Head) :-
  580    strip_module(Head, _, Term),
  581    functor(Term, Name, Arity),
  582    throw(error(existence_error(procedure, Name/Arity), _)).
  583
  584goal_pi(M:G, QPI) :-
  585    !,
  586    strip_module(M:G, Module, Goal),
  587    functor(Goal, Name, Arity),
  588    QPI = Module:Name/Arity.
  589goal_pi(Goal, Name/Arity) :-
  590    functor(Goal, Name, Arity).
 prepare_state(+Options) is det
Prepare the executable by running the prepare_state registered initialization hooks.
  597prepare_state(_) :-
  598    forall('$init_goal'(when(prepare_state), Goal, Ctx),
  599           run_initialize(Goal, Ctx)).
  600
  601run_initialize(Goal, Ctx) :-
  602    (   catch(Goal, E, true),
  603        (   var(E)
  604        ->  true
  605        ;   throw(error(initialization_error(E, Goal, Ctx), _))
  606        )
  607    ;   throw(error(initialization_error(failed, Goal, Ctx), _))
  608    ).
  609
  610
  611                 /*******************************
  612                 *            AUTOLOAD          *
  613                 *******************************/
 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.
  622save_autoload(Options) :-
  623    option(autoload(true),  Options, true),
  624    !,
  625    autoload(Options).
  626save_autoload(_).
  627
  628
  629                 /*******************************
  630                 *             MODULES          *
  631                 *******************************/
 save_module(+Module, +SaveClass)
Saves a module
  637save_module(M, SaveClass) :-
  638    '$qlf_start_module'(M),
  639    feedback('~n~nMODULE ~w~n', [M]),
  640    save_unknown(M),
  641    (   P = (M:_H),
  642        current_predicate(_, P),
  643        \+ predicate_property(P, imported_from(_)),
  644        save_predicate(P, SaveClass),
  645        fail
  646    ;   '$qlf_end_part',
  647        feedback('~n', [])
  648    ).
  649
  650save_predicate(P, _SaveClass) :-
  651    predicate_property(P, foreign),
  652    !,
  653    P = (M:H),
  654    functor(H, Name, Arity),
  655    feedback('~npre-defining foreign ~w/~d ', [Name, Arity]),
  656    '$add_directive_wic'('$predefine_foreign'(M:Name/Arity)).
  657save_predicate(P, SaveClass) :-
  658    P = (M:H),
  659    functor(H, F, A),
  660    feedback('~nsaving ~w/~d ', [F, A]),
  661    (   (   H = resource(_,_)
  662        ;   H = resource(_,_,_)
  663        ),
  664        SaveClass \== development
  665    ->  save_attribute(P, (dynamic)),
  666        (   M == user
  667        ->  save_attribute(P, (multifile))
  668        ),
  669        feedback('(Skipped clauses)', []),
  670        fail
  671    ;   true
  672    ),
  673    (   no_save(P)
  674    ->  true
  675    ;   save_attributes(P),
  676        \+ predicate_property(P, (volatile)),
  677        (   nth_clause(P, _, Ref),
  678            feedback('.', []),
  679            '$qlf_assert_clause'(Ref, SaveClass),
  680            fail
  681        ;   true
  682        )
  683    ).
  684
  685no_save(P) :-
  686    predicate_property(P, volatile),
  687    \+ predicate_property(P, dynamic),
  688    \+ predicate_property(P, multifile).
  689
  690pred_attrib(meta_predicate(Term), Head, meta_predicate(M:Term)) :-
  691    !,
  692    strip_module(Head, M, _).
  693pred_attrib(Attrib, Head,
  694            '$set_predicate_attribute'(M:Name/Arity, AttName, Val)) :-
  695    attrib_name(Attrib, AttName, Val),
  696    strip_module(Head, M, Term),
  697    functor(Term, Name, Arity).
  698
  699attrib_name(dynamic,                dynamic,                true).
  700attrib_name(volatile,               volatile,               true).
  701attrib_name(thread_local,           thread_local,           true).
  702attrib_name(multifile,              multifile,              true).
  703attrib_name(public,                 public,                 true).
  704attrib_name(transparent,            transparent,            true).
  705attrib_name(discontiguous,          discontiguous,          true).
  706attrib_name(notrace,                trace,                  false).
  707attrib_name(show_childs,            hide_childs,            false).
  708attrib_name(built_in,               system,                 true).
  709attrib_name(nodebug,                hide_childs,            true).
  710attrib_name(quasi_quotation_syntax, quasi_quotation_syntax, true).
  711attrib_name(iso,                    iso,                    true).
  712
  713
  714save_attribute(P, Attribute) :-
  715    pred_attrib(Attribute, P, D),
  716    (   Attribute == built_in       % no need if there are clauses
  717    ->  (   predicate_property(P, number_of_clauses(0))
  718        ->  true
  719        ;   predicate_property(P, volatile)
  720        )
  721    ;   Attribute == (dynamic)      % no need if predicate is thread_local
  722    ->  \+ predicate_property(P, thread_local)
  723    ;   true
  724    ),
  725    '$add_directive_wic'(D),
  726    feedback('(~w) ', [Attribute]).
  727
  728save_attributes(P) :-
  729    (   predicate_property(P, Attribute),
  730        save_attribute(P, Attribute),
  731        fail
  732    ;   true
  733    ).
  734
  735%       Save status of the unknown flag
  736
  737save_unknown(M) :-
  738    current_prolog_flag(M:unknown, Unknown),
  739    (   Unknown == error
  740    ->  true
  741    ;   '$add_directive_wic'(set_prolog_flag(M:unknown, Unknown))
  742    ).
  743
  744                 /*******************************
  745                 *            RECORDS           *
  746                 *******************************/
  747
  748save_records :-
  749    feedback('~nRECORDS~n', []),
  750    (   current_key(X),
  751        X \== '$topvar',                        % do not safe toplevel variables
  752        feedback('~n~t~8|~w ', [X, V]),
  753        recorded(X, V, _),
  754        feedback('.', []),
  755        '$add_directive_wic'(recordz(X, V, _)),
  756        fail
  757    ;   true
  758    ).
  759
  760
  761                 /*******************************
  762                 *            FLAGS             *
  763                 *******************************/
  764
  765save_flags :-
  766    feedback('~nFLAGS~n~n', []),
  767    (   current_flag(X),
  768        flag(X, V, V),
  769        feedback('~t~8|~w = ~w~n', [X, V]),
  770        '$add_directive_wic'(set_flag(X, V)),
  771        fail
  772    ;   true
  773    ).
  774
  775save_prompt :-
  776    feedback('~nPROMPT~n~n', []),
  777    prompt(Prompt, Prompt),
  778    '$add_directive_wic'(prompt(_, Prompt)).
  779
  780
  781                 /*******************************
  782                 *           IMPORTS            *
  783                 *******************************/
 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.
  793save_imports :-
  794    feedback('~nIMPORTS~n~n', []),
  795    (   predicate_property(M:H, imported_from(I)),
  796        \+ default_import(M, H, I),
  797        functor(H, F, A),
  798        feedback('~t~8|~w:~w/~d <-- ~w~n', [M, F, A, I]),
  799        '$add_directive_wic'(qsave:restore_import(M, I, F/A)),
  800        fail
  801    ;   true
  802    ).
  803
  804default_import(To, Head, From) :-
  805    '$get_predicate_attribute'(To:Head, (dynamic), 1),
  806    predicate_property(From:Head, exported),
  807    !,
  808    fail.
  809default_import(Into, _, From) :-
  810    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.
  818restore_import(To, user, PI) :-
  819    !,
  820    export(user:PI),
  821    To:import(user:PI).
  822restore_import(To, From, PI) :-
  823    To:import(From:PI).
  824
  825                 /*******************************
  826                 *         PROLOG FLAGS         *
  827                 *******************************/
  828
  829save_prolog_flags :-
  830    feedback('~nPROLOG FLAGS~n~n', []),
  831    '$current_prolog_flag'(Flag, Value, _Scope, write, Type),
  832    \+ no_save_flag(Flag),
  833    feedback('~t~8|~w: ~w (type ~q)~n', [Flag, Value, Type]),
  834    '$add_directive_wic'(qsave:restore_prolog_flag(Flag, Value, Type)),
  835    fail.
  836save_prolog_flags.
  837
  838no_save_flag(argv).
  839no_save_flag(os_argv).
  840no_save_flag(access_level).
  841no_save_flag(tty_control).
  842no_save_flag(readline).
  843no_save_flag(associated_file).
  844no_save_flag(cpu_count).
  845no_save_flag(hwnd).                     % should be read-only, but comes
  846                                        % from user-code
 restore_prolog_flag(+Name, +Value, +Type)
Deal with possibly protected flags (debug_on_error and report_error are protected flags for the runtime kernel).
  853restore_prolog_flag(Flag, Value, _Type) :-
  854    current_prolog_flag(Flag, Value),
  855    !.
  856restore_prolog_flag(Flag, Value, _Type) :-
  857    current_prolog_flag(Flag, _),
  858    !,
  859    catch(set_prolog_flag(Flag, Value), _, true).
  860restore_prolog_flag(Flag, Value, Type) :-
  861    create_prolog_flag(Flag, Value, [type(Type)]).
  862
  863
  864                 /*******************************
  865                 *           OPERATORS          *
  866                 *******************************/
 save_operators(+Options) is det
Save operators for all modules. Operators for system are not saved because these are read-only anyway.
  873save_operators(Options) :-
  874    !,
  875    option(op(save), Options, save),
  876    feedback('~nOPERATORS~n', []),
  877    forall(current_module(M), save_module_operators(M)),
  878    feedback('~n', []).
  879save_operators(_).
  880
  881save_module_operators(system) :- !.
  882save_module_operators(M) :-
  883    forall('$local_op'(P,T,M:N),
  884           (   feedback('~n~t~8|~w ', [op(P,T,M:N)]),
  885               '$add_directive_wic'(op(P,T,M:N))
  886           )).
  887
  888
  889                 /*******************************
  890                 *       FORMAT PREDICATES      *
  891                 *******************************/
  892
  893save_format_predicates :-
  894    feedback('~nFORMAT PREDICATES~n', []),
  895    current_format_predicate(Code, Head),
  896    qualify_head(Head, QHead),
  897    D = format_predicate(Code, QHead),
  898    feedback('~n~t~8|~w ', [D]),
  899    '$add_directive_wic'(D),
  900    fail.
  901save_format_predicates.
  902
  903qualify_head(T, T) :-
  904    functor(T, :, 2),
  905    !.
  906qualify_head(T, user:T).
  907
  908
  909                 /*******************************
  910                 *       FOREIGN LIBRARIES      *
  911                 *******************************/
 save_foreign_libraries(+Archive, +Options) is det
Save current foreign libraries into the archive.
  917save_foreign_libraries(RC, Options) :-
  918    option(foreign(save), Options),
  919    !,
  920    current_prolog_flag(arch, HostArch),
  921    feedback('~nHOST(~w) FOREIGN LIBRARIES~n', [HostArch]),
  922    save_foreign_libraries1(HostArch, RC, Options).
  923save_foreign_libraries(RC, Options) :-
  924    option(foreign(arch(Archs)), Options),
  925    !,
  926    forall(member(Arch, Archs),
  927           ( feedback('~n~w FOREIGN LIBRARIES~n', [Arch]),
  928             save_foreign_libraries1(Arch, RC, Options)
  929           )).
  930save_foreign_libraries(_, _).
  931
  932save_foreign_libraries1(Arch, RC, _Options) :-
  933    forall(current_foreign_library(FileSpec, _Predicates),
  934           ( find_foreign_library(Arch, FileSpec, EntryName, File, Time),
  935             term_to_atom(EntryName, Name),
  936             zipper_append_file(RC, Name, File, [time(Time)])
  937           )).
 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
  951find_foreign_library(Arch, FileSpec, shlib(Arch,Name), SharedObject, Time) :-
  952    FileSpec = foreign(Name),
  953    (   catch(arch_find_shlib(Arch, FileSpec, File),
  954              E,
  955              print_message(error, E)),
  956        exists_file(File)
  957    ->  true
  958    ;   throw(error(existence_error(architecture_shlib(Arch), FileSpec),_))
  959    ),
  960    time_file(File, Time),
  961    strip_file(File, SharedObject).
 strip_file(+File, -Stripped) is det
Try to strip File. Unify Stripped with File if stripping fails for some reason.
  968strip_file(File, Stripped) :-
  969    absolute_file_name(path(strip), Strip,
  970                       [ access(execute),
  971                         file_errors(fail)
  972                       ]),
  973    tmp_file(shared, Stripped),
  974    (   catch(do_strip_file(Strip, File, Stripped), E,
  975              (print_message(warning, E), fail))
  976    ->  true
  977    ;   print_message(warning, qsave(strip_failed(File))),
  978        fail
  979    ),
  980    !.
  981strip_file(File, File).
  982
  983do_strip_file(Strip, File, Stripped) :-
  984    format(atom(Cmd), '"~w" -o "~w" "~w"',
  985           [Strip, Stripped, File]),
  986    shell(Cmd),
  987    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.

 1001:- multifile arch_shlib/3. 1002
 1003arch_find_shlib(Arch, FileSpec, File) :-
 1004    arch_shlib(Arch, FileSpec, File),
 1005    !.
 1006arch_find_shlib(Arch, FileSpec, File) :-
 1007    current_prolog_flag(arch, Arch),
 1008    absolute_file_name(FileSpec,
 1009                       [ file_type(executable),
 1010                         access(read),
 1011                         file_errors(fail)
 1012                       ], File),
 1013    !.
 1014arch_find_shlib(Arch, foreign(Base), File) :-
 1015    current_prolog_flag(arch, Arch),
 1016    current_prolog_flag(windows, true),
 1017    current_prolog_flag(executable, WinExe),
 1018    prolog_to_os_filename(Exe, WinExe),
 1019    file_directory_name(Exe, BinDir),
 1020    file_name_extension(Base, dll, DllFile),
 1021    atomic_list_concat([BinDir, /, DllFile], File),
 1022    exists_file(File).
 1023
 1024
 1025                 /*******************************
 1026                 *             UTIL             *
 1027                 *******************************/
 1028
 1029open_map(Options) :-
 1030    option(map(Map), Options),
 1031    !,
 1032    open(Map, write, Fd),
 1033    asserta(verbose(Fd)).
 1034open_map(_) :-
 1035    retractall(verbose(_)).
 1036
 1037close_map :-
 1038    retract(verbose(Fd)),
 1039    close(Fd),
 1040    !.
 1041close_map.
 1042
 1043feedback(Fmt, Args) :-
 1044    verbose(Fd),
 1045    !,
 1046    format(Fd, Fmt, Args).
 1047feedback(_, _).
 1048
 1049
 1050check_options([]) :- !.
 1051check_options([Var|_]) :-
 1052    var(Var),
 1053    !,
 1054    throw(error(domain_error(save_options, Var), _)).
 1055check_options([Name=Value|T]) :-
 1056    !,
 1057    (   save_option(Name, Type, _Comment)
 1058    ->  (   must_be(Type, Value)
 1059        ->  check_options(T)
 1060        ;   throw(error(domain_error(Type, Value), _))
 1061        )
 1062    ;   throw(error(domain_error(save_option, Name), _))
 1063    ).
 1064check_options([Term|T]) :-
 1065    Term =.. [Name,Arg],
 1066    !,
 1067    check_options([Name=Arg|T]).
 1068check_options([Var|_]) :-
 1069    throw(error(domain_error(save_options, Var), _)).
 1070check_options(Opt) :-
 1071    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.
 1078zipper_append_file(_, Name, _, _) :-
 1079    saved_resource_file(Name),
 1080    !.
 1081zipper_append_file(_, _, File, _) :-
 1082    source_file(File),
 1083    !.
 1084zipper_append_file(Zipper, Name, File, Options) :-
 1085    (   option(time(_), Options)
 1086    ->  Options1 = Options
 1087    ;   time_file(File, Stamp),
 1088        Options1 = [time(Stamp)|Options]
 1089    ),
 1090    setup_call_cleanup(
 1091        open(File, read, In, [type(binary)]),
 1092        setup_call_cleanup(
 1093            zipper_open_new_file_in_zip(Zipper, Name, Out, Options1),
 1094            copy_stream_data(In, Out),
 1095            close(Out)),
 1096        close(In)),
 1097    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).
 1104zipper_add_directory(Zipper, Name, Dir, Options) :-
 1105    (   option(time(Stamp), Options)
 1106    ->  true
 1107    ;   time_file(Dir, Stamp)
 1108    ),
 1109    atom_concat(Name, /, DirName),
 1110    (   saved_resource_file(DirName)
 1111    ->  true
 1112    ;   setup_call_cleanup(
 1113            zipper_open_new_file_in_zip(Zipper, DirName, Out,
 1114                                        [ method(store),
 1115                                          time(Stamp)
 1116                                        | Options
 1117                                        ]),
 1118            true,
 1119            close(Out)),
 1120        assertz(saved_resource_file(DirName))
 1121    ).
 1122
 1123add_parent_dirs(Zipper, Name, Dir, Options) :-
 1124    (   option(time(Stamp), Options)
 1125    ->  true
 1126    ;   time_file(Dir, Stamp)
 1127    ),
 1128    file_directory_name(Name, Parent),
 1129    (   Parent \== Name
 1130    ->  add_parent_dirs(Zipper, Parent, [time(Stamp)|Options])
 1131    ;   true
 1132    ).
 1133
 1134add_parent_dirs(_, '.', _) :-
 1135    !.
 1136add_parent_dirs(Zipper, Name, Options) :-
 1137    zipper_add_directory(Zipper, Name, _, Options),
 1138    file_directory_name(Name, Parent),
 1139    (   Parent \== Name
 1140    ->  add_parent_dirs(Zipper, Parent, Options)
 1141    ;   true
 1142    ).
 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.
 1160zipper_append_directory(Zipper, Name, Dir, Options) :-
 1161    exists_directory(Dir),
 1162    !,
 1163    add_parent_dirs(Zipper, Name, Dir, Options),
 1164    zipper_add_directory(Zipper, Name, Dir, Options),
 1165    directory_files(Dir, Members),
 1166    forall(member(M, Members),
 1167           (   reserved(M)
 1168           ->  true
 1169           ;   ignored(M, Options)
 1170           ->  true
 1171           ;   atomic_list_concat([Dir,M], /, Entry),
 1172               atomic_list_concat([Name,M], /, Store),
 1173               catch(zipper_append_directory(Zipper, Store, Entry, Options),
 1174                     E,
 1175                     print_message(warning, E))
 1176           )).
 1177zipper_append_directory(Zipper, Name, File, Options) :-
 1178    zipper_append_file(Zipper, Name, File, Options).
 1179
 1180reserved(.).
 1181reserved(..).
 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.
 1188ignored(File, Options) :-
 1189    option(include(Patterns), Options),
 1190    \+ ( (   is_list(Patterns)
 1191         ->  member(Pattern, Patterns)
 1192         ;   Pattern = Patterns
 1193         ),
 1194         wildcard_match(Pattern, File)
 1195       ),
 1196    !.
 1197ignored(File, Options) :-
 1198    option(exclude(Patterns), Options),
 1199    (   is_list(Patterns)
 1200    ->  member(Pattern, Patterns)
 1201    ;   Pattern = Patterns
 1202    ),
 1203    wildcard_match(Pattern, File),
 1204    !.
 1205
 1206
 1207                /********************************
 1208                *     SAVED STATE GENERATION    *
 1209                *********************************/
 qsave_toplevel
Called to handle `-c file` compilaton.
 1215:- public
 1216    qsave_toplevel/0. 1217
 1218qsave_toplevel :-
 1219    current_prolog_flag(os_argv, Argv),
 1220    qsave_options(Argv, Files, Options),
 1221    '$cmd_option_val'(compileout, Out),
 1222    user:consult(Files),
 1223    user:qsave_program(Out, Options).
 1224
 1225qsave_options([], [], []).
 1226qsave_options([--|_], [], []) :-
 1227    !.
 1228qsave_options(['-c'|T0], Files, Options) :-
 1229    !,
 1230    argv_files(T0, T1, Files, FilesT),
 1231    qsave_options(T1, FilesT, Options).
 1232qsave_options([O|T0], Files, [Option|T]) :-
 1233    string_concat(--, Opt, O),
 1234    split_string(Opt, =, '', [NameS|Rest]),
 1235    atom_string(Name, NameS),
 1236    qsave_option(Name, OptName, Rest, Value),
 1237    !,
 1238    Option =.. [OptName, Value],
 1239    qsave_options(T0, Files, T).
 1240qsave_options([_|T0], Files, T) :-
 1241    qsave_options(T0, Files, T).
 1242
 1243argv_files([], [], Files, Files).
 1244argv_files([H|T], [H|T], Files, Files) :-
 1245    sub_atom(H, 0, _, _, -),
 1246    !.
 1247argv_files([H|T0], T, [H|Files0], Files) :-
 1248    argv_files(T0, T, Files0, Files).
 qsave_option(+Name, +ValueStrings, -Value) is semidet
 1252qsave_option(Name, Name, [], true) :-
 1253    save_option(Name, boolean, _),
 1254    !.
 1255qsave_option(NoName, Name, [], false) :-
 1256    atom_concat('no-', Name, NoName),
 1257    save_option(Name, boolean, _),
 1258    !.
 1259qsave_option(Name, Name, ValueStrings, Value) :-
 1260    save_option(Name, Type, _),
 1261    !,
 1262    atomics_to_string(ValueStrings, "=", ValueString),
 1263    convert_option_value(Type, ValueString, Value).
 1264qsave_option(Name, Name, _Chars, _Value) :-
 1265    existence_error(save_option, Name).
 1266
 1267convert_option_value(integer, String, Value) :-
 1268    (   number_string(Value, String)
 1269    ->  true
 1270    ;   sub_string(String, 0, _, 1, SubString),
 1271        sub_string(String, _, 1, 0, Suffix0),
 1272        downcase_atom(Suffix0, Suffix),
 1273        number_string(Number, SubString),
 1274        suffix_multiplier(Suffix, Multiplier)
 1275    ->  Value is Number * Multiplier
 1276    ;   domain_error(integer, String)
 1277    ).
 1278convert_option_value(callable, String, Value) :-
 1279    term_string(Value, String).
 1280convert_option_value(atom, String, Value) :-
 1281    atom_string(Value, String).
 1282convert_option_value(boolean, String, Value) :-
 1283    atom_string(Value, String).
 1284convert_option_value(oneof(_), String, Value) :-
 1285    atom_string(Value, String).
 1286convert_option_value(ground, String, Value) :-
 1287    atom_string(Value, String).
 1288convert_option_value(qsave_foreign_option, "save", save).
 1289convert_option_value(qsave_foreign_option, StrArchList, arch(ArchList)) :-
 1290    split_string(StrArchList, ",", ", \t", StrArchList1),
 1291    maplist(atom_string, ArchList, StrArchList1).
 1292
 1293suffix_multiplier(b, 1).
 1294suffix_multiplier(k, 1024).
 1295suffix_multiplier(m, 1024 * 1024).
 1296suffix_multiplier(g, 1024 * 1024 * 1024).
 1297
 1298
 1299                 /*******************************
 1300                 *            MESSAGES          *
 1301                 *******************************/
 1302
 1303:- multifile prolog:message/3. 1304
 1305prolog:message(no_resource(Name, File)) -->
 1306    [ 'Could not find resource ~w on ~w or system resources'-
 1307      [Name, File] ].
 1308prolog:message(qsave(nondet)) -->
 1309    [ 'qsave_program/2 succeeded with a choice point'-[] ]