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(hwnd).                     % should be read-only, but comes
  852                                        % 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).
  859restore_prolog_flag(Flag, Value, _Type) :-
  860    current_prolog_flag(Flag, Value),
  861    !.
  862restore_prolog_flag(Flag, Value, _Type) :-
  863    current_prolog_flag(Flag, _),
  864    !,
  865    catch(set_prolog_flag(Flag, Value), _, true).
  866restore_prolog_flag(Flag, Value, Type) :-
  867    create_prolog_flag(Flag, Value, [type(Type)]).
  868
  869
  870                 /*******************************
  871                 *           OPERATORS          *
  872                 *******************************/
 save_operators(+Options) is det
Save operators for all modules. Operators for system are not saved because these are read-only anyway.
  879save_operators(Options) :-
  880    !,
  881    option(op(save), Options, save),
  882    feedback('~nOPERATORS~n', []),
  883    forall(current_module(M), save_module_operators(M)),
  884    feedback('~n', []).
  885save_operators(_).
  886
  887save_module_operators(system) :- !.
  888save_module_operators(M) :-
  889    forall('$local_op'(P,T,M:N),
  890           (   feedback('~n~t~8|~w ', [op(P,T,M:N)]),
  891               '$add_directive_wic'(op(P,T,M:N))
  892           )).
  893
  894
  895                 /*******************************
  896                 *       FORMAT PREDICATES      *
  897                 *******************************/
  898
  899save_format_predicates :-
  900    feedback('~nFORMAT PREDICATES~n', []),
  901    current_format_predicate(Code, Head),
  902    qualify_head(Head, QHead),
  903    D = format_predicate(Code, QHead),
  904    feedback('~n~t~8|~w ', [D]),
  905    '$add_directive_wic'(D),
  906    fail.
  907save_format_predicates.
  908
  909qualify_head(T, T) :-
  910    functor(T, :, 2),
  911    !.
  912qualify_head(T, user:T).
  913
  914
  915                 /*******************************
  916                 *       FOREIGN LIBRARIES      *
  917                 *******************************/
 save_foreign_libraries(+Archive, +Options) is det
Save current foreign libraries into the archive.
  923save_foreign_libraries(RC, Options) :-
  924    option(foreign(save), Options),
  925    !,
  926    current_prolog_flag(arch, HostArch),
  927    feedback('~nHOST(~w) FOREIGN LIBRARIES~n', [HostArch]),
  928    save_foreign_libraries1(HostArch, RC, Options).
  929save_foreign_libraries(RC, Options) :-
  930    option(foreign(arch(Archs)), Options),
  931    !,
  932    forall(member(Arch, Archs),
  933           ( feedback('~n~w FOREIGN LIBRARIES~n', [Arch]),
  934             save_foreign_libraries1(Arch, RC, Options)
  935           )).
  936save_foreign_libraries(_, _).
  937
  938save_foreign_libraries1(Arch, RC, _Options) :-
  939    forall(current_foreign_library(FileSpec, _Predicates),
  940           ( find_foreign_library(Arch, FileSpec, EntryName, File, Time),
  941             term_to_atom(EntryName, Name),
  942             zipper_append_file(RC, Name, File, [time(Time)])
  943           )).
 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
  957find_foreign_library(Arch, FileSpec, shlib(Arch,Name), SharedObject, Time) :-
  958    FileSpec = foreign(Name),
  959    (   catch(arch_find_shlib(Arch, FileSpec, File),
  960              E,
  961              print_message(error, E)),
  962        exists_file(File)
  963    ->  true
  964    ;   throw(error(existence_error(architecture_shlib(Arch), FileSpec),_))
  965    ),
  966    time_file(File, Time),
  967    strip_file(File, SharedObject).
 strip_file(+File, -Stripped) is det
Try to strip File. Unify Stripped with File if stripping fails for some reason.
  974strip_file(File, Stripped) :-
  975    absolute_file_name(path(strip), Strip,
  976                       [ access(execute),
  977                         file_errors(fail)
  978                       ]),
  979    tmp_file(shared, Stripped),
  980    (   catch(do_strip_file(Strip, File, Stripped), E,
  981              (print_message(warning, E), fail))
  982    ->  true
  983    ;   print_message(warning, qsave(strip_failed(File))),
  984        fail
  985    ),
  986    !.
  987strip_file(File, File).
  988
  989do_strip_file(Strip, File, Stripped) :-
  990    format(atom(Cmd), '"~w" -o "~w" "~w"',
  991           [Strip, Stripped, File]),
  992    shell(Cmd),
  993    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.

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