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(incremental, incremental, true). 723attrib_name(volatile, volatile, true). 724attrib_name(thread_local, thread_local, true). 725attrib_name(multifile, multifile, true). 726attrib_name(public, public, true). 727attrib_name(transparent, transparent, true). 728attrib_name(discontiguous, discontiguous, true). 729attrib_name(notrace, trace, false). 730attrib_name(show_childs, hide_childs, false). 731attrib_name(built_in, system, true). 732attrib_name(nodebug, hide_childs, true). 733attrib_name(quasi_quotation_syntax, quasi_quotation_syntax, true). 734attrib_name(iso, iso, true). 735 736 737save_attribute(P, Attribute) :- 738 pred_attrib(Attribute, P, D), 739 ( Attribute == built_in % no need if there are clauses 740 -> ( predicate_property(P, number_of_clauses(0)) 741 -> true 742 ; predicate_property(P, volatile) 743 ) 744 ; Attribute == (dynamic) % no need if predicate is thread_local 745 -> \+ predicate_property(P, thread_local) 746 ; true 747 ), 748 '$add_directive_wic'(D), 749 feedback('(~w) ', [Attribute]). 750 751save_attributes(P) :- 752 ( predicate_property(P, Attribute), 753 save_attribute(P, Attribute), 754 fail 755 ; true 756 ). 757 758% Save status of the unknown flag 759 760save_unknown(M) :- 761 current_prolog_flag(Munknown, Unknown), 762 ( Unknown == error 763 -> true 764 ; '$add_directive_wic'(set_prolog_flag(Munknown, Unknown)) 765 ). 766 767 /******************************* 768 * RECORDS * 769 *******************************/ 770 771save_records :- 772 feedback('~nRECORDS~n', []), 773 ( current_key(X), 774 X \== '$topvar', % do not safe toplevel variables 775 feedback('~n~t~8|~w ', [X]), 776 recorded(X, V, _), 777 feedback('.', []), 778 '$add_directive_wic'(recordz(X, V, _)), 779 fail 780 ; true 781 ). 782 783 784 /******************************* 785 * FLAGS * 786 *******************************/ 787 788save_flags :- 789 feedback('~nFLAGS~n~n', []), 790 ( current_flag(X), 791 flag(X, V, V), 792 feedback('~t~8|~w = ~w~n', [X, V]), 793 '$add_directive_wic'(set_flag(X, V)), 794 fail 795 ; true 796 ). 797 798save_prompt :- 799 feedback('~nPROMPT~n~n', []), 800 prompt(Prompt, Prompt), 801 '$add_directive_wic'(prompt(_, Prompt)). 802 803 804 /******************************* 805 * IMPORTS * 806 *******************************/
816save_imports :- 817 feedback('~nIMPORTS~n~n', []), 818 ( predicate_property(M:H, imported_from(I)), 819 \+ default_import(M, H, I), 820 functor(H, F, A), 821 feedback('~t~8|~w:~w/~d <-- ~w~n', [M, F, A, I]), 822 '$add_directive_wic'(qsave:restore_import(M, I, F/A)), 823 fail 824 ; true 825 ). 826 827default_import(To, Head, From) :- 828 '$get_predicate_attribute'(To:Head, (dynamic), 1), 829 predicate_property(From:Head, exported), 830 !, 831 fail. 832default_import(Into, _, From) :- 833 default_module(Into, From).
user, avoiding a message that the predicate is not
exported.841restore_import(To, user, PI) :- 842 !, 843 export(user:PI), 844 To:import(user:PI). 845restore_import(To, From, PI) :- 846 To:import(From:PI). 847 848 /******************************* 849 * PROLOG FLAGS * 850 *******************************/ 851 852save_prolog_flags(Options) :- 853 feedback('~nPROLOG FLAGS~n~n', []), 854 '$current_prolog_flag'(Flag, Value0, _Scope, write, Type), 855 \+ no_save_flag(Flag), 856 map_flag(Flag, Value0, Value, Options), 857 feedback('~t~8|~w: ~w (type ~q)~n', [Flag, Value, Type]), 858 '$add_directive_wic'(qsave:restore_prolog_flag(Flag, Value, Type)), 859 fail. 860save_prolog_flags(_). 861 862no_save_flag(argv). 863no_save_flag(os_argv). 864no_save_flag(access_level). 865no_save_flag(tty_control). 866no_save_flag(readline). 867no_save_flag(associated_file). 868no_save_flag(cpu_count). 869no_save_flag(tmp_dir). 870no_save_flag(file_name_case_handling). 871no_save_flag(hwnd). % should be read-only, but comes 872 % from user-code 873map_flag(autoload, true, false, Options) :- 874 option(class(runtime), Options, runtime), 875 option(autoload(true), Options, true), 876 !. 877map_flag(_, Value, Value, _).
885restore_prolog_flag(Flag, Value, _Type) :- 886 current_prolog_flag(Flag, Value), 887 !. 888restore_prolog_flag(Flag, Value, _Type) :- 889 current_prolog_flag(Flag, _), 890 !, 891 catch(set_prolog_flag(Flag, Value), _, true). 892restore_prolog_flag(Flag, Value, Type) :- 893 create_prolog_flag(Flag, Value, [type(Type)]). 894 895 896 /******************************* 897 * OPERATORS * 898 *******************************/
system are
not saved because these are read-only anyway.905save_operators(Options) :- 906 !, 907 option(op(save), Options, save), 908 feedback('~nOPERATORS~n', []), 909 forall(current_module(M), save_module_operators(M)), 910 feedback('~n', []). 911save_operators(_). 912 913save_module_operators(system) :- !. 914save_module_operators(M) :- 915 forall('$local_op'(P,T,M:N), 916 ( feedback('~n~t~8|~w ', [op(P,T,M:N)]), 917 '$add_directive_wic'(op(P,T,M:N)) 918 )). 919 920 921 /******************************* 922 * FORMAT PREDICATES * 923 *******************************/ 924 925save_format_predicates :- 926 feedback('~nFORMAT PREDICATES~n', []), 927 current_format_predicate(Code, Head), 928 qualify_head(Head, QHead), 929 D = format_predicate(Code, QHead), 930 feedback('~n~t~8|~w ', [D]), 931 '$add_directive_wic'(D), 932 fail. 933save_format_predicates. 934 935qualify_head(T, T) :- 936 functor(T, :, 2), 937 !. 938qualify_head(T, user:T). 939 940 941 /******************************* 942 * FOREIGN LIBRARIES * 943 *******************************/
949save_foreign_libraries(RC, _, Options) :- 950 option(foreign(save), Options), 951 !, 952 current_prolog_flag(arch, HostArch), 953 feedback('~nHOST(~w) FOREIGN LIBRARIES~n', [HostArch]), 954 save_foreign_libraries1(HostArch, RC, Options). 955save_foreign_libraries(RC, _, Options) :- 956 option(foreign(arch(Archs)), Options), 957 !, 958 forall(member(Arch, Archs), 959 ( feedback('~n~w FOREIGN LIBRARIES~n', [Arch]), 960 save_foreign_libraries1(Arch, RC, Options) 961 )). 962save_foreign_libraries(_RC, ExeFile, Options) :- 963 option(foreign(copy), Options), 964 copy_foreign_libraries(ExeFile, Options). 965save_foreign_libraries(_, _, _). 966 967save_foreign_libraries1(Arch, RC, _Options) :- 968 forall(current_foreign_library(FileSpec, _Predicates), 969 ( find_foreign_library(Arch, FileSpec, EntryName, File, Time), 970 term_to_atom(EntryName, Name), 971 zipper_append_file(RC, Name, File, [time(Time)]) 972 )).
980:- if(current_prolog_flag(windows, true)). 981copy_foreign_libraries(ExeFile, _Options) :- 982 !, 983 file_directory_name(ExeFile, Dir), 984 win_process_modules(Modules), 985 include(prolog_dll, Modules, PrologDLLs), 986 maplist(copy_dll(Dir), PrologDLLs). 987:- endif. 988copy_foreign_libraries(_ExeFile, _Options) :- 989 print_message(warning, qsave(copy_foreign_libraries)). 990 991prolog_dll(DLL) :- 992 file_base_name(DLL, File), 993 absolute_file_name(foreign(File), DLL, 994 [ solutions(all) ]), 995 !. 996 997copy_dll(Dest, DLL) :- 998 print_message(informational, copy_foreign_library(DLL, Dest)), 999 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.
1014find_foreign_library(Arch, FileSpec, shlib(Arch,Name), SharedObject, Time) :-
1015 FileSpec = foreign(Name),
1016 ( catch(arch_find_shlib(Arch, FileSpec, File),
1017 E,
1018 print_message(error, E)),
1019 exists_file(File)
1020 -> true
1021 ; throw(error(existence_error(architecture_shlib(Arch), FileSpec),_))
1022 ),
1023 time_file(File, Time),
1024 strip_file(File, SharedObject).1031strip_file(File, Stripped) :- 1032 absolute_file_name(path(strip), Strip, 1033 [ access(execute), 1034 file_errors(fail) 1035 ]), 1036 tmp_file(shared, Stripped), 1037 ( catch(do_strip_file(Strip, File, Stripped), E, 1038 (print_message(warning, E), fail)) 1039 -> true 1040 ; print_message(warning, qsave(strip_failed(File))), 1041 fail 1042 ), 1043 !. 1044strip_file(File, File). 1045 1046do_strip_file(Strip, File, Stripped) :- 1047 format(atom(Cmd), '"~w" -x -o "~w" "~w"', 1048 [Strip, Stripped, File]), 1049 shell(Cmd), 1050 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.
1064:- multifile arch_shlib/3. 1065 1066arch_find_shlib(Arch, FileSpec, File) :- 1067 arch_shlib(Arch, FileSpec, File), 1068 !. 1069arch_find_shlib(Arch, FileSpec, File) :- 1070 current_prolog_flag(arch, Arch), 1071 absolute_file_name(FileSpec, 1072 [ file_type(executable), 1073 access(read), 1074 file_errors(fail) 1075 ], File), 1076 !. 1077arch_find_shlib(Arch, foreign(Base), File) :- 1078 current_prolog_flag(arch, Arch), 1079 current_prolog_flag(windows, true), 1080 current_prolog_flag(executable, WinExe), 1081 prolog_to_os_filename(Exe, WinExe), 1082 file_directory_name(Exe, BinDir), 1083 file_name_extension(Base, dll, DllFile), 1084 atomic_list_concat([BinDir, /, DllFile], File), 1085 exists_file(File). 1086 1087 1088 /******************************* 1089 * UTIL * 1090 *******************************/ 1091 1092open_map(Options) :- 1093 option(map(Map), Options), 1094 !, 1095 open(Map, write, Fd), 1096 asserta(verbose(Fd)). 1097open_map(_) :- 1098 retractall(verbose(_)). 1099 1100close_map :- 1101 retract(verbose(Fd)), 1102 close(Fd), 1103 !. 1104close_map. 1105 1106feedback(Fmt, Args) :- 1107 verbose(Fd), 1108 !, 1109 format(Fd, Fmt, Args). 1110feedback(_, _). 1111 1112 1113check_options([]) :- !. 1114check_options([Var|_]) :- 1115 var(Var), 1116 !, 1117 throw(error(domain_error(save_options, Var), _)). 1118check_options([Name=Value|T]) :- 1119 !, 1120 ( save_option(Name, Type, _Comment) 1121 -> ( must_be(Type, Value) 1122 -> check_options(T) 1123 ; throw(error(domain_error(Type, Value), _)) 1124 ) 1125 ; throw(error(domain_error(save_option, Name), _)) 1126 ). 1127check_options([Term|T]) :- 1128 Term =.. [Name,Arg], 1129 !, 1130 check_options([Name=Arg|T]). 1131check_options([Var|_]) :- 1132 throw(error(domain_error(save_options, Var), _)). 1133check_options(Opt) :- 1134 throw(error(domain_error(list, Opt), _)).
1141zipper_append_file(_, Name, _, _) :- 1142 saved_resource_file(Name), 1143 !. 1144zipper_append_file(_, _, File, _) :- 1145 source_file(File), 1146 !. 1147zipper_append_file(Zipper, Name, File, Options) :- 1148 ( option(time(_), Options) 1149 -> Options1 = Options 1150 ; time_file(File, Stamp), 1151 Options1 = [time(Stamp)|Options] 1152 ), 1153 setup_call_cleanup( 1154 open(File, read, In, [type(binary)]), 1155 setup_call_cleanup( 1156 zipper_open_new_file_in_zip(Zipper, Name, Out, Options1), 1157 copy_stream_data(In, Out), 1158 close(Out)), 1159 close(In)), 1160 assertz(saved_resource_file(Name)).
time(Stamp).1167zipper_add_directory(Zipper, Name, Dir, Options) :- 1168 ( option(time(Stamp), Options) 1169 -> true 1170 ; time_file(Dir, Stamp) 1171 ), 1172 atom_concat(Name, /, DirName), 1173 ( saved_resource_file(DirName) 1174 -> true 1175 ; setup_call_cleanup( 1176 zipper_open_new_file_in_zip(Zipper, DirName, Out, 1177 [ method(store), 1178 time(Stamp) 1179 | Options 1180 ]), 1181 true, 1182 close(Out)), 1183 assertz(saved_resource_file(DirName)) 1184 ). 1185 1186add_parent_dirs(Zipper, Name, Dir, Options) :- 1187 ( option(time(Stamp), Options) 1188 -> true 1189 ; time_file(Dir, Stamp) 1190 ), 1191 file_directory_name(Name, Parent), 1192 ( Parent \== Name 1193 -> add_parent_dirs(Zipper, Parent, [time(Stamp)|Options]) 1194 ; true 1195 ). 1196 1197add_parent_dirs(_, '.', _) :- 1198 !. 1199add_parent_dirs(Zipper, Name, Options) :- 1200 zipper_add_directory(Zipper, Name, _, Options), 1201 file_directory_name(Name, Parent), 1202 ( Parent \== Name 1203 -> add_parent_dirs(Zipper, Parent, Options) 1204 ; true 1205 ).
1223zipper_append_directory(Zipper, Name, Dir, Options) :- 1224 exists_directory(Dir), 1225 !, 1226 add_parent_dirs(Zipper, Name, Dir, Options), 1227 zipper_add_directory(Zipper, Name, Dir, Options), 1228 directory_files(Dir, Members), 1229 forall(member(M, Members), 1230 ( reserved(M) 1231 -> true 1232 ; ignored(M, Options) 1233 -> true 1234 ; atomic_list_concat([Dir,M], /, Entry), 1235 atomic_list_concat([Name,M], /, Store), 1236 catch(zipper_append_directory(Zipper, Store, Entry, Options), 1237 E, 1238 print_message(warning, E)) 1239 )). 1240zipper_append_directory(Zipper, Name, File, Options) :- 1241 zipper_append_file(Zipper, Name, File, Options). 1242 1243reserved(.). 1244reserved(..).
include(Patterns) option that does not
match File or an exclude(Patterns) that does match File.1251ignored(File, Options) :- 1252 option(include(Patterns), Options), 1253 \+ ( ( is_list(Patterns) 1254 -> member(Pattern, Patterns) 1255 ; Pattern = Patterns 1256 ), 1257 glob_match(Pattern, File) 1258 ), 1259 !. 1260ignored(File, Options) :- 1261 option(exclude(Patterns), Options), 1262 ( is_list(Patterns) 1263 -> member(Pattern, Patterns) 1264 ; Pattern = Patterns 1265 ), 1266 glob_match(Pattern, File), 1267 !. 1268 1269glob_match(Pattern, File) :- 1270 current_prolog_flag(file_name_case_handling, case_sensitive), 1271 !, 1272 wildcard_match(Pattern, File). 1273glob_match(Pattern, File) :- 1274 wildcard_match(Pattern, File, [case_sensitive(false)]). 1275 1276 1277 /******************************** 1278 * SAVED STATE GENERATION * 1279 *********************************/
1285:- public 1286 qsave_toplevel/0. 1287 1288qsave_toplevel :- 1289 current_prolog_flag(os_argv, Argv), 1290 qsave_options(Argv, Files, Options), 1291 set_on_error(Options), 1292 '$cmd_option_val'(compileout, Out), 1293 user:consult(Files), 1294 maybe_exit_on_errors, 1295 qsave_program(Out, user:Options). 1296 1297set_on_error(Options) :- 1298 option(on_error(_), Options), !. 1299set_on_error(_Options) :- 1300 set_prolog_flag(on_error, status). 1301 1302maybe_exit_on_errors :- 1303 '$exit_code'(Code), 1304 ( Code =\= 0 1305 -> halt 1306 ; true 1307 ). 1308 1309qsave_options([], [], []). 1310qsave_options([--|_], [], []) :- 1311 !. 1312qsave_options(['-c'|T0], Files, Options) :- 1313 !, 1314 argv_files(T0, T1, Files, FilesT), 1315 qsave_options(T1, FilesT, Options). 1316qsave_options([O|T0], Files, [Option|T]) :- 1317 string_concat(--, Opt, O), 1318 split_string(Opt, =, '', [NameS|Rest]), 1319 split_string(NameS, '-', '', NameParts), 1320 atomic_list_concat(NameParts, '_', Name), 1321 qsave_option(Name, OptName, Rest, Value), 1322 !, 1323 Option =.. [OptName, Value], 1324 qsave_options(T0, Files, T). 1325qsave_options([_|T0], Files, T) :- 1326 qsave_options(T0, Files, T). 1327 1328argv_files([], [], Files, Files). 1329argv_files([H|T], [H|T], Files, Files) :- 1330 sub_atom(H, 0, _, _, -), 1331 !. 1332argv_files([H|T0], T, [H|Files0], Files) :- 1333 argv_files(T0, T, Files0, Files).
1337qsave_option(Name, Name, [], true) :- 1338 save_option(Name, boolean, _), 1339 !. 1340qsave_option(NoName, Name, [], false) :- 1341 atom_concat('no_', Name, NoName), 1342 save_option(Name, boolean, _), 1343 !. 1344qsave_option(Name, Name, ValueStrings, Value) :- 1345 save_option(Name, Type, _), 1346 !, 1347 atomics_to_string(ValueStrings, "=", ValueString), 1348 convert_option_value(Type, ValueString, Value). 1349qsave_option(Name, Name, _Chars, _Value) :- 1350 existence_error(save_option, Name). 1351 1352convert_option_value(integer, String, Value) :- 1353 ( number_string(Value, String) 1354 -> true 1355 ; sub_string(String, 0, _, 1, SubString), 1356 sub_string(String, _, 1, 0, Suffix0), 1357 downcase_atom(Suffix0, Suffix), 1358 number_string(Number, SubString), 1359 suffix_multiplier(Suffix, Multiplier) 1360 -> Value is Number * Multiplier 1361 ; domain_error(integer, String) 1362 ). 1363convert_option_value(callable, String, Value) :- 1364 term_string(Value, String). 1365convert_option_value(atom, String, Value) :- 1366 atom_string(Value, String). 1367convert_option_value(boolean, String, Value) :- 1368 atom_string(Value, String). 1369convert_option_value(oneof(_), String, Value) :- 1370 atom_string(Value, String). 1371convert_option_value(ground, String, Value) :- 1372 atom_string(Value, String). 1373convert_option_value(qsave_foreign_option, "save", save). 1374convert_option_value(qsave_foreign_option, StrArchList, arch(ArchList)) :- 1375 split_string(StrArchList, ",", ", \t", StrArchList1), 1376 maplist(atom_string, ArchList, StrArchList1). 1377 1378suffix_multiplier(b, 1). 1379suffix_multiplier(k, 1024). 1380suffix_multiplier(m, 1024 * 1024). 1381suffix_multiplier(g, 1024 * 1024 * 1024). 1382 1383 1384 /******************************* 1385 * MESSAGES * 1386 *******************************/ 1387 1388:- multifile prolog:message/3. 1389 1390prologmessage(no_resource(Name, File)) --> 1391 [ 'Could not find resource ~w on ~w or system resources'- 1392 [Name, File] ]. 1393prologmessage(qsave(nondet)) --> 1394 [ 'qsave_program/2 succeeded with a choice point'-[] ]. 1395prologmessage(copy_foreign_library(Lib,Dir)) --> 1396 [ '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.
*/