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-2022, 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 stand_alone(Options), 224 !, 225 emulator(Emulator, Options), 226 setup_call_cleanup( 227 open(Emulator, read, In, [type(binary)]), 228 copy_stream_data(In, Out), 229 close(In)). 230make_header(Out, SaveClass, Options) :- 231 current_prolog_flag(unix, true), 232 !, 233 emulator(Emulator, Options), 234 current_prolog_flag(posix_shell, Shell), 235 format(Out, '#!~w~n', [Shell]), 236 format(Out, '# SWI-Prolog saved state~n', []), 237 ( SaveClass == runtime 238 -> ArgSep = ' -- ' 239 ; ArgSep = ' ' 240 ), 241 format(Out, 'exec ${SWIPL:-~w} -x "$0"~w"$@"~n~n', [Emulator, ArgSep]). 242make_header(_, _, _). 243 244stand_alone(Options) :- 245 ( current_prolog_flag(windows, true) 246 -> DefStandAlone = true 247 ; DefStandAlone = false 248 ), 249 option(stand_alone(true), Options, DefStandAlone). 250 251emulator(Emulator, Options) :- 252 ( option(emulator(OptVal), Options) 253 -> absolute_file_name(OptVal, [access(read)], Emulator) 254 ; current_prolog_flag(executable, Emulator) 255 ). 256 257 258 259 /******************************* 260 * OPTIONS * 261 *******************************/ 262 263min_stack(stack_limit, 100_000). 264 265convert_option(Stack, Val, NewVal, '~w') :- % stack-sizes are in K-bytes 266 min_stack(Stack, Min), 267 !, 268 ( Val == 0 269 -> NewVal = Val 270 ; NewVal is max(Min, Val) 271 ). 272convert_option(toplevel, Callable, Callable, '~q') :- !. 273convert_option(_, Value, Value, '~w'). 274 275doption(Name) :- min_stack(Name, _). 276doption(init_file). 277doption(system_init_file). 278doption(class). 279doption(home). 280doption(nosignals).
The script files (-s script) are not saved at all. I think this is fine to avoid a save-script loading itself.
291save_options(RC, SaveClass, Options) :-
292 zipper_open_new_file_in_zip(RC, '$prolog/options.txt', Fd, []),
293 ( doption(OptionName),
294 ( OptTerm =.. [OptionName,OptionVal2],
295 option(OptTerm, Options)
296 -> convert_option(OptionName, OptionVal2, OptionVal, FmtVal)
297 ; '$cmd_option_val'(OptionName, OptionVal0),
298 save_option_value(SaveClass, OptionName, OptionVal0, OptionVal1),
299 OptionVal = OptionVal1,
300 FmtVal = '~w'
301 ),
302 atomics_to_string(['~w=', FmtVal, '~n'], Fmt),
303 format(Fd, Fmt, [OptionName, OptionVal]),
304 fail
305 ; true
306 ),
307 save_init_goals(Fd, Options),
308 close(Fd).312save_option_value(Class, class, _, Class) :- !. 313save_option_value(runtime, home, _, _) :- !, fail. 314save_option_value(_, _, Value, Value).
goal(Goal) option, use
that, else save the goals from '$cmd_option_val'/2.321save_init_goals(Out, Options) :- 322 option(goal(Goal), Options), 323 !, 324 format(Out, 'goal=~q~n', [Goal]), 325 save_toplevel_goal(Out, halt, Options). 326save_init_goals(Out, Options) :- 327 '$cmd_option_val'(goals, Goals), 328 forall(member(Goal, Goals), 329 format(Out, 'goal=~w~n', [Goal])), 330 ( Goals == [] 331 -> DefToplevel = default 332 ; DefToplevel = halt 333 ), 334 save_toplevel_goal(Out, DefToplevel, Options). 335 336save_toplevel_goal(Out, _Default, Options) :- 337 option(toplevel(Goal), Options), 338 !, 339 unqualify_reserved_goal(Goal, Goal1), 340 format(Out, 'toplevel=~q~n', [Goal1]). 341save_toplevel_goal(Out, _Default, _Options) :- 342 '$cmd_option_val'(toplevel, Toplevel), 343 Toplevel \== default, 344 !, 345 format(Out, 'toplevel=~w~n', [Toplevel]). 346save_toplevel_goal(Out, Default, _Options) :- 347 format(Out, 'toplevel=~q~n', [Default]). 348 349unqualify_reserved_goal(_:prolog, prolog) :- !. 350unqualify_reserved_goal(_:default, default) :- !. 351unqualify_reserved_goal(Goal, Goal). 352 353 354 /******************************* 355 * RESOURCES * 356 *******************************/ 357 358save_resources(_RC, development) :- !. 359save_resources(RC, _SaveClass) :- 360 feedback('~nRESOURCES~n~n', []), 361 copy_resources(RC), 362 forall(declared_resource(Name, FileSpec, Options), 363 save_resource(RC, Name, FileSpec, Options)). 364 365declared_resource(RcName, FileSpec, []) :- 366 current_predicate(_, M:resource(_,_)), 367 M:resource(Name, FileSpec), 368 mkrcname(M, Name, RcName). 369declared_resource(RcName, FileSpec, Options) :- 370 current_predicate(_, M:resource(_,_,_)), 371 M:resource(Name, A2, A3), 372 ( is_list(A3) 373 -> FileSpec = A2, 374 Options = A3 375 ; FileSpec = A3 376 ), 377 mkrcname(M, Name, RcName).
383mkrcname(user, Name0, Name) :- 384 !, 385 path_segments_to_atom(Name0, Name). 386mkrcname(M, Name0, RcName) :- 387 path_segments_to_atom(Name0, Name), 388 atomic_list_concat([M, :, Name], RcName). 389 390path_segments_to_atom(Name0, Name) :- 391 phrase(segments_to_atom(Name0), Atoms), 392 atomic_list_concat(Atoms, /, Name). 393 394segments_to_atom(Var) --> 395 { var(Var), !, 396 instantiation_error(Var) 397 }. 398segments_to_atom(A/B) --> 399 !, 400 segments_to_atom(A), 401 segments_to_atom(B). 402segments_to_atom(A) --> 403 [A].
409save_resource(RC, Name, FileSpec, _Options) :- 410 absolute_file_name(FileSpec, 411 [ access(read), 412 file_errors(fail) 413 ], File), 414 !, 415 feedback('~t~8|~w~t~32|~w~n', 416 [Name, File]), 417 zipper_append_file(RC, Name, File, []). 418save_resource(RC, Name, FileSpec, Options) :- 419 findall(Dir, 420 absolute_file_name(FileSpec, Dir, 421 [ access(read), 422 file_type(directory), 423 file_errors(fail), 424 solutions(all) 425 ]), 426 Dirs), 427 Dirs \== [], 428 !, 429 forall(member(Dir, Dirs), 430 ( feedback('~t~8|~w~t~32|~w~n', 431 [Name, Dir]), 432 zipper_append_directory(RC, Name, Dir, Options))). 433save_resource(RC, Name, _, _Options) :- 434 '$rc_handle'(SystemRC), 435 copy_resource(SystemRC, RC, Name), 436 !. 437save_resource(_, Name, FileSpec, _Options) :- 438 print_message(warning, 439 error(existence_error(resource, 440 resource(Name, FileSpec)), 441 _)). 442 443copy_resources(ToRC) :- 444 '$rc_handle'(FromRC), 445 zipper_members(FromRC, List), 446 ( member(Name, List), 447 \+ declared_resource(Name, _, _), 448 \+ reserved_resource(Name), 449 copy_resource(FromRC, ToRC, Name), 450 fail 451 ; true 452 ). 453 454reserved_resource('$prolog/state.qlf'). 455reserved_resource('$prolog/options.txt'). 456 457copy_resource(FromRC, ToRC, Name) :- 458 ( zipper_goto(FromRC, file(Name)) 459 -> true 460 ; existence_error(resource, Name) 461 ), 462 zipper_file_info(FromRC, _Name, Attrs), 463 get_dict(time, Attrs, Time), 464 setup_call_cleanup( 465 zipper_open_current(FromRC, FdIn, 466 [ type(binary), 467 time(Time) 468 ]), 469 setup_call_cleanup( 470 zipper_open_new_file_in_zip(ToRC, Name, FdOut, []), 471 ( feedback('~t~8|~w~t~24|~w~n', 472 [Name, '<Copied from running state>']), 473 copy_stream_data(FdIn, FdOut) 474 ), 475 close(FdOut)), 476 close(FdIn)). 477 478 479 /******************************* 480 * OBFUSCATE * 481 *******************************/
487:- multifile prolog:obfuscate_identifiers/1. 488 489create_mapping(Options) :- 490 option(obfuscate(true), Options), 491 !, 492 ( predicate_property(prolog:obfuscate_identifiers(_), number_of_clauses(N)), 493 N > 0 494 -> true 495 ; use_module(library(obfuscate)) 496 ), 497 ( catch(prolog:obfuscate_identifiers(Options), E, 498 print_message(error, E)) 499 -> true 500 ; print_message(warning, failed(obfuscate_identifiers)) 501 ). 502create_mapping(_).
runtime, lock all files such that when running the
program the system stops checking existence and modification time on
the filesystem.
512lock_files(runtime) :- 513 !, 514 '$set_source_files'(system). % implies from_state 515lock_files(_) :- 516 '$set_source_files'(from_state).
522save_program(RC, SaveClass, Options) :- 523 setup_call_cleanup( 524 ( zipper_open_new_file_in_zip(RC, '$prolog/state.qlf', StateFd, 525 [ zip64(true) 526 ]), 527 current_prolog_flag(access_level, OldLevel), 528 set_prolog_flag(access_level, system), % generate system modules 529 '$open_wic'(StateFd, Options) 530 ), 531 ( create_mapping(Options), 532 save_modules(SaveClass), 533 save_records, 534 save_flags, 535 save_prompt, 536 save_imports, 537 save_prolog_flags(Options), 538 save_operators(Options), 539 save_format_predicates 540 ), 541 ( '$close_wic', 542 set_prolog_flag(access_level, OldLevel), 543 close(StateFd) 544 )). 545 546 547 /******************************* 548 * MODULES * 549 *******************************/ 550 551save_modules(SaveClass) :- 552 forall(special_module(X), 553 save_module(X, SaveClass)), 554 forall((current_module(X), \+ special_module(X)), 555 save_module(X, SaveClass)). 556 557special_module(system). 558special_module(user).
567prepare_entry_points(Options) :- 568 define_init_goal(Options), 569 define_toplevel_goal(Options). 570 571define_init_goal(Options) :- 572 option(goal(Goal), Options), 573 !, 574 entry_point(Goal). 575define_init_goal(_). 576 577define_toplevel_goal(Options) :- 578 option(toplevel(Goal), Options), 579 !, 580 entry_point(Goal). 581define_toplevel_goal(_). 582 583entry_point(Goal) :- 584 define_predicate(Goal), 585 ( \+ predicate_property(Goal, built_in), 586 \+ predicate_property(Goal, imported_from(_)) 587 -> goal_pi(Goal, PI), 588 public(PI) 589 ; true 590 ). 591 592define_predicate(Head) :- 593 '$define_predicate'(Head), 594 !. % autoloader 595define_predicate(Head) :- 596 strip_module(Head, _, Term), 597 functor(Term, Name, Arity), 598 throw(error(existence_error(procedure, Name/Arity), _)). 599 600goal_pi(M:G, QPI) :- 601 !, 602 strip_module(M:G, Module, Goal), 603 functor(Goal, Name, Arity), 604 QPI = Module:Name/Arity. 605goal_pi(Goal, Name/Arity) :- 606 functor(Goal, Name, Arity).
prepare_state registered
initialization hooks.613prepare_state(_) :- 614 forall('$init_goal'(when(prepare_state), Goal, Ctx), 615 run_initialize(Goal, Ctx)). 616 617run_initialize(Goal, Ctx) :- 618 ( catch(Goal, E, true), 619 ( var(E) 620 -> true 621 ; throw(error(initialization_error(E, Goal, Ctx), _)) 622 ) 623 ; throw(error(initialization_error(failed, Goal, Ctx), _)) 624 ). 625 626 627 /******************************* 628 * AUTOLOAD * 629 *******************************/
638save_autoload(Options) :- 639 option(autoload(true), Options, true), 640 !, 641 setup_call_cleanup( 642 current_prolog_flag(autoload, Old), 643 autoload_all(Options), 644 set_prolog_flag(autoload, Old)). 645save_autoload(_). 646 647 648 /******************************* 649 * MODULES * 650 *******************************/
656save_module(M, SaveClass) :- 657 '$qlf_start_module'(M), 658 feedback('~n~nMODULE ~w~n', [M]), 659 save_unknown(M), 660 ( P = (M:_H), 661 current_predicate(_, P), 662 \+ predicate_property(P, imported_from(_)), 663 save_predicate(P, SaveClass), 664 fail 665 ; '$qlf_end_part', 666 feedback('~n', []) 667 ). 668 669save_predicate(P, _SaveClass) :- 670 predicate_property(P, foreign), 671 !, 672 P = (M:H), 673 functor(H, Name, Arity), 674 feedback('~npre-defining foreign ~w/~d ', [Name, Arity]), 675 '$add_directive_wic'('$predefine_foreign'(M:Name/Arity)), 676 save_attributes(P). 677save_predicate(P, SaveClass) :- 678 P = (M:H), 679 functor(H, F, A), 680 feedback('~nsaving ~w/~d ', [F, A]), 681 ( ( H = resource(_,_) 682 ; H = resource(_,_,_) 683 ) 684 -> ( SaveClass == development 685 -> true 686 ; save_attribute(P, (dynamic)), 687 ( M == user 688 -> save_attribute(P, (multifile)) 689 ), 690 feedback('(Skipped clauses)', []), 691 fail 692 ) 693 ; true 694 ), 695 ( no_save(P) 696 -> true 697 ; save_attributes(P), 698 \+ predicate_property(P, (volatile)), 699 ( nth_clause(P, _, Ref), 700 feedback('.', []), 701 '$qlf_assert_clause'(Ref, SaveClass), 702 fail 703 ; true 704 ) 705 ). 706 707no_save(P) :- 708 predicate_property(P, volatile), 709 \+ predicate_property(P, dynamic), 710 \+ predicate_property(P, multifile). 711 712pred_attrib(meta_predicate(Term), Head, meta_predicate(M:Term)) :- 713 !, 714 strip_module(Head, M, _). 715pred_attrib(Attrib, Head, 716 '$set_predicate_attribute'(M:Name/Arity, AttName, Val)) :- 717 attrib_name(Attrib, AttName, Val), 718 strip_module(Head, M, Term), 719 functor(Term, Name, Arity). 720 721attrib_name(dynamic, dynamic, true). 722attrib_name(volatile, volatile, true). 723attrib_name(thread_local, thread_local, true). 724attrib_name(multifile, multifile, true). 725attrib_name(public, public, true). 726attrib_name(transparent, transparent, true). 727attrib_name(discontiguous, discontiguous, true). 728attrib_name(notrace, trace, false). 729attrib_name(show_childs, hide_childs, false). 730attrib_name(built_in, system, true). 731attrib_name(nodebug, hide_childs, true). 732attrib_name(quasi_quotation_syntax, quasi_quotation_syntax, true). 733attrib_name(iso, iso, true). 734 735 736save_attribute(P, Attribute) :- 737 pred_attrib(Attribute, P, D), 738 ( Attribute == built_in % no need if there are clauses 739 -> ( predicate_property(P, number_of_clauses(0)) 740 -> true 741 ; predicate_property(P, volatile) 742 ) 743 ; Attribute == (dynamic) % no need if predicate is thread_local 744 -> \+ predicate_property(P, thread_local) 745 ; true 746 ), 747 '$add_directive_wic'(D), 748 feedback('(~w) ', [Attribute]). 749 750save_attributes(P) :- 751 ( predicate_property(P, Attribute), 752 save_attribute(P, Attribute), 753 fail 754 ; true 755 ). 756 757% Save status of the unknown flag 758 759save_unknown(M) :- 760 current_prolog_flag(Munknown, Unknown), 761 ( Unknown == error 762 -> true 763 ; '$add_directive_wic'(set_prolog_flag(Munknown, Unknown)) 764 ). 765 766 /******************************* 767 * RECORDS * 768 *******************************/ 769 770save_records :- 771 feedback('~nRECORDS~n', []), 772 ( current_key(X), 773 X \== '$topvar', % do not safe toplevel variables 774 feedback('~n~t~8|~w ', [X]), 775 recorded(X, V, _), 776 feedback('.', []), 777 '$add_directive_wic'(recordz(X, V, _)), 778 fail 779 ; true 780 ). 781 782 783 /******************************* 784 * FLAGS * 785 *******************************/ 786 787save_flags :- 788 feedback('~nFLAGS~n~n', []), 789 ( current_flag(X), 790 flag(X, V, V), 791 feedback('~t~8|~w = ~w~n', [X, V]), 792 '$add_directive_wic'(set_flag(X, V)), 793 fail 794 ; true 795 ). 796 797save_prompt :- 798 feedback('~nPROMPT~n~n', []), 799 prompt(Prompt, Prompt), 800 '$add_directive_wic'(prompt(_, Prompt)). 801 802 803 /******************************* 804 * IMPORTS * 805 *******************************/
815save_imports :- 816 feedback('~nIMPORTS~n~n', []), 817 ( predicate_property(M:H, imported_from(I)), 818 \+ default_import(M, H, I), 819 functor(H, F, A), 820 feedback('~t~8|~w:~w/~d <-- ~w~n', [M, F, A, I]), 821 '$add_directive_wic'(qsave:restore_import(M, I, F/A)), 822 fail 823 ; true 824 ). 825 826default_import(To, Head, From) :- 827 '$get_predicate_attribute'(To:Head, (dynamic), 1), 828 predicate_property(From:Head, exported), 829 !, 830 fail. 831default_import(Into, _, From) :- 832 default_module(Into, From).
user, avoiding a message that the predicate is not
exported.840restore_import(To, user, PI) :- 841 !, 842 export(user:PI), 843 To:import(user:PI). 844restore_import(To, From, PI) :- 845 To:import(From:PI). 846 847 /******************************* 848 * PROLOG FLAGS * 849 *******************************/ 850 851save_prolog_flags(Options) :- 852 feedback('~nPROLOG FLAGS~n~n', []), 853 '$current_prolog_flag'(Flag, Value0, _Scope, write, Type), 854 \+ no_save_flag(Flag), 855 map_flag(Flag, Value0, Value, Options), 856 feedback('~t~8|~w: ~w (type ~q)~n', [Flag, Value, Type]), 857 '$add_directive_wic'(qsave:restore_prolog_flag(Flag, Value, Type)), 858 fail. 859save_prolog_flags(_). 860 861no_save_flag(argv). 862no_save_flag(os_argv). 863no_save_flag(access_level). 864no_save_flag(tty_control). 865no_save_flag(readline). 866no_save_flag(associated_file). 867no_save_flag(cpu_count). 868no_save_flag(tmp_dir). 869no_save_flag(file_name_case_handling). 870no_save_flag(hwnd). % should be read-only, but comes 871 % from user-code 872map_flag(autoload, true, false, Options) :- 873 option(class(runtime), Options, runtime), 874 option(autoload(true), Options, true), 875 !. 876map_flag(_, Value, Value, _).
884restore_prolog_flag(Flag, Value, _Type) :- 885 current_prolog_flag(Flag, Value), 886 !. 887restore_prolog_flag(Flag, Value, _Type) :- 888 current_prolog_flag(Flag, _), 889 !, 890 catch(set_prolog_flag(Flag, Value), _, true). 891restore_prolog_flag(Flag, Value, Type) :- 892 create_prolog_flag(Flag, Value, [type(Type)]). 893 894 895 /******************************* 896 * OPERATORS * 897 *******************************/
system are
not saved because these are read-only anyway.904save_operators(Options) :- 905 !, 906 option(op(save), Options, save), 907 feedback('~nOPERATORS~n', []), 908 forall(current_module(M), save_module_operators(M)), 909 feedback('~n', []). 910save_operators(_). 911 912save_module_operators(system) :- !. 913save_module_operators(M) :- 914 forall('$local_op'(P,T,M:N), 915 ( feedback('~n~t~8|~w ', [op(P,T,M:N)]), 916 '$add_directive_wic'(op(P,T,M:N)) 917 )). 918 919 920 /******************************* 921 * FORMAT PREDICATES * 922 *******************************/ 923 924save_format_predicates :- 925 feedback('~nFORMAT PREDICATES~n', []), 926 current_format_predicate(Code, Head), 927 qualify_head(Head, QHead), 928 D = format_predicate(Code, QHead), 929 feedback('~n~t~8|~w ', [D]), 930 '$add_directive_wic'(D), 931 fail. 932save_format_predicates. 933 934qualify_head(T, T) :- 935 functor(T, :, 2), 936 !. 937qualify_head(T, user:T). 938 939 940 /******************************* 941 * FOREIGN LIBRARIES * 942 *******************************/
948save_foreign_libraries(RC, Options) :- 949 option(foreign(save), Options), 950 !, 951 current_prolog_flag(arch, HostArch), 952 feedback('~nHOST(~w) FOREIGN LIBRARIES~n', [HostArch]), 953 save_foreign_libraries1(HostArch, RC, Options). 954save_foreign_libraries(RC, Options) :- 955 option(foreign(arch(Archs)), Options), 956 !, 957 forall(member(Arch, Archs), 958 ( feedback('~n~w FOREIGN LIBRARIES~n', [Arch]), 959 save_foreign_libraries1(Arch, RC, Options) 960 )). 961save_foreign_libraries(_, _). 962 963save_foreign_libraries1(Arch, RC, _Options) :- 964 forall(current_foreign_library(FileSpec, _Predicates), 965 ( find_foreign_library(Arch, FileSpec, EntryName, File, Time), 966 term_to_atom(EntryName, Name), 967 zipper_append_file(RC, Name, File, [time(Time)]) 968 )).
strip -o <tmp>
<shared-object>. Note that (if stripped) the file is a Prolog tmp
file and will be deleted on halt.
982find_foreign_library(Arch, FileSpec, shlib(Arch,Name), SharedObject, Time) :-
983 FileSpec = foreign(Name),
984 ( catch(arch_find_shlib(Arch, FileSpec, File),
985 E,
986 print_message(error, E)),
987 exists_file(File)
988 -> true
989 ; throw(error(existence_error(architecture_shlib(Arch), FileSpec),_))
990 ),
991 time_file(File, Time),
992 strip_file(File, SharedObject).999strip_file(File, Stripped) :- 1000 absolute_file_name(path(strip), Strip, 1001 [ access(execute), 1002 file_errors(fail) 1003 ]), 1004 tmp_file(shared, Stripped), 1005 ( catch(do_strip_file(Strip, File, Stripped), E, 1006 (print_message(warning, E), fail)) 1007 -> true 1008 ; print_message(warning, qsave(strip_failed(File))), 1009 fail 1010 ), 1011 !. 1012strip_file(File, File). 1013 1014do_strip_file(Strip, File, Stripped) :- 1015 format(atom(Cmd), '"~w" -x -o "~w" "~w"', 1016 [Strip, Stripped, File]), 1017 shell(Cmd), 1018 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.
1032:- multifile arch_shlib/3. 1033 1034arch_find_shlib(Arch, FileSpec, File) :- 1035 arch_shlib(Arch, FileSpec, File), 1036 !. 1037arch_find_shlib(Arch, FileSpec, File) :- 1038 current_prolog_flag(arch, Arch), 1039 absolute_file_name(FileSpec, 1040 [ file_type(executable), 1041 access(read), 1042 file_errors(fail) 1043 ], File), 1044 !. 1045arch_find_shlib(Arch, foreign(Base), File) :- 1046 current_prolog_flag(arch, Arch), 1047 current_prolog_flag(windows, true), 1048 current_prolog_flag(executable, WinExe), 1049 prolog_to_os_filename(Exe, WinExe), 1050 file_directory_name(Exe, BinDir), 1051 file_name_extension(Base, dll, DllFile), 1052 atomic_list_concat([BinDir, /, DllFile], File), 1053 exists_file(File). 1054 1055 1056 /******************************* 1057 * UTIL * 1058 *******************************/ 1059 1060open_map(Options) :- 1061 option(map(Map), Options), 1062 !, 1063 open(Map, write, Fd), 1064 asserta(verbose(Fd)). 1065open_map(_) :- 1066 retractall(verbose(_)). 1067 1068close_map :- 1069 retract(verbose(Fd)), 1070 close(Fd), 1071 !. 1072close_map. 1073 1074feedback(Fmt, Args) :- 1075 verbose(Fd), 1076 !, 1077 format(Fd, Fmt, Args). 1078feedback(_, _). 1079 1080 1081check_options([]) :- !. 1082check_options([Var|_]) :- 1083 var(Var), 1084 !, 1085 throw(error(domain_error(save_options, Var), _)). 1086check_options([Name=Value|T]) :- 1087 !, 1088 ( save_option(Name, Type, _Comment) 1089 -> ( must_be(Type, Value) 1090 -> check_options(T) 1091 ; throw(error(domain_error(Type, Value), _)) 1092 ) 1093 ; throw(error(domain_error(save_option, Name), _)) 1094 ). 1095check_options([Term|T]) :- 1096 Term =.. [Name,Arg], 1097 !, 1098 check_options([Name=Arg|T]). 1099check_options([Var|_]) :- 1100 throw(error(domain_error(save_options, Var), _)). 1101check_options(Opt) :- 1102 throw(error(domain_error(list, Opt), _)).
1109zipper_append_file(_, Name, _, _) :- 1110 saved_resource_file(Name), 1111 !. 1112zipper_append_file(_, _, File, _) :- 1113 source_file(File), 1114 !. 1115zipper_append_file(Zipper, Name, File, Options) :- 1116 ( option(time(_), Options) 1117 -> Options1 = Options 1118 ; time_file(File, Stamp), 1119 Options1 = [time(Stamp)|Options] 1120 ), 1121 setup_call_cleanup( 1122 open(File, read, In, [type(binary)]), 1123 setup_call_cleanup( 1124 zipper_open_new_file_in_zip(Zipper, Name, Out, Options1), 1125 copy_stream_data(In, Out), 1126 close(Out)), 1127 close(In)), 1128 assertz(saved_resource_file(Name)).
time(Stamp).1135zipper_add_directory(Zipper, Name, Dir, Options) :- 1136 ( option(time(Stamp), Options) 1137 -> true 1138 ; time_file(Dir, Stamp) 1139 ), 1140 atom_concat(Name, /, DirName), 1141 ( saved_resource_file(DirName) 1142 -> true 1143 ; setup_call_cleanup( 1144 zipper_open_new_file_in_zip(Zipper, DirName, Out, 1145 [ method(store), 1146 time(Stamp) 1147 | Options 1148 ]), 1149 true, 1150 close(Out)), 1151 assertz(saved_resource_file(DirName)) 1152 ). 1153 1154add_parent_dirs(Zipper, Name, Dir, Options) :- 1155 ( option(time(Stamp), Options) 1156 -> true 1157 ; time_file(Dir, Stamp) 1158 ), 1159 file_directory_name(Name, Parent), 1160 ( Parent \== Name 1161 -> add_parent_dirs(Zipper, Parent, [time(Stamp)|Options]) 1162 ; true 1163 ). 1164 1165add_parent_dirs(_, '.', _) :- 1166 !. 1167add_parent_dirs(Zipper, Name, Options) :- 1168 zipper_add_directory(Zipper, Name, _, Options), 1169 file_directory_name(Name, Parent), 1170 ( Parent \== Name 1171 -> add_parent_dirs(Zipper, Parent, Options) 1172 ; true 1173 ).
1191zipper_append_directory(Zipper, Name, Dir, Options) :- 1192 exists_directory(Dir), 1193 !, 1194 add_parent_dirs(Zipper, Name, Dir, Options), 1195 zipper_add_directory(Zipper, Name, Dir, Options), 1196 directory_files(Dir, Members), 1197 forall(member(M, Members), 1198 ( reserved(M) 1199 -> true 1200 ; ignored(M, Options) 1201 -> true 1202 ; atomic_list_concat([Dir,M], /, Entry), 1203 atomic_list_concat([Name,M], /, Store), 1204 catch(zipper_append_directory(Zipper, Store, Entry, Options), 1205 E, 1206 print_message(warning, E)) 1207 )). 1208zipper_append_directory(Zipper, Name, File, Options) :- 1209 zipper_append_file(Zipper, Name, File, Options). 1210 1211reserved(.). 1212reserved(..).
include(Patterns) option that does not
match File or an exclude(Patterns) that does match File.1219ignored(File, Options) :- 1220 option(include(Patterns), Options), 1221 \+ ( ( is_list(Patterns) 1222 -> member(Pattern, Patterns) 1223 ; Pattern = Patterns 1224 ), 1225 glob_match(Pattern, File) 1226 ), 1227 !. 1228ignored(File, Options) :- 1229 option(exclude(Patterns), Options), 1230 ( is_list(Patterns) 1231 -> member(Pattern, Patterns) 1232 ; Pattern = Patterns 1233 ), 1234 glob_match(Pattern, File), 1235 !. 1236 1237glob_match(Pattern, File) :- 1238 current_prolog_flag(file_name_case_handling, case_sensitive), 1239 !, 1240 wildcard_match(Pattern, File). 1241glob_match(Pattern, File) :- 1242 wildcard_match(Pattern, File, [case_sensitive(false)]). 1243 1244 1245 /******************************** 1246 * SAVED STATE GENERATION * 1247 *********************************/
1253:- public 1254 qsave_toplevel/0. 1255 1256qsave_toplevel :- 1257 current_prolog_flag(os_argv, Argv), 1258 qsave_options(Argv, Files, Options), 1259 set_on_error(Options), 1260 '$cmd_option_val'(compileout, Out), 1261 user:consult(Files), 1262 maybe_exit_on_errors, 1263 qsave_program(Out, user:Options). 1264 1265set_on_error(Options) :- 1266 option(on_error(_), Options), !. 1267set_on_error(_Options) :- 1268 set_prolog_flag(on_error, status). 1269 1270maybe_exit_on_errors :- 1271 '$exit_code'(Code), 1272 ( Code =\= 0 1273 -> halt 1274 ; true 1275 ). 1276 1277qsave_options([], [], []). 1278qsave_options([--|_], [], []) :- 1279 !. 1280qsave_options(['-c'|T0], Files, Options) :- 1281 !, 1282 argv_files(T0, T1, Files, FilesT), 1283 qsave_options(T1, FilesT, Options). 1284qsave_options([O|T0], Files, [Option|T]) :- 1285 string_concat(--, Opt, O), 1286 split_string(Opt, =, '', [NameS|Rest]), 1287 split_string(NameS, '-', '', NameParts), 1288 atomic_list_concat(NameParts, '_', Name), 1289 qsave_option(Name, OptName, Rest, Value), 1290 !, 1291 Option =.. [OptName, Value], 1292 qsave_options(T0, Files, T). 1293qsave_options([_|T0], Files, T) :- 1294 qsave_options(T0, Files, T). 1295 1296argv_files([], [], Files, Files). 1297argv_files([H|T], [H|T], Files, Files) :- 1298 sub_atom(H, 0, _, _, -), 1299 !. 1300argv_files([H|T0], T, [H|Files0], Files) :- 1301 argv_files(T0, T, Files0, Files).
1305qsave_option(Name, Name, [], true) :- 1306 save_option(Name, boolean, _), 1307 !. 1308qsave_option(NoName, Name, [], false) :- 1309 atom_concat('no_', Name, NoName), 1310 save_option(Name, boolean, _), 1311 !. 1312qsave_option(Name, Name, ValueStrings, Value) :- 1313 save_option(Name, Type, _), 1314 !, 1315 atomics_to_string(ValueStrings, "=", ValueString), 1316 convert_option_value(Type, ValueString, Value). 1317qsave_option(Name, Name, _Chars, _Value) :- 1318 existence_error(save_option, Name). 1319 1320convert_option_value(integer, String, Value) :- 1321 ( number_string(Value, String) 1322 -> true 1323 ; sub_string(String, 0, _, 1, SubString), 1324 sub_string(String, _, 1, 0, Suffix0), 1325 downcase_atom(Suffix0, Suffix), 1326 number_string(Number, SubString), 1327 suffix_multiplier(Suffix, Multiplier) 1328 -> Value is Number * Multiplier 1329 ; domain_error(integer, String) 1330 ). 1331convert_option_value(callable, String, Value) :- 1332 term_string(Value, String). 1333convert_option_value(atom, String, Value) :- 1334 atom_string(Value, String). 1335convert_option_value(boolean, String, Value) :- 1336 atom_string(Value, String). 1337convert_option_value(oneof(_), String, Value) :- 1338 atom_string(Value, String). 1339convert_option_value(ground, String, Value) :- 1340 atom_string(Value, String). 1341convert_option_value(qsave_foreign_option, "save", save). 1342convert_option_value(qsave_foreign_option, StrArchList, arch(ArchList)) :- 1343 split_string(StrArchList, ",", ", \t", StrArchList1), 1344 maplist(atom_string, ArchList, StrArchList1). 1345 1346suffix_multiplier(b, 1). 1347suffix_multiplier(k, 1024). 1348suffix_multiplier(m, 1024 * 1024). 1349suffix_multiplier(g, 1024 * 1024 * 1024). 1350 1351 1352 /******************************* 1353 * MESSAGES * 1354 *******************************/ 1355 1356:- multifile prolog:message/3. 1357 1358prologmessage(no_resource(Name, File)) --> 1359 [ 'Could not find resource ~w on ~w or system resources'- 1360 [Name, File] ]. 1361prologmessage(qsave(nondet)) --> 1362 [ '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.
*/