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        SaveClass \== development
  663    ->  save_attribute(P, (dynamic)),
  664        (   M == user
  665        ->  save_attribute(P, (multifile))
  666        ),
  667        feedback('(Skipped clauses)', []),
  668        fail
  669    ;   true
  670    ),
  671    (   no_save(P)
  672    ->  true
  673    ;   save_attributes(P),
  674        \+ predicate_property(P, (volatile)),
  675        (   nth_clause(P, _, Ref),
  676            feedback('.', []),
  677            '$qlf_assert_clause'(Ref, SaveClass),
  678            fail
  679        ;   true
  680        )
  681    ).
  682
  683no_save(P) :-
  684    predicate_property(P, volatile),
  685    \+ predicate_property(P, dynamic),
  686    \+ predicate_property(P, multifile).
  687
  688pred_attrib(meta_predicate(Term), Head, meta_predicate(M:Term)) :-
  689    !,
  690    strip_module(Head, M, _).
  691pred_attrib(Attrib, Head,
  692            '$set_predicate_attribute'(M:Name/Arity, AttName, Val)) :-
  693    attrib_name(Attrib, AttName, Val),
  694    strip_module(Head, M, Term),
  695    functor(Term, Name, Arity).
  696
  697attrib_name(dynamic,                dynamic,                true).
  698attrib_name(volatile,               volatile,               true).
  699attrib_name(thread_local,           thread_local,           true).
  700attrib_name(multifile,              multifile,              true).
  701attrib_name(public,                 public,                 true).
  702attrib_name(transparent,            transparent,            true).
  703attrib_name(discontiguous,          discontiguous,          true).
  704attrib_name(notrace,                trace,                  false).
  705attrib_name(show_childs,            hide_childs,            false).
  706attrib_name(built_in,               system,                 true).
  707attrib_name(nodebug,                hide_childs,            true).
  708attrib_name(quasi_quotation_syntax, quasi_quotation_syntax, true).
  709attrib_name(iso,                    iso,                    true).
  710
  711
  712save_attribute(P, Attribute) :-
  713    pred_attrib(Attribute, P, D),
  714    (   Attribute == built_in       % no need if there are clauses
  715    ->  (   predicate_property(P, number_of_clauses(0))
  716        ->  true
  717        ;   predicate_property(P, volatile)
  718        )
  719    ;   Attribute == (dynamic)      % no need if predicate is thread_local
  720    ->  \+ predicate_property(P, thread_local)
  721    ;   true
  722    ),
  723    '$add_directive_wic'(D),
  724    feedback('(~w) ', [Attribute]).
  725
  726save_attributes(P) :-
  727    (   predicate_property(P, Attribute),
  728        save_attribute(P, Attribute),
  729        fail
  730    ;   true
  731    ).
  732
  733%       Save status of the unknown flag
  734
  735save_unknown(M) :-
  736    current_prolog_flag(M:unknown, Unknown),
  737    (   Unknown == error
  738    ->  true
  739    ;   '$add_directive_wic'(set_prolog_flag(M:unknown, Unknown))
  740    ).
  741
  742                 /*******************************
  743                 *            RECORDS           *
  744                 *******************************/
  745
  746save_records :-
  747    feedback('~nRECORDS~n', []),
  748    (   current_key(X),
  749        X \== '$topvar',                        % do not safe toplevel variables
  750        feedback('~n~t~8|~w ', [X, V]),
  751        recorded(X, V, _),
  752        feedback('.', []),
  753        '$add_directive_wic'(recordz(X, V, _)),
  754        fail
  755    ;   true
  756    ).
  757
  758
  759                 /*******************************
  760                 *            FLAGS             *
  761                 *******************************/
  762
  763save_flags :-
  764    feedback('~nFLAGS~n~n', []),
  765    (   current_flag(X),
  766        flag(X, V, V),
  767        feedback('~t~8|~w = ~w~n', [X, V]),
  768        '$add_directive_wic'(set_flag(X, V)),
  769        fail
  770    ;   true
  771    ).
  772
  773save_prompt :-
  774    feedback('~nPROMPT~n~n', []),
  775    prompt(Prompt, Prompt),
  776    '$add_directive_wic'(prompt(_, Prompt)).
  777
  778
  779                 /*******************************
  780                 *           IMPORTS            *
  781                 *******************************/
 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.
  791save_imports :-
  792    feedback('~nIMPORTS~n~n', []),
  793    (   predicate_property(M:H, imported_from(I)),
  794        \+ default_import(M, H, I),
  795        functor(H, F, A),
  796        feedback('~t~8|~w:~w/~d <-- ~w~n', [M, F, A, I]),
  797        '$add_directive_wic'(qsave:restore_import(M, I, F/A)),
  798        fail
  799    ;   true
  800    ).
  801
  802default_import(To, Head, From) :-
  803    '$get_predicate_attribute'(To:Head, (dynamic), 1),
  804    predicate_property(From:Head, exported),
  805    !,
  806    fail.
  807default_import(Into, _, From) :-
  808    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.
  816restore_import(To, user, PI) :-
  817    !,
  818    export(user:PI),
  819    To:import(user:PI).
  820restore_import(To, From, PI) :-
  821    To:import(From:PI).
  822
  823                 /*******************************
  824                 *         PROLOG FLAGS         *
  825                 *******************************/
  826
  827save_prolog_flags :-
  828    feedback('~nPROLOG FLAGS~n~n', []),
  829    '$current_prolog_flag'(Flag, Value, _Scope, write, Type),
  830    \+ no_save_flag(Flag),
  831    feedback('~t~8|~w: ~w (type ~q)~n', [Flag, Value, Type]),
  832    '$add_directive_wic'(qsave:restore_prolog_flag(Flag, Value, Type)),
  833    fail.
  834save_prolog_flags.
  835
  836no_save_flag(argv).
  837no_save_flag(os_argv).
  838no_save_flag(access_level).
  839no_save_flag(tty_control).
  840no_save_flag(readline).
  841no_save_flag(associated_file).
  842no_save_flag(cpu_count).
  843no_save_flag(hwnd).                     % should be read-only, but comes
  844                                        % 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).
  851restore_prolog_flag(Flag, Value, _Type) :-
  852    current_prolog_flag(Flag, Value),
  853    !.
  854restore_prolog_flag(Flag, Value, _Type) :-
  855    current_prolog_flag(Flag, _),
  856    !,
  857    catch(set_prolog_flag(Flag, Value), _, true).
  858restore_prolog_flag(Flag, Value, Type) :-
  859    create_prolog_flag(Flag, Value, [type(Type)]).
  860
  861
  862                 /*******************************
  863                 *           OPERATORS          *
  864                 *******************************/
 save_operators(+Options) is det
Save operators for all modules. Operators for system are not saved because these are read-only anyway.
  871save_operators(Options) :-
  872    !,
  873    option(op(save), Options, save),
  874    feedback('~nOPERATORS~n', []),
  875    forall(current_module(M), save_module_operators(M)),
  876    feedback('~n', []).
  877save_operators(_).
  878
  879save_module_operators(system) :- !.
  880save_module_operators(M) :-
  881    forall('$local_op'(P,T,M:N),
  882           (   feedback('~n~t~8|~w ', [op(P,T,M:N)]),
  883               '$add_directive_wic'(op(P,T,M:N))
  884           )).
  885
  886
  887                 /*******************************
  888                 *       FORMAT PREDICATES      *
  889                 *******************************/
  890
  891save_format_predicates :-
  892    feedback('~nFORMAT PREDICATES~n', []),
  893    current_format_predicate(Code, Head),
  894    qualify_head(Head, QHead),
  895    D = format_predicate(Code, QHead),
  896    feedback('~n~t~8|~w ', [D]),
  897    '$add_directive_wic'(D),
  898    fail.
  899save_format_predicates.
  900
  901qualify_head(T, T) :-
  902    functor(T, :, 2),
  903    !.
  904qualify_head(T, user:T).
  905
  906
  907                 /*******************************
  908                 *       FOREIGN LIBRARIES      *
  909                 *******************************/
 save_foreign_libraries(+Archive, +Options) is det
Save current foreign libraries into the archive.
  915save_foreign_libraries(RC, Options) :-
  916    option(foreign(save), Options),
  917    !,
  918    current_prolog_flag(arch, HostArch),
  919    feedback('~nHOST(~w) FOREIGN LIBRARIES~n', [HostArch]),
  920    save_foreign_libraries1(HostArch, RC, Options).
  921save_foreign_libraries(RC, Options) :-
  922    option(foreign(arch(Archs)), Options),
  923    !,
  924    forall(member(Arch, Archs),
  925           ( feedback('~n~w FOREIGN LIBRARIES~n', [Arch]),
  926             save_foreign_libraries1(Arch, RC, Options)
  927           )).
  928save_foreign_libraries(_, _).
  929
  930save_foreign_libraries1(Arch, RC, _Options) :-
  931    forall(current_foreign_library(FileSpec, _Predicates),
  932           ( find_foreign_library(Arch, FileSpec, EntryName, File, Time),
  933             term_to_atom(EntryName, Name),
  934             zipper_append_file(RC, Name, File, [time(Time)])
  935           )).
 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
  949find_foreign_library(Arch, FileSpec, shlib(Arch,Name), SharedObject, Time) :-
  950    FileSpec = foreign(Name),
  951    (   catch(arch_find_shlib(Arch, FileSpec, File),
  952              E,
  953              print_message(error, E)),
  954        exists_file(File)
  955    ->  true
  956    ;   throw(error(existence_error(architecture_shlib(Arch), FileSpec),_))
  957    ),
  958    time_file(File, Time),
  959    strip_file(File, SharedObject).
 strip_file(+File, -Stripped) is det
Try to strip File. Unify Stripped with File if stripping fails for some reason.
  966strip_file(File, Stripped) :-
  967    absolute_file_name(path(strip), Strip,
  968                       [ access(execute),
  969                         file_errors(fail)
  970                       ]),
  971    tmp_file(shared, Stripped),
  972    (   catch(do_strip_file(Strip, File, Stripped), E,
  973              (print_message(warning, E), fail))
  974    ->  true
  975    ;   print_message(warning, qsave(strip_failed(File))),
  976        fail
  977    ),
  978    !.
  979strip_file(File, File).
  980
  981do_strip_file(Strip, File, Stripped) :-
  982    format(atom(Cmd), '"~w" -o "~w" "~w"',
  983           [Strip, Stripped, File]),
  984    shell(Cmd),
  985    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.

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