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