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-2024, 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, copy]), 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, File, Options), 155 Reason, 156 finalize_state(Reason, StateOut, File)) 157 ), 158 close_map), 159 cleanup, 160 !. 161 162write_state(StateOut, SaveClass, ExeFile, Options) :- 163 make_header(StateOut, SaveClass, Options), 164 setup_call_cleanup( 165 zip_open_stream(StateOut, RC, []), 166 write_zip_state(RC, SaveClass, ExeFile, Options), 167 zip_close(RC, [comment('SWI-Prolog saved state')])), 168 flush_output(StateOut). 169 170write_zip_state(RC, SaveClass, ExeFile, 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, ExeFile, 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(_RC, ExeFile, Options) :- 962 option(foreign(copy), Options), 963 copy_foreign_libraries(ExeFile, Options). 964save_foreign_libraries(_, _, _). 965 966save_foreign_libraries1(Arch, RC, _Options) :- 967 forall(current_foreign_library(FileSpec, _Predicates), 968 ( find_foreign_library(Arch, FileSpec, EntryName, File, Time), 969 term_to_atom(EntryName, Name), 970 zipper_append_file(RC, Name, File, [time(Time)]) 971 )).
979:- if(current_prolog_flag(windows, true)). 980copy_foreign_libraries(ExeFile, _Options) :- 981 !, 982 file_directory_name(ExeFile, Dir), 983 win_process_modules(Modules), 984 include(prolog_dll, Modules, PrologDLLs), 985 maplist(copy_dll(Dir), PrologDLLs). 986:- endif. 987copy_foreign_libraries(_ExeFile, _Options) :- 988 print_message(warning, qsave(copy_foreign_libraries)). 989 990prolog_dll(DLL) :- 991 file_base_name(DLL, File), 992 absolute_file_name(foreign(File), DLL, 993 [ solutions(all) ]), 994 !. 995 996copy_dll(Dest, DLL) :- 997 print_message(informational, copy_foreign_library(DLL, Dest)), 998 copy_file(DLL, Dest).
strip -o <tmp>
<shared-object>. Note that (if stripped) the file is a Prolog tmp
file and will be deleted on halt.
1013find_foreign_library(Arch, FileSpec, shlib(Arch,Name), SharedObject, Time) :-
1014 FileSpec = foreign(Name),
1015 ( catch(arch_find_shlib(Arch, FileSpec, File),
1016 E,
1017 print_message(error, E)),
1018 exists_file(File)
1019 -> true
1020 ; throw(error(existence_error(architecture_shlib(Arch), FileSpec),_))
1021 ),
1022 time_file(File, Time),
1023 strip_file(File, SharedObject).1030strip_file(File, Stripped) :- 1031 absolute_file_name(path(strip), Strip, 1032 [ access(execute), 1033 file_errors(fail) 1034 ]), 1035 tmp_file(shared, Stripped), 1036 ( catch(do_strip_file(Strip, File, Stripped), E, 1037 (print_message(warning, E), fail)) 1038 -> true 1039 ; print_message(warning, qsave(strip_failed(File))), 1040 fail 1041 ), 1042 !. 1043strip_file(File, File). 1044 1045do_strip_file(Strip, File, Stripped) :- 1046 format(atom(Cmd), '"~w" -x -o "~w" "~w"', 1047 [Strip, Stripped, File]), 1048 shell(Cmd), 1049 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.
1063:- multifile arch_shlib/3. 1064 1065arch_find_shlib(Arch, FileSpec, File) :- 1066 arch_shlib(Arch, FileSpec, File), 1067 !. 1068arch_find_shlib(Arch, FileSpec, File) :- 1069 current_prolog_flag(arch, Arch), 1070 absolute_file_name(FileSpec, 1071 [ file_type(executable), 1072 access(read), 1073 file_errors(fail) 1074 ], File), 1075 !. 1076arch_find_shlib(Arch, foreign(Base), File) :- 1077 current_prolog_flag(arch, Arch), 1078 current_prolog_flag(windows, true), 1079 current_prolog_flag(executable, WinExe), 1080 prolog_to_os_filename(Exe, WinExe), 1081 file_directory_name(Exe, BinDir), 1082 file_name_extension(Base, dll, DllFile), 1083 atomic_list_concat([BinDir, /, DllFile], File), 1084 exists_file(File). 1085 1086 1087 /******************************* 1088 * UTIL * 1089 *******************************/ 1090 1091open_map(Options) :- 1092 option(map(Map), Options), 1093 !, 1094 open(Map, write, Fd), 1095 asserta(verbose(Fd)). 1096open_map(_) :- 1097 retractall(verbose(_)). 1098 1099close_map :- 1100 retract(verbose(Fd)), 1101 close(Fd), 1102 !. 1103close_map. 1104 1105feedback(Fmt, Args) :- 1106 verbose(Fd), 1107 !, 1108 format(Fd, Fmt, Args). 1109feedback(_, _). 1110 1111 1112check_options([]) :- !. 1113check_options([Var|_]) :- 1114 var(Var), 1115 !, 1116 throw(error(domain_error(save_options, Var), _)). 1117check_options([Name=Value|T]) :- 1118 !, 1119 ( save_option(Name, Type, _Comment) 1120 -> ( must_be(Type, Value) 1121 -> check_options(T) 1122 ; throw(error(domain_error(Type, Value), _)) 1123 ) 1124 ; throw(error(domain_error(save_option, Name), _)) 1125 ). 1126check_options([Term|T]) :- 1127 Term =.. [Name,Arg], 1128 !, 1129 check_options([Name=Arg|T]). 1130check_options([Var|_]) :- 1131 throw(error(domain_error(save_options, Var), _)). 1132check_options(Opt) :- 1133 throw(error(domain_error(list, Opt), _)).
1140zipper_append_file(_, Name, _, _) :- 1141 saved_resource_file(Name), 1142 !. 1143zipper_append_file(_, _, File, _) :- 1144 source_file(File), 1145 !. 1146zipper_append_file(Zipper, Name, File, Options) :- 1147 ( option(time(_), Options) 1148 -> Options1 = Options 1149 ; time_file(File, Stamp), 1150 Options1 = [time(Stamp)|Options] 1151 ), 1152 setup_call_cleanup( 1153 open(File, read, In, [type(binary)]), 1154 setup_call_cleanup( 1155 zipper_open_new_file_in_zip(Zipper, Name, Out, Options1), 1156 copy_stream_data(In, Out), 1157 close(Out)), 1158 close(In)), 1159 assertz(saved_resource_file(Name)).
time(Stamp).1166zipper_add_directory(Zipper, Name, Dir, Options) :- 1167 ( option(time(Stamp), Options) 1168 -> true 1169 ; time_file(Dir, Stamp) 1170 ), 1171 atom_concat(Name, /, DirName), 1172 ( saved_resource_file(DirName) 1173 -> true 1174 ; setup_call_cleanup( 1175 zipper_open_new_file_in_zip(Zipper, DirName, Out, 1176 [ method(store), 1177 time(Stamp) 1178 | Options 1179 ]), 1180 true, 1181 close(Out)), 1182 assertz(saved_resource_file(DirName)) 1183 ). 1184 1185add_parent_dirs(Zipper, Name, Dir, Options) :- 1186 ( option(time(Stamp), Options) 1187 -> true 1188 ; time_file(Dir, Stamp) 1189 ), 1190 file_directory_name(Name, Parent), 1191 ( Parent \== Name 1192 -> add_parent_dirs(Zipper, Parent, [time(Stamp)|Options]) 1193 ; true 1194 ). 1195 1196add_parent_dirs(_, '.', _) :- 1197 !. 1198add_parent_dirs(Zipper, Name, Options) :- 1199 zipper_add_directory(Zipper, Name, _, Options), 1200 file_directory_name(Name, Parent), 1201 ( Parent \== Name 1202 -> add_parent_dirs(Zipper, Parent, Options) 1203 ; true 1204 ).
1222zipper_append_directory(Zipper, Name, Dir, Options) :- 1223 exists_directory(Dir), 1224 !, 1225 add_parent_dirs(Zipper, Name, Dir, Options), 1226 zipper_add_directory(Zipper, Name, Dir, Options), 1227 directory_files(Dir, Members), 1228 forall(member(M, Members), 1229 ( reserved(M) 1230 -> true 1231 ; ignored(M, Options) 1232 -> true 1233 ; atomic_list_concat([Dir,M], /, Entry), 1234 atomic_list_concat([Name,M], /, Store), 1235 catch(zipper_append_directory(Zipper, Store, Entry, Options), 1236 E, 1237 print_message(warning, E)) 1238 )). 1239zipper_append_directory(Zipper, Name, File, Options) :- 1240 zipper_append_file(Zipper, Name, File, Options). 1241 1242reserved(.). 1243reserved(..).
include(Patterns) option that does not
match File or an exclude(Patterns) that does match File.1250ignored(File, Options) :- 1251 option(include(Patterns), Options), 1252 \+ ( ( is_list(Patterns) 1253 -> member(Pattern, Patterns) 1254 ; Pattern = Patterns 1255 ), 1256 glob_match(Pattern, File) 1257 ), 1258 !. 1259ignored(File, Options) :- 1260 option(exclude(Patterns), Options), 1261 ( is_list(Patterns) 1262 -> member(Pattern, Patterns) 1263 ; Pattern = Patterns 1264 ), 1265 glob_match(Pattern, File), 1266 !. 1267 1268glob_match(Pattern, File) :- 1269 current_prolog_flag(file_name_case_handling, case_sensitive), 1270 !, 1271 wildcard_match(Pattern, File). 1272glob_match(Pattern, File) :- 1273 wildcard_match(Pattern, File, [case_sensitive(false)]). 1274 1275 1276 /******************************** 1277 * SAVED STATE GENERATION * 1278 *********************************/
1284:- public 1285 qsave_toplevel/0. 1286 1287qsave_toplevel :- 1288 current_prolog_flag(os_argv, Argv), 1289 qsave_options(Argv, Files, Options), 1290 set_on_error(Options), 1291 '$cmd_option_val'(compileout, Out), 1292 user:consult(Files), 1293 maybe_exit_on_errors, 1294 qsave_program(Out, user:Options). 1295 1296set_on_error(Options) :- 1297 option(on_error(_), Options), !. 1298set_on_error(_Options) :- 1299 set_prolog_flag(on_error, status). 1300 1301maybe_exit_on_errors :- 1302 '$exit_code'(Code), 1303 ( Code =\= 0 1304 -> halt 1305 ; true 1306 ). 1307 1308qsave_options([], [], []). 1309qsave_options([--|_], [], []) :- 1310 !. 1311qsave_options(['-c'|T0], Files, Options) :- 1312 !, 1313 argv_files(T0, T1, Files, FilesT), 1314 qsave_options(T1, FilesT, Options). 1315qsave_options([O|T0], Files, [Option|T]) :- 1316 string_concat(--, Opt, O), 1317 split_string(Opt, =, '', [NameS|Rest]), 1318 split_string(NameS, '-', '', NameParts), 1319 atomic_list_concat(NameParts, '_', Name), 1320 qsave_option(Name, OptName, Rest, Value), 1321 !, 1322 Option =.. [OptName, Value], 1323 qsave_options(T0, Files, T). 1324qsave_options([_|T0], Files, T) :- 1325 qsave_options(T0, Files, T). 1326 1327argv_files([], [], Files, Files). 1328argv_files([H|T], [H|T], Files, Files) :- 1329 sub_atom(H, 0, _, _, -), 1330 !. 1331argv_files([H|T0], T, [H|Files0], Files) :- 1332 argv_files(T0, T, Files0, Files).
1336qsave_option(Name, Name, [], true) :- 1337 save_option(Name, boolean, _), 1338 !. 1339qsave_option(NoName, Name, [], false) :- 1340 atom_concat('no_', Name, NoName), 1341 save_option(Name, boolean, _), 1342 !. 1343qsave_option(Name, Name, ValueStrings, Value) :- 1344 save_option(Name, Type, _), 1345 !, 1346 atomics_to_string(ValueStrings, "=", ValueString), 1347 convert_option_value(Type, ValueString, Value). 1348qsave_option(Name, Name, _Chars, _Value) :- 1349 existence_error(save_option, Name). 1350 1351convert_option_value(integer, String, Value) :- 1352 ( number_string(Value, String) 1353 -> true 1354 ; sub_string(String, 0, _, 1, SubString), 1355 sub_string(String, _, 1, 0, Suffix0), 1356 downcase_atom(Suffix0, Suffix), 1357 number_string(Number, SubString), 1358 suffix_multiplier(Suffix, Multiplier) 1359 -> Value is Number * Multiplier 1360 ; domain_error(integer, String) 1361 ). 1362convert_option_value(callable, String, Value) :- 1363 term_string(Value, String). 1364convert_option_value(atom, String, Value) :- 1365 atom_string(Value, String). 1366convert_option_value(boolean, String, Value) :- 1367 atom_string(Value, String). 1368convert_option_value(oneof(_), String, Value) :- 1369 atom_string(Value, String). 1370convert_option_value(ground, String, Value) :- 1371 atom_string(Value, String). 1372convert_option_value(qsave_foreign_option, "save", save). 1373convert_option_value(qsave_foreign_option, StrArchList, arch(ArchList)) :- 1374 split_string(StrArchList, ",", ", \t", StrArchList1), 1375 maplist(atom_string, ArchList, StrArchList1). 1376 1377suffix_multiplier(b, 1). 1378suffix_multiplier(k, 1024). 1379suffix_multiplier(m, 1024 * 1024). 1380suffix_multiplier(g, 1024 * 1024 * 1024). 1381 1382 1383 /******************************* 1384 * MESSAGES * 1385 *******************************/ 1386 1387:- multifile prolog:message/3. 1388 1389prologmessage(no_resource(Name, File)) --> 1390 [ 'Could not find resource ~w on ~w or system resources'- 1391 [Name, File] ]. 1392prologmessage(qsave(nondet)) --> 1393 [ 'qsave_program/2 succeeded with a choice point'-[] ]. 1394prologmessage(copy_foreign_library(Lib,Dir)) --> 1395 [ 'Copying ~w to ~w'-[Lib, Dir] ]
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.
*/