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