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(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").
  100
  101term_expansion(save_pred_options,
  102               (:- predicate_options(qsave_program/2, 2, Options))) :-
  103    findall(O,
  104            ( save_option(Name, Type, _),
  105              O =.. [Name,Type]
  106            ),
  107            Options).
  108
  109save_pred_options.
  110
  111:- set_prolog_flag(generate_debug_info, false).  112
  113:- dynamic
  114    verbose/1,
  115    saved_resource_file/1.  116:- volatile
  117    verbose/1,                  % contains a stream-handle
  118    saved_resource_file/1.
 qsave_program(+File) is det
 qsave_program(+File, :Options) is det
Make a saved state in file `File'.
  125qsave_program(File) :-
  126    qsave_program(File, []).
  127
  128qsave_program(FileBase, Options0) :-
  129    meta_options(is_meta, Options0, Options),
  130    check_options(Options),
  131    exe_file(FileBase, File, Options),
  132    option(class(SaveClass),    Options, runtime),
  133    option(init_file(InitFile), Options, DefInit),
  134    default_init_file(SaveClass, DefInit),
  135    prepare_entry_points(Options),
  136    save_autoload(Options),
  137    setup_call_cleanup(
  138        open_map(Options),
  139        ( prepare_state(Options),
  140          create_prolog_flag(saved_program, true, []),
  141          create_prolog_flag(saved_program_class, SaveClass, []),
  142          delete_if_exists(File),    % truncate will crash Prolog's
  143                                     % running on this state
  144          setup_call_catcher_cleanup(
  145              open(File, write, StateOut, [type(binary)]),
  146              write_state(StateOut, SaveClass, InitFile, Options),
  147              Reason,
  148              finalize_state(Reason, StateOut, File))
  149        ),
  150        close_map),
  151    cleanup,
  152    !.
  153
  154write_state(StateOut, SaveClass, InitFile, Options) :-
  155    make_header(StateOut, SaveClass, Options),
  156    setup_call_cleanup(
  157        zip_open_stream(StateOut, RC, []),
  158        write_zip_state(RC, SaveClass, InitFile, Options),
  159        zip_close(RC, [comment('SWI-Prolog saved state')])),
  160    flush_output(StateOut).
  161
  162write_zip_state(RC, SaveClass, InitFile, Options) :-
  163    save_options(RC, SaveClass,
  164                 [ init_file(InitFile)
  165                 | Options
  166                 ]),
  167    save_resources(RC, SaveClass),
  168    lock_files(SaveClass),
  169    save_program(RC, SaveClass, Options),
  170    save_foreign_libraries(RC, Options).
  171
  172finalize_state(exit, StateOut, File) :-
  173    close(StateOut),
  174    '$mark_executable'(File).
  175finalize_state(!, StateOut, File) :-
  176    print_message(warning, qsave(nondet)),
  177    finalize_state(exit, StateOut, File).
  178finalize_state(_, StateOut, File) :-
  179    close(StateOut, [force(true)]),
  180    catch(delete_file(File),
  181          Error,
  182          print_message(error, Error)).
  183
  184cleanup :-
  185    retractall(saved_resource_file(_)).
  186
  187is_meta(goal).
  188is_meta(toplevel).
  189
  190exe_file(Base, Exe, Options) :-
  191    current_prolog_flag(windows, true),
  192    option(stand_alone(true), Options, true),
  193    file_name_extension(_, '', Base),
  194    !,
  195    file_name_extension(Base, exe, Exe).
  196exe_file(Exe, Exe, _).
  197
  198default_init_file(runtime, none) :- !.
  199default_init_file(_,       InitFile) :-
  200    '$cmd_option_val'(init_file, InitFile).
  201
  202delete_if_exists(File) :-
  203    (   exists_file(File)
  204    ->  delete_file(File)
  205    ;   true
  206    ).
  207
  208                 /*******************************
  209                 *           HEADER             *
  210                 *******************************/
 make_header(+Out:stream, +SaveClass, +Options) is det
  214make_header(Out, _, Options) :-
  215    option(emulator(OptVal), Options),
  216    !,
  217    absolute_file_name(OptVal, [access(read)], Emulator),
  218    setup_call_cleanup(
  219        open(Emulator, read, In, [type(binary)]),
  220        copy_stream_data(In, Out),
  221        close(In)).
  222make_header(Out, _, Options) :-
  223    (   current_prolog_flag(windows, true)
  224    ->  DefStandAlone = true
  225    ;   DefStandAlone = false
  226    ),
  227    option(stand_alone(true), Options, DefStandAlone),
  228    !,
  229    current_prolog_flag(executable, Executable),
  230    setup_call_cleanup(
  231        open(Executable, read, In, [type(binary)]),
  232        copy_stream_data(In, Out),
  233        close(In)).
  234make_header(Out, SaveClass, _Options) :-
  235    current_prolog_flag(unix, true),
  236    !,
  237    current_prolog_flag(executable, Executable),
  238    current_prolog_flag(posix_shell, Shell),
  239    format(Out, '#!~w~n', [Shell]),
  240    format(Out, '# SWI-Prolog saved state~n', []),
  241    (   SaveClass == runtime
  242    ->  ArgSep = ' -- '
  243    ;   ArgSep = ' '
  244    ),
  245    format(Out, 'exec ${SWIPL-~w} -x "$0"~w"$@"~n~n', [Executable, ArgSep]).
  246make_header(_, _, _).
  247
  248
  249                 /*******************************
  250                 *           OPTIONS            *
  251                 *******************************/
  252
  253min_stack(stack_limit, 100_000).
  254
  255convert_option(Stack, Val, NewVal, '~w') :-     % stack-sizes are in K-bytes
  256    min_stack(Stack, Min),
  257    !,
  258    (   Val == 0
  259    ->  NewVal = Val
  260    ;   NewVal is max(Min, Val)
  261    ).
  262convert_option(toplevel, Callable, Callable, '~q') :- !.
  263convert_option(_, Value, Value, '~w').
  264
  265doption(Name) :- min_stack(Name, _).
  266doption(init_file).
  267doption(system_init_file).
  268doption(class).
  269doption(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.

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

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