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