1/*  Part of SWI-Prolog
    2
    3    Author:        Jan Wielemaker
    4    E-mail:        J.Wielemaker@vu.nl
    5    WWW:           http://www.swi-prolog.org
    6    Copyright (c)  1995-2019, University of Amsterdam
    7                              VU University Amsterdam
    8                              CWI, Amsterdam
    9    All rights reserved.
   10
   11    Redistribution and use in source and binary forms, with or without
   12    modification, are permitted provided that the following conditions
   13    are met:
   14
   15    1. Redistributions of source code must retain the above copyright
   16       notice, this list of conditions and the following disclaimer.
   17
   18    2. Redistributions in binary form must reproduce the above copyright
   19       notice, this list of conditions and the following disclaimer in
   20       the documentation and/or other materials provided with the
   21       distribution.
   22
   23    THIS SOFTWARE IS PROVIDED BY THE COPYRIGHT HOLDERS AND CONTRIBUTORS
   24    "AS IS" AND ANY EXPRESS OR IMPLIED WARRANTIES, INCLUDING, BUT NOT
   25    LIMITED TO, THE IMPLIED WARRANTIES OF MERCHANTABILITY AND FITNESS
   26    FOR A PARTICULAR PURPOSE ARE DISCLAIMED. IN NO EVENT SHALL THE
   27    COPYRIGHT OWNER OR CONTRIBUTORS BE LIABLE FOR ANY DIRECT, INDIRECT,
   28    INCIDENTAL, SPECIAL, EXEMPLARY, OR CONSEQUENTIAL DAMAGES (INCLUDING,
   29    BUT NOT LIMITED TO, PROCUREMENT OF SUBSTITUTE GOODS OR SERVICES;
   30    LOSS OF USE, DATA, OR PROFITS; OR BUSINESS INTERRUPTION) HOWEVER
   31    CAUSED AND ON ANY THEORY OF LIABILITY, WHETHER IN CONTRACT, STRICT
   32    LIABILITY, OR TORT (INCLUDING NEGLIGENCE OR OTHERWISE) ARISING IN
   33    ANY WAY OUT OF THE USE OF THIS SOFTWARE, EVEN IF ADVISED OF THE
   34    POSSIBILITY OF SUCH DAMAGE.
   35*/
   36
   37:- module(qsave,
   38          [ qsave_program/1,                    % +File
   39            qsave_program/2                     % +File, +Options
   40          ]).   41:- use_module(library(lists)).   42:- use_module(library(option)).   43:- use_module(library(error)).   44:- use_module(library(apply)).   45
   46/** <module> Save current program as a state or executable
   47
   48This library provides qsave_program/1  and   qsave_program/2,  which are
   49also used by the commandline sequence below.
   50
   51  ==
   52  swipl -o exe -c file.pl ...
   53  ==
   54*/
   55
   56:- meta_predicate
   57    qsave_program(+, :).   58
   59:- multifile error:has_type/2.   60error:has_type(qsave_foreign_option, Term) :-
   61    is_of_type(oneof([save, no_save]), Term),
   62    !.
   63error:has_type(qsave_foreign_option, arch(Archs)) :-
   64    is_of_type(list(atom), Archs),
   65    !.
   66
   67save_option(stack_limit, integer,
   68            "Stack limit (bytes)").
   69save_option(goal,        callable,
   70            "Main initialization goal").
   71save_option(toplevel,    callable,
   72            "Toplevel goal").
   73save_option(init_file,   atom,
   74            "Application init file").
   75save_option(class,       oneof([runtime,development]),
   76            "Development state").
   77save_option(op,          oneof([save,standard]),
   78            "Save operators").
   79save_option(autoload,    boolean,
   80            "Resolve autoloadable predicates").
   81save_option(map,         atom,
   82            "File to report content of the state").
   83save_option(stand_alone, boolean,
   84            "Add emulator at start").
   85save_option(emulator,    ground,
   86            "Emulator to use").
   87save_option(foreign,     qsave_foreign_option,
   88            "Include foreign code in state").
   89save_option(obfuscate,   boolean,
   90            "Obfuscate identifiers").
   91save_option(verbose,     boolean,
   92            "Be more verbose about the state creation").
   93save_option(undefined,   oneof([ignore,error]),
   94            "How to handle undefined predicates").
   95
   96term_expansion(save_pred_options,
   97               (:- predicate_options(qsave_program/2, 2, Options))) :-
   98    findall(O,
   99            ( save_option(Name, Type, _),
  100              O =.. [Name,Type]
  101            ),
  102            Options).
  103
  104save_pred_options.
  105
  106:- set_prolog_flag(generate_debug_info, false).  107
  108:- dynamic
  109    verbose/1,
  110    saved_resource_file/1.  111:- volatile
  112    verbose/1,                  % contains a stream-handle
  113    saved_resource_file/1.  114
  115%!  qsave_program(+File) is det.
  116%!  qsave_program(+File, :Options) is det.
  117%
  118%   Make a saved state in file `File'.
  119
  120qsave_program(File) :-
  121    qsave_program(File, []).
  122
  123qsave_program(FileBase, Options0) :-
  124    meta_options(is_meta, Options0, Options),
  125    check_options(Options),
  126    exe_file(FileBase, File, Options),
  127    option(class(SaveClass),    Options, runtime),
  128    option(init_file(InitFile), Options, DefInit),
  129    default_init_file(SaveClass, DefInit),
  130    prepare_entry_points(Options),
  131    save_autoload(Options),
  132    setup_call_cleanup(
  133        open_map(Options),
  134        ( prepare_state(Options),
  135          create_prolog_flag(saved_program, true, []),
  136          create_prolog_flag(saved_program_class, SaveClass, []),
  137          delete_if_exists(File),    % truncate will crash Prolog's
  138                                     % running on this state
  139          setup_call_catcher_cleanup(
  140              open(File, write, StateOut, [type(binary)]),
  141              write_state(StateOut, SaveClass, InitFile, Options),
  142              Reason,
  143              finalize_state(Reason, StateOut, File))
  144        ),
  145        close_map),
  146    cleanup,
  147    !.
  148
  149write_state(StateOut, SaveClass, InitFile, Options) :-
  150    make_header(StateOut, SaveClass, Options),
  151    setup_call_cleanup(
  152        zip_open_stream(StateOut, RC, []),
  153        write_zip_state(RC, SaveClass, InitFile, Options),
  154        zip_close(RC, [comment("SWI-Prolog saved state")])),
  155    flush_output(StateOut).
  156
  157write_zip_state(RC, SaveClass, InitFile, Options) :-
  158    save_options(RC, SaveClass,
  159                 [ init_file(InitFile)
  160                 | Options
  161                 ]),
  162    save_resources(RC, SaveClass),
  163    lock_files(SaveClass),
  164    save_program(RC, SaveClass, Options),
  165    save_foreign_libraries(RC, Options).
  166
  167finalize_state(exit, StateOut, File) :-
  168    close(StateOut),
  169    '$mark_executable'(File).
  170finalize_state(!, StateOut, File) :-
  171    print_message(warning, qsave(nondet)),
  172    finalize_state(exit, StateOut, File).
  173finalize_state(_, StateOut, File) :-
  174    close(StateOut, [force(true)]),
  175    catch(delete_file(File),
  176          Error,
  177          print_message(error, Error)).
  178
  179cleanup :-
  180    retractall(saved_resource_file(_)).
  181
  182is_meta(goal).
  183is_meta(toplevel).
  184
  185exe_file(Base, Exe, Options) :-
  186    current_prolog_flag(windows, true),
  187    option(stand_alone(true), Options, true),
  188    file_name_extension(_, '', Base),
  189    !,
  190    file_name_extension(Base, exe, Exe).
  191exe_file(Exe, Exe, _).
  192
  193default_init_file(runtime, none) :- !.
  194default_init_file(_,       InitFile) :-
  195    '$cmd_option_val'(init_file, InitFile).
  196
  197delete_if_exists(File) :-
  198    (   exists_file(File)
  199    ->  delete_file(File)
  200    ;   true
  201    ).
  202
  203                 /*******************************
  204                 *           HEADER             *
  205                 *******************************/
  206
  207%!  make_header(+Out:stream, +SaveClass, +Options) is det.
  208
  209make_header(Out, _, Options) :-
  210    option(emulator(OptVal), Options),
  211    !,
  212    absolute_file_name(OptVal, [access(read)], Emulator),
  213    setup_call_cleanup(
  214        open(Emulator, read, In, [type(binary)]),
  215        copy_stream_data(In, Out),
  216        close(In)).
  217make_header(Out, _, Options) :-
  218    (   current_prolog_flag(windows, true)
  219    ->  DefStandAlone = true
  220    ;   DefStandAlone = false
  221    ),
  222    option(stand_alone(true), Options, DefStandAlone),
  223    !,
  224    current_prolog_flag(executable, Executable),
  225    setup_call_cleanup(
  226        open(Executable, read, In, [type(binary)]),
  227        copy_stream_data(In, Out),
  228        close(In)).
  229make_header(Out, SaveClass, _Options) :-
  230    current_prolog_flag(unix, true),
  231    !,
  232    current_prolog_flag(executable, Executable),
  233    current_prolog_flag(posix_shell, Shell),
  234    format(Out, '#!~w~n', [Shell]),
  235    format(Out, '# SWI-Prolog saved state~n', []),
  236    (   SaveClass == runtime
  237    ->  ArgSep = ' -- '
  238    ;   ArgSep = ' '
  239    ),
  240    format(Out, 'exec ${SWIPL-~w} -x "$0"~w"$@"~n~n', [Executable, ArgSep]).
  241make_header(_, _, _).
  242
  243
  244                 /*******************************
  245                 *           OPTIONS            *
  246                 *******************************/
  247
  248min_stack(stack_limit, 100_000).
  249
  250convert_option(Stack, Val, NewVal, "~w") :-     % stack-sizes are in K-bytes
  251    min_stack(Stack, Min),
  252    !,
  253    (   Val == 0
  254    ->  NewVal = Val
  255    ;   NewVal is max(Min, Val)
  256    ).
  257convert_option(toplevel, Callable, Callable, "~q") :- !.
  258convert_option(_, Value, Value, "~w").
  259
  260doption(Name) :- min_stack(Name, _).
  261doption(init_file).
  262doption(system_init_file).
  263doption(class).
  264doption(home).
  265
  266%!  save_options(+ArchiveHandle, +SaveClass, +Options)
  267%
  268%   Save the options in the '$options'   resource. The home directory is
  269%   saved for development  states  to  make   it  keep  refering  to the
  270%   development home.
  271%
  272%   The script files (-s script) are not saved   at all. I think this is
  273%   fine to avoid a save-script loading itself.
  274
  275save_options(RC, SaveClass, Options) :-
  276    zipper_open_new_file_in_zip(RC, '$prolog/options.txt', Fd, []),
  277    (   doption(OptionName),
  278            '$cmd_option_val'(OptionName, OptionVal0),
  279            save_option_value(SaveClass, OptionName, OptionVal0, OptionVal1),
  280            OptTerm =.. [OptionName,OptionVal2],
  281            (   option(OptTerm, Options)
  282            ->  convert_option(OptionName, OptionVal2, OptionVal, FmtVal)
  283            ;   OptionVal = OptionVal1,
  284                FmtVal = "~w"
  285            ),
  286            atomics_to_string(["~w=", FmtVal, "~n"], Fmt),
  287            format(Fd, Fmt, [OptionName, OptionVal]),
  288        fail
  289    ;   true
  290    ),
  291    save_init_goals(Fd, Options),
  292    close(Fd).
  293
  294%!  save_option_value(+SaveClass, +OptionName, +OptionValue, -FinalValue)
  295
  296save_option_value(Class,   class, _,     Class) :- !.
  297save_option_value(runtime, home,  _,     _) :- !, fail.
  298save_option_value(_,       _,     Value, Value).
  299
  300%!  save_init_goals(+Stream, +Options)
  301%
  302%   Save initialization goals. If there  is   a  goal(Goal)  option, use
  303%   that, else save the goals from '$cmd_option_val'/2.
  304
  305save_init_goals(Out, Options) :-
  306    option(goal(Goal), Options),
  307    !,
  308    format(Out, 'goal=~q~n', [Goal]),
  309    save_toplevel_goal(Out, halt, Options).
  310save_init_goals(Out, Options) :-
  311    '$cmd_option_val'(goals, Goals),
  312    forall(member(Goal, Goals),
  313           format(Out, 'goal=~w~n', [Goal])),
  314    (   Goals == []
  315    ->  DefToplevel = default
  316    ;   DefToplevel = halt
  317    ),
  318    save_toplevel_goal(Out, DefToplevel, Options).
  319
  320save_toplevel_goal(Out, _Default, Options) :-
  321    option(toplevel(Goal), Options),
  322    !,
  323    unqualify_reserved_goal(Goal, Goal1),
  324    format(Out, 'toplevel=~q~n', [Goal1]).
  325save_toplevel_goal(Out, _Default, _Options) :-
  326    '$cmd_option_val'(toplevel, Toplevel),
  327    Toplevel \== default,
  328    !,
  329    format(Out, 'toplevel=~w~n', [Toplevel]).
  330save_toplevel_goal(Out, Default, _Options) :-
  331    format(Out, 'toplevel=~q~n', [Default]).
  332
  333unqualify_reserved_goal(_:prolog, prolog) :- !.
  334unqualify_reserved_goal(_:default, default) :- !.
  335unqualify_reserved_goal(Goal, Goal).
  336
  337
  338                 /*******************************
  339                 *           RESOURCES          *
  340                 *******************************/
  341
  342save_resources(_RC, development) :- !.
  343save_resources(RC, _SaveClass) :-
  344    feedback('~nRESOURCES~n~n', []),
  345    copy_resources(RC),
  346    forall(declared_resource(Name, FileSpec, Options),
  347           save_resource(RC, Name, FileSpec, Options)).
  348
  349declared_resource(RcName, FileSpec, []) :-
  350    current_predicate(_, M:resource(_,_)),
  351    M:resource(Name, FileSpec),
  352    mkrcname(M, Name, RcName).
  353declared_resource(RcName, FileSpec, Options) :-
  354    current_predicate(_, M:resource(_,_,_)),
  355    M:resource(Name, A2, A3),
  356    (   is_list(A3)
  357    ->  FileSpec = A2,
  358        Options = A3
  359    ;   FileSpec = A3
  360    ),
  361    mkrcname(M, Name, RcName).
  362
  363%!  mkrcname(+Module, +NameSpec, -Name)
  364%
  365%   Turn a resource name term into a resource name atom.
  366
  367mkrcname(user, Name0, Name) :-
  368    !,
  369    path_segments_to_atom(Name0, Name).
  370mkrcname(M, Name0, RcName) :-
  371    path_segments_to_atom(Name0, Name),
  372    atomic_list_concat([M, :, Name], RcName).
  373
  374path_segments_to_atom(Name0, Name) :-
  375    phrase(segments_to_atom(Name0), Atoms),
  376    atomic_list_concat(Atoms, /, Name).
  377
  378segments_to_atom(Var) -->
  379    { var(Var), !,
  380      instantiation_error(Var)
  381    }.
  382segments_to_atom(A/B) -->
  383    !,
  384    segments_to_atom(A),
  385    segments_to_atom(B).
  386segments_to_atom(A) -->
  387    [A].
  388
  389%!  save_resource(+Zipper, +Name, +FileSpec, +Options) is det.
  390%
  391%   Add the content represented by FileSpec to Zipper under Name.
  392
  393save_resource(RC, Name, FileSpec, _Options) :-
  394    absolute_file_name(FileSpec,
  395                       [ access(read),
  396                         file_errors(fail)
  397                       ], File),
  398    !,
  399    feedback('~t~8|~w~t~32|~w~n',
  400             [Name, File]),
  401    zipper_append_file(RC, Name, File, []).
  402save_resource(RC, Name, FileSpec, Options) :-
  403    findall(Dir,
  404            absolute_file_name(FileSpec, Dir,
  405                               [ access(read),
  406                                 file_type(directory),
  407                                 file_errors(fail),
  408                                 solutions(all)
  409                               ]),
  410            Dirs),
  411    Dirs \== [],
  412    !,
  413    forall(member(Dir, Dirs),
  414           ( feedback('~t~8|~w~t~32|~w~n',
  415                      [Name, Dir]),
  416             zipper_append_directory(RC, Name, Dir, Options))).
  417save_resource(RC, Name, _, _Options) :-
  418    '$rc_handle'(SystemRC),
  419    copy_resource(SystemRC, RC, Name),
  420    !.
  421save_resource(_, Name, FileSpec, _Options) :-
  422    print_message(warning,
  423                  error(existence_error(resource,
  424                                        resource(Name, FileSpec)),
  425                        _)).
  426
  427copy_resources(ToRC) :-
  428    '$rc_handle'(FromRC),
  429    zipper_members(FromRC, List),
  430    (   member(Name, List),
  431        \+ declared_resource(Name, _, _),
  432        \+ reserved_resource(Name),
  433        copy_resource(FromRC, ToRC, Name),
  434        fail
  435    ;   true
  436    ).
  437
  438reserved_resource('$prolog/state.qlf').
  439reserved_resource('$prolog/options.txt').
  440
  441copy_resource(FromRC, ToRC, Name) :-
  442    (   zipper_goto(FromRC, file(Name))
  443    ->  true
  444    ;   existence_error(resource, Name)
  445    ),
  446    zipper_file_info(FromRC, _Name, Attrs),
  447    get_dict(time, Attrs, Time),
  448    setup_call_cleanup(
  449        zipper_open_current(FromRC, FdIn,
  450                            [ type(binary),
  451                              time(Time)
  452                            ]),
  453        setup_call_cleanup(
  454            zipper_open_new_file_in_zip(ToRC, Name, FdOut, []),
  455            ( feedback('~t~8|~w~t~24|~w~n',
  456                       [Name, '<Copied from running state>']),
  457              copy_stream_data(FdIn, FdOut)
  458            ),
  459            close(FdOut)),
  460        close(FdIn)).
  461
  462
  463		 /*******************************
  464		 *           OBFUSCATE		*
  465		 *******************************/
  466
  467%!  create_mapping(+Options) is det.
  468%
  469%   Call hook to obfuscate symbols.
  470
  471:- multifile prolog:obfuscate_identifiers/1.  472
  473create_mapping(Options) :-
  474    option(obfuscate(true), Options),
  475    !,
  476    (   predicate_property(prolog:obfuscate_identifiers(_), number_of_clauses(N)),
  477        N > 0
  478    ->  true
  479    ;   use_module(library(obfuscate))
  480    ),
  481    (   catch(prolog:obfuscate_identifiers(Options), E,
  482              print_message(error, E))
  483    ->  true
  484    ;   print_message(warning, failed(obfuscate_identifiers))
  485    ).
  486create_mapping(_).
  487
  488%!  lock_files(+SaveClass) is det.
  489%
  490%   When saving as `runtime`, lock all files  such that when running the
  491%   program the system stops checking existence and modification time on
  492%   the filesystem.
  493%
  494%   @tbd `system` is a poor name.  Maybe use `resource`?
  495
  496lock_files(runtime) :-
  497    !,
  498    '$set_source_files'(system).                % implies from_state
  499lock_files(_) :-
  500    '$set_source_files'(from_state).
  501
  502%!  save_program(+Zipper, +SaveClass, +Options) is det.
  503%
  504%   Save the program itself as virtual machine code to Zipper.
  505
  506save_program(RC, SaveClass, Options) :-
  507    zipper_open_new_file_in_zip(RC, '$prolog/state.qlf', StateFd, []),
  508    setup_call_cleanup(
  509        ( current_prolog_flag(access_level, OldLevel),
  510          set_prolog_flag(access_level, system), % generate system modules
  511          '$open_wic'(StateFd, Options)
  512        ),
  513        ( create_mapping(Options),
  514          save_modules(SaveClass),
  515          save_records,
  516          save_flags,
  517          save_prompt,
  518          save_imports,
  519          save_prolog_flags,
  520          save_operators(Options),
  521          save_format_predicates
  522        ),
  523        ( '$close_wic',
  524          set_prolog_flag(access_level, OldLevel)
  525        )),
  526    close(StateFd).
  527
  528
  529                 /*******************************
  530                 *            MODULES           *
  531                 *******************************/
  532
  533save_modules(SaveClass) :-
  534    forall(special_module(X),
  535           save_module(X, SaveClass)),
  536    forall((current_module(X), \+ special_module(X)),
  537           save_module(X, SaveClass)).
  538
  539special_module(system).
  540special_module(user).
  541
  542
  543%!  prepare_entry_points(+Options)
  544%
  545%   Prepare  the  --goal=Goal  and  --toplevel=Goal  options.  Preparing
  546%   implies autoloading the definition and declaring it _public_ such at
  547%   it doesn't get obfuscated.
  548
  549prepare_entry_points(Options) :-
  550    define_init_goal(Options),
  551    define_toplevel_goal(Options).
  552
  553define_init_goal(Options) :-
  554    option(goal(Goal), Options),
  555    !,
  556    entry_point(Goal).
  557define_init_goal(_).
  558
  559define_toplevel_goal(Options) :-
  560    option(toplevel(Goal), Options),
  561    !,
  562    entry_point(Goal).
  563define_toplevel_goal(_).
  564
  565entry_point(Goal) :-
  566    define_predicate(Goal),
  567    (   \+ predicate_property(Goal, built_in),
  568        \+ predicate_property(Goal, imported_from(_))
  569    ->  goal_pi(Goal, PI),
  570        public(PI)
  571    ;   true
  572    ).
  573
  574define_predicate(Head) :-
  575    '$define_predicate'(Head),
  576    !.   % autoloader
  577define_predicate(Head) :-
  578    strip_module(Head, _, Term),
  579    functor(Term, Name, Arity),
  580    throw(error(existence_error(procedure, Name/Arity), _)).
  581
  582goal_pi(M:G, QPI) :-
  583    !,
  584    strip_module(M:G, Module, Goal),
  585    functor(Goal, Name, Arity),
  586    QPI = Module:Name/Arity.
  587goal_pi(Goal, Name/Arity) :-
  588    functor(Goal, Name, Arity).
  589
  590%!  prepare_state(+Options) is det.
  591%
  592%   Prepare the executable by  running   the  `prepare_state` registered
  593%   initialization hooks.
  594
  595prepare_state(_) :-
  596    forall('$init_goal'(when(prepare_state), Goal, Ctx),
  597           run_initialize(Goal, Ctx)).
  598
  599run_initialize(Goal, Ctx) :-
  600    (   catch(Goal, E, true),
  601        (   var(E)
  602        ->  true
  603        ;   throw(error(initialization_error(E, Goal, Ctx), _))
  604        )
  605    ;   throw(error(initialization_error(failed, Goal, Ctx), _))
  606    ).
  607
  608
  609                 /*******************************
  610                 *            AUTOLOAD          *
  611                 *******************************/
  612
  613%!  save_autoload(+Options) is det.
  614%
  615%   Resolve all autoload dependencies.
  616%
  617%   @error existence_error(procedures, List) if undefined(true) is
  618%   in Options and there are undefined predicates.
  619
  620save_autoload(Options) :-
  621    option(autoload(true),  Options, true),
  622    !,
  623    autoload(Options).
  624save_autoload(_).
  625
  626
  627                 /*******************************
  628                 *             MODULES          *
  629                 *******************************/
  630
  631%!  save_module(+Module, +SaveClass)
  632%
  633%   Saves a module
  634
  635save_module(M, SaveClass) :-
  636    '$qlf_start_module'(M),
  637    feedback('~n~nMODULE ~w~n', [M]),
  638    save_unknown(M),
  639    (   P = (M:_H),
  640        current_predicate(_, P),
  641        \+ predicate_property(P, imported_from(_)),
  642        save_predicate(P, SaveClass),
  643        fail
  644    ;   '$qlf_end_part',
  645        feedback('~n', [])
  646    ).
  647
  648save_predicate(P, _SaveClass) :-
  649    predicate_property(P, foreign),
  650    !,
  651    P = (M:H),
  652    functor(H, Name, Arity),
  653    feedback('~npre-defining foreign ~w/~d ', [Name, Arity]),
  654    '$add_directive_wic'('$predefine_foreign'(M:Name/Arity)).
  655save_predicate(P, SaveClass) :-
  656    P = (M:H),
  657    functor(H, F, A),
  658    feedback('~nsaving ~w/~d ', [F, A]),
  659    (   H = resource(_,_,_),
  660        SaveClass \== development
  661    ->  save_attribute(P, (dynamic)),
  662        (   M == user
  663        ->  save_attribute(P, (multifile))
  664        ),
  665        feedback('(Skipped clauses)', []),
  666        fail
  667    ;   true
  668    ),
  669    (   no_save(P)
  670    ->  true
  671    ;   save_attributes(P),
  672        \+ predicate_property(P, (volatile)),
  673        (   nth_clause(P, _, Ref),
  674            feedback('.', []),
  675            '$qlf_assert_clause'(Ref, SaveClass),
  676            fail
  677        ;   true
  678        )
  679    ).
  680
  681no_save(P) :-
  682    predicate_property(P, volatile),
  683    \+ predicate_property(P, dynamic),
  684    \+ predicate_property(P, multifile).
  685
  686pred_attrib(meta_predicate(Term), Head, meta_predicate(M:Term)) :-
  687    !,
  688    strip_module(Head, M, _).
  689pred_attrib(Attrib, Head,
  690            '$set_predicate_attribute'(M:Name/Arity, AttName, Val)) :-
  691    attrib_name(Attrib, AttName, Val),
  692    strip_module(Head, M, Term),
  693    functor(Term, Name, Arity).
  694
  695attrib_name(dynamic,                dynamic,                true).
  696attrib_name(volatile,               volatile,               true).
  697attrib_name(thread_local,           thread_local,           true).
  698attrib_name(multifile,              multifile,              true).
  699attrib_name(public,                 public,                 true).
  700attrib_name(transparent,            transparent,            true).
  701attrib_name(discontiguous,          discontiguous,          true).
  702attrib_name(notrace,                trace,                  false).
  703attrib_name(show_childs,            hide_childs,            false).
  704attrib_name(built_in,               system,                 true).
  705attrib_name(nodebug,                hide_childs,            true).
  706attrib_name(quasi_quotation_syntax, quasi_quotation_syntax, true).
  707attrib_name(iso,                    iso,                    true).
  708
  709
  710save_attribute(P, Attribute) :-
  711    pred_attrib(Attribute, P, D),
  712    (   Attribute == built_in       % no need if there are clauses
  713    ->  (   predicate_property(P, number_of_clauses(0))
  714        ->  true
  715        ;   predicate_property(P, volatile)
  716        )
  717    ;   Attribute == 'dynamic'      % no need if predicate is thread_local
  718    ->  \+ predicate_property(P, thread_local)
  719    ;   true
  720    ),
  721    '$add_directive_wic'(D),
  722    feedback('(~w) ', [Attribute]).
  723
  724save_attributes(P) :-
  725    (   predicate_property(P, Attribute),
  726        save_attribute(P, Attribute),
  727        fail
  728    ;   true
  729    ).
  730
  731%       Save status of the unknown flag
  732
  733save_unknown(M) :-
  734    current_prolog_flag(M:unknown, Unknown),
  735    (   Unknown == error
  736    ->  true
  737    ;   '$add_directive_wic'(set_prolog_flag(M:unknown, Unknown))
  738    ).
  739
  740                 /*******************************
  741                 *            RECORDS           *
  742                 *******************************/
  743
  744save_records :-
  745    feedback('~nRECORDS~n', []),
  746    (   current_key(X),
  747        X \== '$topvar',                        % do not safe toplevel variables
  748        feedback('~n~t~8|~w ', [X, V]),
  749        recorded(X, V, _),
  750        feedback('.', []),
  751        '$add_directive_wic'(recordz(X, V, _)),
  752        fail
  753    ;   true
  754    ).
  755
  756
  757                 /*******************************
  758                 *            FLAGS             *
  759                 *******************************/
  760
  761save_flags :-
  762    feedback('~nFLAGS~n~n', []),
  763    (   current_flag(X),
  764        flag(X, V, V),
  765        feedback('~t~8|~w = ~w~n', [X, V]),
  766        '$add_directive_wic'(set_flag(X, V)),
  767        fail
  768    ;   true
  769    ).
  770
  771save_prompt :-
  772    feedback('~nPROMPT~n~n', []),
  773    prompt(Prompt, Prompt),
  774    '$add_directive_wic'(prompt(_, Prompt)).
  775
  776
  777                 /*******************************
  778                 *           IMPORTS            *
  779                 *******************************/
  780
  781%!  save_imports
  782%
  783%   Save  import  relations.  An  import  relation  is  saved  if  a
  784%   predicate is imported from a module that is not a default module
  785%   for the destination module. If  the   predicate  is  dynamic, we
  786%   always define the explicit import relation to make clear that an
  787%   assert must assert on the imported predicate.
  788
  789save_imports :-
  790    feedback('~nIMPORTS~n~n', []),
  791    (   predicate_property(M:H, imported_from(I)),
  792        \+ default_import(M, H, I),
  793        functor(H, F, A),
  794        feedback('~t~8|~w:~w/~d <-- ~w~n', [M, F, A, I]),
  795        '$add_directive_wic'(qsave:restore_import(M, I, F/A)),
  796        fail
  797    ;   true
  798    ).
  799
  800default_import(To, Head, From) :-
  801    '$get_predicate_attribute'(To:Head, (dynamic), 1),
  802    predicate_property(From:Head, exported),
  803    !,
  804    fail.
  805default_import(Into, _, From) :-
  806    default_module(Into, From).
  807
  808%!  restore_import(+TargetModule, +SourceModule, +PI) is det.
  809%
  810%   Restore import relation. This notably   deals  with imports from
  811%   the module =user=, avoiding a message  that the predicate is not
  812%   exported.
  813
  814restore_import(To, user, PI) :-
  815    !,
  816    export(user:PI),
  817    To:import(user:PI).
  818restore_import(To, From, PI) :-
  819    To:import(From:PI).
  820
  821                 /*******************************
  822                 *         PROLOG FLAGS         *
  823                 *******************************/
  824
  825save_prolog_flags :-
  826    feedback('~nPROLOG FLAGS~n~n', []),
  827    '$current_prolog_flag'(Flag, Value, _Scope, write, Type),
  828    \+ no_save_flag(Flag),
  829    feedback('~t~8|~w: ~w (type ~q)~n', [Flag, Value, Type]),
  830    '$add_directive_wic'(qsave:restore_prolog_flag(Flag, Value, Type)),
  831    fail.
  832save_prolog_flags.
  833
  834no_save_flag(argv).
  835no_save_flag(os_argv).
  836no_save_flag(access_level).
  837no_save_flag(tty_control).
  838no_save_flag(readline).
  839no_save_flag(associated_file).
  840no_save_flag(cpu_count).
  841no_save_flag(hwnd).                     % should be read-only, but comes
  842                                        % from user-code
  843
  844%!  restore_prolog_flag(+Name, +Value, +Type)
  845%
  846%   Deal  with  possibly   protected    flags   (debug_on_error  and
  847%   report_error are protected flags for the runtime kernel).
  848
  849restore_prolog_flag(Flag, Value, _Type) :-
  850    current_prolog_flag(Flag, Value),
  851    !.
  852restore_prolog_flag(Flag, Value, _Type) :-
  853    current_prolog_flag(Flag, _),
  854    !,
  855    catch(set_prolog_flag(Flag, Value), _, true).
  856restore_prolog_flag(Flag, Value, Type) :-
  857    create_prolog_flag(Flag, Value, [type(Type)]).
  858
  859
  860                 /*******************************
  861                 *           OPERATORS          *
  862                 *******************************/
  863
  864%!  save_operators(+Options) is det.
  865%
  866%   Save operators for all modules.   Operators for =system= are
  867%   not saved because these are read-only anyway.
  868
  869save_operators(Options) :-
  870    !,
  871    option(op(save), Options, save),
  872    feedback('~nOPERATORS~n', []),
  873    forall(current_module(M), save_module_operators(M)),
  874    feedback('~n', []).
  875save_operators(_).
  876
  877save_module_operators(system) :- !.
  878save_module_operators(M) :-
  879    forall('$local_op'(P,T,M:N),
  880           (   feedback('~n~t~8|~w ', [op(P,T,M:N)]),
  881               '$add_directive_wic'(op(P,T,M:N))
  882           )).
  883
  884
  885                 /*******************************
  886                 *       FORMAT PREDICATES      *
  887                 *******************************/
  888
  889save_format_predicates :-
  890    feedback('~nFORMAT PREDICATES~n', []),
  891    current_format_predicate(Code, Head),
  892    qualify_head(Head, QHead),
  893    D = format_predicate(Code, QHead),
  894    feedback('~n~t~8|~w ', [D]),
  895    '$add_directive_wic'(D),
  896    fail.
  897save_format_predicates.
  898
  899qualify_head(T, T) :-
  900    functor(T, :, 2),
  901    !.
  902qualify_head(T, user:T).
  903
  904
  905                 /*******************************
  906                 *       FOREIGN LIBRARIES      *
  907                 *******************************/
  908
  909%!  save_foreign_libraries(+Archive, +Options) is det.
  910%
  911%   Save current foreign libraries into the archive.
  912
  913save_foreign_libraries(RC, Options) :-
  914    option(foreign(save), Options),
  915    !,
  916    current_prolog_flag(arch, HostArch),
  917    feedback('~nHOST(~w) FOREIGN LIBRARIES~n', [HostArch]),
  918    save_foreign_libraries1(HostArch, RC, Options).
  919save_foreign_libraries(RC, Options) :-
  920    option(foreign(arch(Archs)), Options),
  921    !,
  922    forall(member(Arch, Archs),
  923           ( feedback('~n~w FOREIGN LIBRARIES~n', [Arch]),
  924             save_foreign_libraries1(Arch, RC, Options)
  925           )).
  926save_foreign_libraries(_, _).
  927
  928save_foreign_libraries1(Arch, RC, _Options) :-
  929    forall(current_foreign_library(FileSpec, _Predicates),
  930           ( find_foreign_library(Arch, FileSpec, EntryName, File, Time),
  931             term_to_atom(EntryName, Name),
  932             zipper_append_file(RC, Name, File, [time(Time)])
  933           )).
  934
  935%!  find_foreign_library(+Architecture, +FileSpec, -EntryName, -File, -Time)
  936%!								is det.
  937%
  938%   Find  the  shared  object  specified  by   FileSpec  for  the  named
  939%   Architecture. EntryName will be the  name   of  the  file within the
  940%   saved state archive. If posible, the   shared  object is stripped to
  941%   reduce its size. This  is  achieved   by  calling  =|strip  -o <tmp>
  942%   <shared-object>|=. Note that (if stripped) the  file is a Prolog tmp
  943%   file and will be deleted on halt.
  944%
  945%   @bug    Should perform OS search on failure
  946
  947find_foreign_library(Arch, FileSpec, shlib(Arch,Name), SharedObject, Time) :-
  948    FileSpec = foreign(Name),
  949    (   catch(arch_find_shlib(Arch, FileSpec, File),
  950              E,
  951              print_message(error, E)),
  952        exists_file(File)
  953    ->  true
  954    ;   throw(error(existence_error(architecture_shlib(Arch), FileSpec),_))
  955    ),
  956    time_file(File, Time),
  957    strip_file(File, SharedObject).
  958
  959%!  strip_file(+File, -Stripped) is det.
  960%
  961%   Try to strip File. Unify Stripped with   File if stripping fails for
  962%   some reason.
  963
  964strip_file(File, Stripped) :-
  965    absolute_file_name(path(strip), Strip,
  966                       [ access(execute),
  967                         file_errors(fail)
  968                       ]),
  969    tmp_file(shared, Stripped),
  970    (   catch(do_strip_file(Strip, File, Stripped), E,
  971              (print_message(warning, E), fail))
  972    ->  true
  973    ;   print_message(warning, qsave(strip_failed(File))),
  974        fail
  975    ),
  976    !.
  977strip_file(File, File).
  978
  979do_strip_file(Strip, File, Stripped) :-
  980    format(atom(Cmd), '"~w" -o "~w" "~w"',
  981           [Strip, Stripped, File]),
  982    shell(Cmd),
  983    exists_file(Stripped).
  984
  985%!  qsave:arch_shlib(+Architecture, +FileSpec, -File) is det.
  986%
  987%   This is a user defined hook called by qsave_program/2. It is used to
  988%   find a shared library  for  the   specified  Architecture,  named by
  989%   FileSpec. FileSpec is of  the   form  foreign(Name), a specification
  990%   usable by absolute_file_name/2. The predicate should unify File with
  991%   the absolute path for the  shared   library  that corresponds to the
  992%   specified Architecture.
  993%
  994%   If  this  predicate  fails  to  find    a  file  for  the  specified
  995%   architecture an `existence_error` is thrown.
  996
  997:- multifile arch_shlib/3.  998
  999arch_find_shlib(Arch, FileSpec, File) :-
 1000    arch_shlib(Arch, FileSpec, File),
 1001    !.
 1002arch_find_shlib(Arch, FileSpec, File) :-
 1003    current_prolog_flag(arch, Arch),
 1004    absolute_file_name(FileSpec,
 1005                       [ file_type(executable),
 1006                         access(read),
 1007                         file_errors(fail)
 1008                       ], File).
 1009
 1010
 1011                 /*******************************
 1012                 *             UTIL             *
 1013                 *******************************/
 1014
 1015open_map(Options) :-
 1016    option(map(Map), Options),
 1017    !,
 1018    open(Map, write, Fd),
 1019    asserta(verbose(Fd)).
 1020open_map(_) :-
 1021    retractall(verbose(_)).
 1022
 1023close_map :-
 1024    retract(verbose(Fd)),
 1025    close(Fd),
 1026    !.
 1027close_map.
 1028
 1029feedback(Fmt, Args) :-
 1030    verbose(Fd),
 1031    !,
 1032    format(Fd, Fmt, Args).
 1033feedback(_, _).
 1034
 1035
 1036check_options([]) :- !.
 1037check_options([Var|_]) :-
 1038    var(Var),
 1039    !,
 1040    throw(error(domain_error(save_options, Var), _)).
 1041check_options([Name=Value|T]) :-
 1042    !,
 1043    (   save_option(Name, Type, _Comment)
 1044    ->  (   must_be(Type, Value)
 1045        ->  check_options(T)
 1046        ;   throw(error(domain_error(Type, Value), _))
 1047        )
 1048    ;   throw(error(domain_error(save_option, Name), _))
 1049    ).
 1050check_options([Term|T]) :-
 1051    Term =.. [Name,Arg],
 1052    !,
 1053    check_options([Name=Arg|T]).
 1054check_options([Var|_]) :-
 1055    throw(error(domain_error(save_options, Var), _)).
 1056check_options(Opt) :-
 1057    throw(error(domain_error(list, Opt), _)).
 1058
 1059
 1060%!  zipper_append_file(+Zipper, +Name, +File, +Options) is det.
 1061%
 1062%   Append the content of File under Name to the open Zipper.
 1063
 1064zipper_append_file(_, Name, _, _) :-
 1065    saved_resource_file(Name),
 1066    !.
 1067zipper_append_file(_, _, File, _) :-
 1068    source_file(File),
 1069    !.
 1070zipper_append_file(Zipper, Name, File, Options) :-
 1071    (   option(time(_), Options)
 1072    ->  Options1 = Options
 1073    ;   time_file(File, Stamp),
 1074        Options1 = [time(Stamp)|Options]
 1075    ),
 1076    setup_call_cleanup(
 1077        open(File, read, In, [type(binary)]),
 1078        setup_call_cleanup(
 1079            zipper_open_new_file_in_zip(Zipper, Name, Out, Options1),
 1080            copy_stream_data(In, Out),
 1081            close(Out)),
 1082        close(In)),
 1083    assertz(saved_resource_file(Name)).
 1084
 1085%!  zipper_add_directory(+Zipper, +Name, +Dir, +Options) is det.
 1086%
 1087%   Add a directory entry. Dir  is  only   used  if  there  is no option
 1088%   time(Stamp).
 1089
 1090zipper_add_directory(Zipper, Name, Dir, Options) :-
 1091    (   option(time(Stamp), Options)
 1092    ->  true
 1093    ;   time_file(Dir, Stamp)
 1094    ),
 1095    atom_concat(Name, /, DirName),
 1096    (   saved_resource_file(DirName)
 1097    ->  true
 1098    ;   setup_call_cleanup(
 1099            zipper_open_new_file_in_zip(Zipper, DirName, Out,
 1100                                        [ method(store),
 1101                                          time(Stamp)
 1102                                        | Options
 1103                                        ]),
 1104            true,
 1105            close(Out)),
 1106        assertz(saved_resource_file(DirName))
 1107    ).
 1108
 1109add_parent_dirs(Zipper, Name, Dir, Options) :-
 1110    (   option(time(Stamp), Options)
 1111    ->  true
 1112    ;   time_file(Dir, Stamp)
 1113    ),
 1114    file_directory_name(Name, Parent),
 1115    (   Parent \== Name
 1116    ->  add_parent_dirs(Zipper, Parent, [time(Stamp)|Options])
 1117    ;   true
 1118    ).
 1119
 1120add_parent_dirs(_, '.', _) :-
 1121    !.
 1122add_parent_dirs(Zipper, Name, Options) :-
 1123    zipper_add_directory(Zipper, Name, _, Options),
 1124    file_directory_name(Name, Parent),
 1125    (   Parent \== Name
 1126    ->  add_parent_dirs(Zipper, Parent, Options)
 1127    ;   true
 1128    ).
 1129
 1130
 1131%!  zipper_append_directory(+Zipper, +Name, +Dir, +Options) is det.
 1132%
 1133%   Append the content of  Dir  below   Name  in  the  resource archive.
 1134%   Options:
 1135%
 1136%     - include(+Patterns)
 1137%     Only add entries that match an element from Patterns using
 1138%     wildcard_match/2.
 1139%     - exclude(+Patterns)
 1140%     Ignore entries that match an element from Patterns using
 1141%     wildcard_match/2.
 1142%
 1143%   @tbd Process .gitignore.  There also seem to exists other
 1144%   standards for this.
 1145
 1146zipper_append_directory(Zipper, Name, Dir, Options) :-
 1147    exists_directory(Dir),
 1148    !,
 1149    add_parent_dirs(Zipper, Name, Dir, Options),
 1150    zipper_add_directory(Zipper, Name, Dir, Options),
 1151    directory_files(Dir, Members),
 1152    forall(member(M, Members),
 1153           (   reserved(M)
 1154           ->  true
 1155           ;   ignored(M, Options)
 1156           ->  true
 1157           ;   atomic_list_concat([Dir,M], /, Entry),
 1158               atomic_list_concat([Name,M], /, Store),
 1159               catch(zipper_append_directory(Zipper, Store, Entry, Options),
 1160                     E,
 1161                     print_message(warning, E))
 1162           )).
 1163zipper_append_directory(Zipper, Name, File, Options) :-
 1164    zipper_append_file(Zipper, Name, File, Options).
 1165
 1166reserved(.).
 1167reserved(..).
 1168
 1169%!  ignored(+File, +Options) is semidet.
 1170%
 1171%   Ignore File if there is an  include(Patterns) option that does *not*
 1172%   match File or an exclude(Patterns) that does match File.
 1173
 1174ignored(File, Options) :-
 1175    option(include(Patterns), Options),
 1176    \+ ( (   is_list(Patterns)
 1177         ->  member(Pattern, Patterns)
 1178         ;   Pattern = Patterns
 1179         ),
 1180         wildcard_match(Pattern, File)
 1181       ),
 1182    !.
 1183ignored(File, Options) :-
 1184    option(exclude(Patterns), Options),
 1185    (   is_list(Patterns)
 1186    ->  member(Pattern, Patterns)
 1187    ;   Pattern = Patterns
 1188    ),
 1189    wildcard_match(Pattern, File),
 1190    !.
 1191
 1192
 1193                /********************************
 1194                *     SAVED STATE GENERATION    *
 1195                *********************************/
 1196
 1197%!  qsave_toplevel
 1198%
 1199%   Called to handle `-c file` compilaton.
 1200
 1201:- public
 1202    qsave_toplevel/0. 1203
 1204qsave_toplevel :-
 1205    current_prolog_flag(os_argv, Argv),
 1206    qsave_options(Argv, Files, Options),
 1207    '$cmd_option_val'(compileout, Out),
 1208    user:consult(Files),
 1209    user:qsave_program(Out, Options).
 1210
 1211qsave_options([], [], []).
 1212qsave_options([--|_], [], []) :-
 1213    !.
 1214qsave_options(['-c'|T0], Files, Options) :-
 1215    !,
 1216    argv_files(T0, T1, Files, FilesT),
 1217    qsave_options(T1, FilesT, Options).
 1218qsave_options([O|T0], Files, [Option|T]) :-
 1219    string_concat("--", Opt, O),
 1220    split_string(Opt, "=", "", [NameS|Rest]),
 1221    atom_string(Name, NameS),
 1222    qsave_option(Name, OptName, Rest, Value),
 1223    !,
 1224    Option =.. [OptName, Value],
 1225    qsave_options(T0, Files, T).
 1226qsave_options([_|T0], Files, T) :-
 1227    qsave_options(T0, Files, T).
 1228
 1229argv_files([], [], Files, Files).
 1230argv_files([H|T], [H|T], Files, Files) :-
 1231    sub_atom(H, 0, _, _, -),
 1232    !.
 1233argv_files([H|T0], T, [H|Files0], Files) :-
 1234    argv_files(T0, T, Files0, Files).
 1235
 1236%!  qsave_option(+Name, +ValueStrings, -Value) is semidet.
 1237
 1238qsave_option(Name, Name, [], true) :-
 1239    save_option(Name, boolean, _),
 1240    !.
 1241qsave_option(NoName, Name, [], false) :-
 1242    atom_concat('no-', Name, NoName),
 1243    save_option(Name, boolean, _),
 1244    !.
 1245qsave_option(Name, Name, ValueStrings, Value) :-
 1246    save_option(Name, Type, _),
 1247    !,
 1248    atomics_to_string(ValueStrings, "=", ValueString),
 1249    convert_option_value(Type, ValueString, Value).
 1250qsave_option(Name, Name, _Chars, _Value) :-
 1251    existence_error(save_option, Name).
 1252
 1253convert_option_value(integer, String, Value) :-
 1254    (   number_string(Value, String)
 1255    ->  true
 1256    ;   domain_error(integer, String)
 1257    ).
 1258convert_option_value(callable, String, Value) :-
 1259    term_string(Value, String).
 1260convert_option_value(atom, String, Value) :-
 1261    atom_string(Value, String).
 1262convert_option_value(boolean, String, Value) :-
 1263    atom_string(Value, String).
 1264convert_option_value(oneof(_), String, Value) :-
 1265    atom_string(Value, String).
 1266convert_option_value(ground, String, Value) :-
 1267    atom_string(Value, String).
 1268convert_option_value(qsave_foreign_option, "save", save).
 1269convert_option_value(qsave_foreign_option, StrArchList, arch(ArchList)) :-
 1270    split_string(StrArchList, ",", ", \t", StrArchList1),
 1271    maplist(atom_string, ArchList, StrArchList1).
 1272
 1273
 1274                 /*******************************
 1275                 *            MESSAGES          *
 1276                 *******************************/
 1277
 1278:- multifile prolog:message/3. 1279
 1280prolog:message(no_resource(Name, File)) -->
 1281    [ 'Could not find resource ~w on ~w or system resources'-
 1282      [Name, File] ].
 1283prolog:message(qsave(nondet)) -->
 1284    [ 'qsave_program/2 succeeded with a choice point'-[] ]