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

Save current program as a state or executable

This library provides qsave_program/1 and qsave_program/2, which are also used by the commandline sequence below.

swipl -o exe -c file.pl ...

*/

   57:- meta_predicate
   58    qsave_program(+, :).   59
   60:- multifile error:has_type/2.   61error:has_type(qsave_foreign_option, Term) :-
   62    is_of_type(oneof([save, no_save]), Term),
   63    !.
   64error:has_type(qsave_foreign_option, arch(Archs)) :-
   65    is_of_type(list(atom), Archs),
   66    !.
   67
   68save_option(stack_limit, integer,
   69            "Stack limit (bytes)").
   70save_option(goal,        callable,
   71            "Main initialization goal").
   72save_option(toplevel,    callable,
   73            "Toplevel goal").
   74save_option(init_file,   atom,
   75            "Application init file").
   76save_option(packs,       boolean,
   77            "Do (not) attach packs").
   78save_option(class,       oneof([runtime,development]),
   79            "Development state").
   80save_option(op,          oneof([save,standard]),
   81            "Save operators").
   82save_option(autoload,    boolean,
   83            "Resolve autoloadable predicates").
   84save_option(map,         atom,
   85            "File to report content of the state").
   86save_option(stand_alone, boolean,
   87            "Add emulator at start").
   88save_option(traditional, boolean,
   89            "Use traditional mode").
   90save_option(emulator,    ground,
   91            "Emulator to use").
   92save_option(foreign,     qsave_foreign_option,
   93            "Include foreign code in state").
   94save_option(obfuscate,   boolean,
   95            "Obfuscate identifiers").
   96save_option(verbose,     boolean,
   97            "Be more verbose about the state creation").
   98save_option(undefined,   oneof([ignore,error]),
   99            "How to handle undefined predicates").
  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 a Prolog
  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).
  270doption(nosignals).
 save_options(+ArchiveHandle, +SaveClass, +Options)
Save the options in the '$options' resource. The home directory is saved for development states to make it keep refering to the development home.

The script files (-s script) are not saved at all. I think this is fine to avoid a save-script loading itself.

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

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