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-2019, University of Amsterdam 7 VU University Amsterdam 8 CWI, Amsterdam 9 All rights reserved. 10 11 Redistribution and use in source and binary forms, with or without 12 modification, are permitted provided that the following conditions 13 are met: 14 15 1. Redistributions of source code must retain the above copyright 16 notice, this list of conditions and the following disclaimer. 17 18 2. Redistributions in binary form must reproduce the above copyright 19 notice, this list of conditions and the following disclaimer in 20 the documentation and/or other materials provided with the 21 distribution. 22 23 THIS SOFTWARE IS PROVIDED BY THE COPYRIGHT HOLDERS AND CONTRIBUTORS 24 "AS IS" AND ANY EXPRESS OR IMPLIED WARRANTIES, INCLUDING, BUT NOT 25 LIMITED TO, THE IMPLIED WARRANTIES OF MERCHANTABILITY AND FITNESS 26 FOR A PARTICULAR PURPOSE ARE DISCLAIMED. IN NO EVENT SHALL THE 27 COPYRIGHT OWNER OR CONTRIBUTORS BE LIABLE FOR ANY DIRECT, INDIRECT, 28 INCIDENTAL, SPECIAL, EXEMPLARY, OR CONSEQUENTIAL DAMAGES (INCLUDING, 29 BUT NOT LIMITED TO, PROCUREMENT OF SUBSTITUTE GOODS OR SERVICES; 30 LOSS OF USE, DATA, OR PROFITS; OR BUSINESS INTERRUPTION) HOWEVER 31 CAUSED AND ON ANY THEORY OF LIABILITY, WHETHER IN CONTRACT, STRICT 32 LIABILITY, OR TORT (INCLUDING NEGLIGENCE OR OTHERWISE) ARISING IN 33 ANY WAY OUT OF THE USE OF THIS SOFTWARE, EVEN IF ADVISED OF THE 34 POSSIBILITY OF SUCH DAMAGE. 35*/ 36 37:- module(qsave, 38 [ qsave_program/1, % +File 39 qsave_program/2 % +File, +Options 40 ]). 41:- use_module(library(lists)). 42:- use_module(library(option)). 43:- use_module(library(error)). 44:- use_module(library(apply)).
56:- meta_predicate 57 qsave_program(, ). 58 59:- multifile error:has_type/2. 60errorhas_type(qsave_foreign_option, Term) :- 61 is_of_type(oneof([save, no_save]), Term), 62 !. 63errorhas_type(qsave_foreign_option, arch(Archs)) :- 64 is_of_type(list(atom), Archs), 65 !. 66 67save_option(stack_limit, integer, 68 "Stack limit (bytes)"). 69save_option(goal, callable, 70 "Main initialization goal"). 71save_option(toplevel, callable, 72 "Toplevel goal"). 73save_option(init_file, atom, 74 "Application init file"). 75save_option(class, oneof([runtime,development]), 76 "Development state"). 77save_option(op, oneof([save,standard]), 78 "Save operators"). 79save_option(autoload, boolean, 80 "Resolve autoloadable predicates"). 81save_option(map, atom, 82 "File to report content of the state"). 83save_option(stand_alone, boolean, 84 "Add emulator at start"). 85save_option(emulator, ground, 86 "Emulator to use"). 87save_option(foreign, qsave_foreign_option, 88 "Include foreign code in state"). 89save_option(obfuscate, boolean, 90 "Obfuscate identifiers"). 91save_option(verbose, boolean, 92 "Be more verbose about the state creation"). 93save_option(undefined, oneof([ignore,error]), 94 "How to handle undefined predicates"). 95 96term_expansion(save_pred_options, 97 (:- predicate_options(qsave_program/2, 2, Options))) :- 98 findall(O, 99 ( save_option(Name, Type, _), 100 O =.. [Name,Type] 101 ), 102 Options). 103 104save_pred_options. 105 106:- set_prolog_flag(generate_debug_info, false). 107 108:- dynamic 109 verbose/1, 110 saved_resource_file/1. 111:- volatile 112 verbose/1, % contains a stream-handle 113 saved_resource_file/1.
120qsave_program(File) :- 121 qsave_program(File, []). 122 123qsave_program(FileBase, Options0) :- 124 meta_options(is_meta, Options0, Options), 125 check_options(Options), 126 exe_file(FileBase, File, Options), 127 option(class(SaveClass), Options, runtime), 128 option(init_file(InitFile), Options, DefInit), 129 default_init_file(SaveClass, DefInit), 130 prepare_entry_points(Options), 131 save_autoload(Options), 132 setup_call_cleanup( 133 open_map(Options), 134 ( prepare_state(Options), 135 create_prolog_flag(saved_program, true, []), 136 create_prolog_flag(saved_program_class, SaveClass, []), 137 delete_if_exists(File), % truncate will crash Prolog's 138 % running on this state 139 setup_call_catcher_cleanup( 140 open(File, write, StateOut, [type(binary)]), 141 write_state(StateOut, SaveClass, InitFile, Options), 142 Reason, 143 finalize_state(Reason, StateOut, File)) 144 ), 145 close_map), 146 cleanup, 147 !. 148 149write_state(StateOut, SaveClass, InitFile, Options) :- 150 make_header(StateOut, SaveClass, Options), 151 setup_call_cleanup( 152 zip_open_stream(StateOut, RC, []), 153 write_zip_state(RC, SaveClass, InitFile, Options), 154 zip_close(RC, [comment("SWI-Prolog saved state")])), 155 flush_output(StateOut). 156 157write_zip_state(RC, SaveClass, InitFile, Options) :- 158 save_options(RC, SaveClass, 159 [ init_file(InitFile) 160 | Options 161 ]), 162 save_resources(RC, SaveClass), 163 lock_files(SaveClass), 164 save_program(RC, SaveClass, Options), 165 save_foreign_libraries(RC, Options). 166 167finalize_state(exit, StateOut, File) :- 168 close(StateOut), 169 '$mark_executable'(File). 170finalize_state(!, StateOut, File) :- 171 print_message(warning, qsave(nondet)), 172 finalize_state(exit, StateOut, File). 173finalize_state(_, StateOut, File) :- 174 close(StateOut, [force(true)]), 175 catch(delete_file(File), 176 Error, 177 print_message(error, Error)). 178 179cleanup :- 180 retractall(saved_resource_file(_)). 181 182is_meta(goal). 183is_meta(toplevel). 184 185exe_file(Base, Exe, Options) :- 186 current_prolog_flag(windows, true), 187 option(stand_alone(true), Options, true), 188 file_name_extension(_, '', Base), 189 !, 190 file_name_extension(Base, exe, Exe). 191exe_file(Exe, Exe, _). 192 193default_init_file(runtime, none) :- !. 194default_init_file(_, InitFile) :- 195 '$cmd_option_val'(init_file, InitFile). 196 197delete_if_exists(File) :- 198 ( exists_file(File) 199 -> delete_file(File) 200 ; true 201 ). 202 203 /******************************* 204 * HEADER * 205 *******************************/
209make_header(Out, _, Options) :- 210 option(emulator(OptVal), Options), 211 !, 212 absolute_file_name(OptVal, [access(read)], Emulator), 213 setup_call_cleanup( 214 open(Emulator, read, In, [type(binary)]), 215 copy_stream_data(In, Out), 216 close(In)). 217make_header(Out, _, Options) :- 218 ( current_prolog_flag(windows, true) 219 -> DefStandAlone = true 220 ; DefStandAlone = false 221 ), 222 option(stand_alone(true), Options, DefStandAlone), 223 !, 224 current_prolog_flag(executable, Executable), 225 setup_call_cleanup( 226 open(Executable, read, In, [type(binary)]), 227 copy_stream_data(In, Out), 228 close(In)). 229make_header(Out, SaveClass, _Options) :- 230 current_prolog_flag(unix, true), 231 !, 232 current_prolog_flag(executable, Executable), 233 current_prolog_flag(posix_shell, Shell), 234 format(Out, '#!~w~n', [Shell]), 235 format(Out, '# SWI-Prolog saved state~n', []), 236 ( SaveClass == runtime 237 -> ArgSep = ' -- ' 238 ; ArgSep = ' ' 239 ), 240 format(Out, 'exec ${SWIPL-~w} -x "$0"~w"$@"~n~n', [Executable, ArgSep]). 241make_header(_, _, _). 242 243 244 /******************************* 245 * OPTIONS * 246 *******************************/ 247 248min_stack(stack_limit, 100_000). 249 250convert_option(Stack, Val, NewVal, "~w") :- % stack-sizes are in K-bytes 251 min_stack(Stack, Min), 252 !, 253 ( Val == 0 254 -> NewVal = Val 255 ; NewVal is max(Min, Val) 256 ). 257convert_option(toplevel, Callable, Callable, "~q") :- !. 258convert_option(_, Value, Value, "~w"). 259 260doption(Name) :- min_stack(Name, _). 261doption(init_file). 262doption(system_init_file). 263doption(class). 264doption(home).
The script files (-s script) are not saved at all. I think this is fine to avoid a save-script loading itself.
275save_options(RC, SaveClass, Options) :-
276 zipper_open_new_file_in_zip(RC, '$prolog/options.txt', Fd, []),
277 ( doption(OptionName),
278 '$cmd_option_val'(OptionName, OptionVal0),
279 save_option_value(SaveClass, OptionName, OptionVal0, OptionVal1),
280 OptTerm =.. [OptionName,OptionVal2],
281 ( option(OptTerm, Options)
282 -> convert_option(OptionName, OptionVal2, OptionVal, FmtVal)
283 ; OptionVal = OptionVal1,
284 FmtVal = "~w"
285 ),
286 atomics_to_string(["~w=", FmtVal, "~n"], Fmt),
287 format(Fd, Fmt, [OptionName, OptionVal]),
288 fail
289 ; true
290 ),
291 save_init_goals(Fd, Options),
292 close(Fd).296save_option_value(Class, class, _, Class) :- !. 297save_option_value(runtime, home, _, _) :- !, fail. 298save_option_value(_, _, Value, Value).
goal(Goal) option, use
that, else save the goals from '$cmd_option_val'/2.305save_init_goals(Out, Options) :- 306 option(goal(Goal), Options), 307 !, 308 format(Out, 'goal=~q~n', [Goal]), 309 save_toplevel_goal(Out, halt, Options). 310save_init_goals(Out, Options) :- 311 '$cmd_option_val'(goals, Goals), 312 forall(member(Goal, Goals), 313 format(Out, 'goal=~w~n', [Goal])), 314 ( Goals == [] 315 -> DefToplevel = default 316 ; DefToplevel = halt 317 ), 318 save_toplevel_goal(Out, DefToplevel, Options). 319 320save_toplevel_goal(Out, _Default, Options) :- 321 option(toplevel(Goal), Options), 322 !, 323 unqualify_reserved_goal(Goal, Goal1), 324 format(Out, 'toplevel=~q~n', [Goal1]). 325save_toplevel_goal(Out, _Default, _Options) :- 326 '$cmd_option_val'(toplevel, Toplevel), 327 Toplevel \== default, 328 !, 329 format(Out, 'toplevel=~w~n', [Toplevel]). 330save_toplevel_goal(Out, Default, _Options) :- 331 format(Out, 'toplevel=~q~n', [Default]). 332 333unqualify_reserved_goal(_:prolog, prolog) :- !. 334unqualify_reserved_goal(_:default, default) :- !. 335unqualify_reserved_goal(Goal, Goal). 336 337 338 /******************************* 339 * RESOURCES * 340 *******************************/ 341 342save_resources(_RC, development) :- !. 343save_resources(RC, _SaveClass) :- 344 feedback('~nRESOURCES~n~n', []), 345 copy_resources(RC), 346 forall(declared_resource(Name, FileSpec, Options), 347 save_resource(RC, Name, FileSpec, Options)). 348 349declared_resource(RcName, FileSpec, []) :- 350 current_predicate(_, M:resource(_,_)), 351 M:resource(Name, FileSpec), 352 mkrcname(M, Name, RcName). 353declared_resource(RcName, FileSpec, Options) :- 354 current_predicate(_, M:resource(_,_,_)), 355 M:resource(Name, A2, A3), 356 ( is_list(A3) 357 -> FileSpec = A2, 358 Options = A3 359 ; FileSpec = A3 360 ), 361 mkrcname(M, Name, RcName).
367mkrcname(user, Name0, Name) :- 368 !, 369 path_segments_to_atom(Name0, Name). 370mkrcname(M, Name0, RcName) :- 371 path_segments_to_atom(Name0, Name), 372 atomic_list_concat([M, :, Name], RcName). 373 374path_segments_to_atom(Name0, Name) :- 375 phrase(segments_to_atom(Name0), Atoms), 376 atomic_list_concat(Atoms, /, Name). 377 378segments_to_atom(Var) --> 379 { var(Var), !, 380 instantiation_error(Var) 381 }. 382segments_to_atom(A/B) --> 383 !, 384 segments_to_atom(A), 385 segments_to_atom(B). 386segments_to_atom(A) --> 387 [A].
393save_resource(RC, Name, FileSpec, _Options) :- 394 absolute_file_name(FileSpec, 395 [ access(read), 396 file_errors(fail) 397 ], File), 398 !, 399 feedback('~t~8|~w~t~32|~w~n', 400 [Name, File]), 401 zipper_append_file(RC, Name, File, []). 402save_resource(RC, Name, FileSpec, Options) :- 403 findall(Dir, 404 absolute_file_name(FileSpec, Dir, 405 [ access(read), 406 file_type(directory), 407 file_errors(fail), 408 solutions(all) 409 ]), 410 Dirs), 411 Dirs \== [], 412 !, 413 forall(member(Dir, Dirs), 414 ( feedback('~t~8|~w~t~32|~w~n', 415 [Name, Dir]), 416 zipper_append_directory(RC, Name, Dir, Options))). 417save_resource(RC, Name, _, _Options) :- 418 '$rc_handle'(SystemRC), 419 copy_resource(SystemRC, RC, Name), 420 !. 421save_resource(_, Name, FileSpec, _Options) :- 422 print_message(warning, 423 error(existence_error(resource, 424 resource(Name, FileSpec)), 425 _)). 426 427copy_resources(ToRC) :- 428 '$rc_handle'(FromRC), 429 zipper_members(FromRC, List), 430 ( member(Name, List), 431 \+ declared_resource(Name, _, _), 432 \+ reserved_resource(Name), 433 copy_resource(FromRC, ToRC, Name), 434 fail 435 ; true 436 ). 437 438reserved_resource('$prolog/state.qlf'). 439reserved_resource('$prolog/options.txt'). 440 441copy_resource(FromRC, ToRC, Name) :- 442 ( zipper_goto(FromRC, file(Name)) 443 -> true 444 ; existence_error(resource, Name) 445 ), 446 zipper_file_info(FromRC, _Name, Attrs), 447 get_dict(time, Attrs, Time), 448 setup_call_cleanup( 449 zipper_open_current(FromRC, FdIn, 450 [ type(binary), 451 time(Time) 452 ]), 453 setup_call_cleanup( 454 zipper_open_new_file_in_zip(ToRC, Name, FdOut, []), 455 ( feedback('~t~8|~w~t~24|~w~n', 456 [Name, '<Copied from running state>']), 457 copy_stream_data(FdIn, FdOut) 458 ), 459 close(FdOut)), 460 close(FdIn)). 461 462 463 /******************************* 464 * OBFUSCATE * 465 *******************************/
471:- multifile prolog:obfuscate_identifiers/1. 472 473create_mapping(Options) :- 474 option(obfuscate(true), Options), 475 !, 476 ( predicate_property(prolog:obfuscate_identifiers(_), number_of_clauses(N)), 477 N > 0 478 -> true 479 ; use_module(library(obfuscate)) 480 ), 481 ( catch(prolog:obfuscate_identifiers(Options), E, 482 print_message(error, E)) 483 -> true 484 ; print_message(warning, failed(obfuscate_identifiers)) 485 ). 486create_mapping(_).
runtime, lock all files such that when running the
program the system stops checking existence and modification time on
the filesystem.
496lock_files(runtime) :- 497 !, 498 '$set_source_files'(system). % implies from_state 499lock_files(_) :- 500 '$set_source_files'(from_state).
506save_program(RC, SaveClass, Options) :- 507 zipper_open_new_file_in_zip(RC, '$prolog/state.qlf', StateFd, []), 508 setup_call_cleanup( 509 ( current_prolog_flag(access_level, OldLevel), 510 set_prolog_flag(access_level, system), % generate system modules 511 '$open_wic'(StateFd, Options) 512 ), 513 ( create_mapping(Options), 514 save_modules(SaveClass), 515 save_records, 516 save_flags, 517 save_prompt, 518 save_imports, 519 save_prolog_flags, 520 save_operators(Options), 521 save_format_predicates 522 ), 523 ( '$close_wic', 524 set_prolog_flag(access_level, OldLevel) 525 )), 526 close(StateFd). 527 528 529 /******************************* 530 * MODULES * 531 *******************************/ 532 533save_modules(SaveClass) :- 534 forall(special_module(X), 535 save_module(X, SaveClass)), 536 forall((current_module(X), \+ special_module(X)), 537 save_module(X, SaveClass)). 538 539special_module(system). 540special_module(user).
549prepare_entry_points(Options) :- 550 define_init_goal(Options), 551 define_toplevel_goal(Options). 552 553define_init_goal(Options) :- 554 option(goal(Goal), Options), 555 !, 556 entry_point(Goal). 557define_init_goal(_). 558 559define_toplevel_goal(Options) :- 560 option(toplevel(Goal), Options), 561 !, 562 entry_point(Goal). 563define_toplevel_goal(_). 564 565entry_point(Goal) :- 566 define_predicate(Goal), 567 ( \+ predicate_property(Goal, built_in), 568 \+ predicate_property(Goal, imported_from(_)) 569 -> goal_pi(Goal, PI), 570 public(PI) 571 ; true 572 ). 573 574define_predicate(Head) :- 575 '$define_predicate'(Head), 576 !. % autoloader 577define_predicate(Head) :- 578 strip_module(Head, _, Term), 579 functor(Term, Name, Arity), 580 throw(error(existence_error(procedure, Name/Arity), _)). 581 582goal_pi(M:G, QPI) :- 583 !, 584 strip_module(M:G, Module, Goal), 585 functor(Goal, Name, Arity), 586 QPI = Module:Name/Arity. 587goal_pi(Goal, Name/Arity) :- 588 functor(Goal, Name, Arity).
prepare_state registered
initialization hooks.595prepare_state(_) :- 596 forall('$init_goal'(when(prepare_state), Goal, Ctx), 597 run_initialize(Goal, Ctx)). 598 599run_initialize(Goal, Ctx) :- 600 ( catch(Goal, E, true), 601 ( var(E) 602 -> true 603 ; throw(error(initialization_error(E, Goal, Ctx), _)) 604 ) 605 ; throw(error(initialization_error(failed, Goal, Ctx), _)) 606 ). 607 608 609 /******************************* 610 * AUTOLOAD * 611 *******************************/
620save_autoload(Options) :- 621 option(autoload(true), Options, true), 622 !, 623 autoload(Options). 624save_autoload(_). 625 626 627 /******************************* 628 * MODULES * 629 *******************************/
635save_module(M, SaveClass) :- 636 '$qlf_start_module'(M), 637 feedback('~n~nMODULE ~w~n', [M]), 638 save_unknown(M), 639 ( P = (M:_H), 640 current_predicate(_, P), 641 \+ predicate_property(P, imported_from(_)), 642 save_predicate(P, SaveClass), 643 fail 644 ; '$qlf_end_part', 645 feedback('~n', []) 646 ). 647 648save_predicate(P, _SaveClass) :- 649 predicate_property(P, foreign), 650 !, 651 P = (M:H), 652 functor(H, Name, Arity), 653 feedback('~npre-defining foreign ~w/~d ', [Name, Arity]), 654 '$add_directive_wic'('$predefine_foreign'(M:Name/Arity)). 655save_predicate(P, SaveClass) :- 656 P = (M:H), 657 functor(H, F, A), 658 feedback('~nsaving ~w/~d ', [F, A]), 659 ( H = resource(_,_,_), 660 SaveClass \== development 661 -> save_attribute(P, (dynamic)), 662 ( M == user 663 -> save_attribute(P, (multifile)) 664 ), 665 feedback('(Skipped clauses)', []), 666 fail 667 ; true 668 ), 669 ( no_save(P) 670 -> true 671 ; save_attributes(P), 672 \+ predicate_property(P, (volatile)), 673 ( nth_clause(P, _, Ref), 674 feedback('.', []), 675 '$qlf_assert_clause'(Ref, SaveClass), 676 fail 677 ; true 678 ) 679 ). 680 681no_save(P) :- 682 predicate_property(P, volatile), 683 \+ predicate_property(P, dynamic), 684 \+ predicate_property(P, multifile). 685 686pred_attrib(meta_predicate(Term), Head, meta_predicate(M:Term)) :- 687 !, 688 strip_module(Head, M, _). 689pred_attrib(Attrib, Head, 690 '$set_predicate_attribute'(M:Name/Arity, AttName, Val)) :- 691 attrib_name(Attrib, AttName, Val), 692 strip_module(Head, M, Term), 693 functor(Term, Name, Arity). 694 695attrib_name(dynamic, dynamic, true). 696attrib_name(volatile, volatile, true). 697attrib_name(thread_local, thread_local, true). 698attrib_name(multifile, multifile, true). 699attrib_name(public, public, true). 700attrib_name(transparent, transparent, true). 701attrib_name(discontiguous, discontiguous, true). 702attrib_name(notrace, trace, false). 703attrib_name(show_childs, hide_childs, false). 704attrib_name(built_in, system, true). 705attrib_name(nodebug, hide_childs, true). 706attrib_name(quasi_quotation_syntax, quasi_quotation_syntax, true). 707attrib_name(iso, iso, true). 708 709 710save_attribute(P, Attribute) :- 711 pred_attrib(Attribute, P, D), 712 ( Attribute == built_in % no need if there are clauses 713 -> ( predicate_property(P, number_of_clauses(0)) 714 -> true 715 ; predicate_property(P, volatile) 716 ) 717 ; Attribute == 'dynamic' % no need if predicate is thread_local 718 -> \+ predicate_property(P, thread_local) 719 ; true 720 ), 721 '$add_directive_wic'(D), 722 feedback('(~w) ', [Attribute]). 723 724save_attributes(P) :- 725 ( predicate_property(P, Attribute), 726 save_attribute(P, Attribute), 727 fail 728 ; true 729 ). 730 731% Save status of the unknown flag 732 733save_unknown(M) :- 734 current_prolog_flag(Munknown, Unknown), 735 ( Unknown == error 736 -> true 737 ; '$add_directive_wic'(set_prolog_flag(Munknown, Unknown)) 738 ). 739 740 /******************************* 741 * RECORDS * 742 *******************************/ 743 744save_records :- 745 feedback('~nRECORDS~n', []), 746 ( current_key(X), 747 X \== '$topvar', % do not safe toplevel variables 748 feedback('~n~t~8|~w ', [X, V]), 749 recorded(X, V, _), 750 feedback('.', []), 751 '$add_directive_wic'(recordz(X, V, _)), 752 fail 753 ; true 754 ). 755 756 757 /******************************* 758 * FLAGS * 759 *******************************/ 760 761save_flags :- 762 feedback('~nFLAGS~n~n', []), 763 ( current_flag(X), 764 flag(X, V, V), 765 feedback('~t~8|~w = ~w~n', [X, V]), 766 '$add_directive_wic'(set_flag(X, V)), 767 fail 768 ; true 769 ). 770 771save_prompt :- 772 feedback('~nPROMPT~n~n', []), 773 prompt(Prompt, Prompt), 774 '$add_directive_wic'(prompt(_, Prompt)). 775 776 777 /******************************* 778 * IMPORTS * 779 *******************************/
789save_imports :- 790 feedback('~nIMPORTS~n~n', []), 791 ( predicate_property(M:H, imported_from(I)), 792 \+ default_import(M, H, I), 793 functor(H, F, A), 794 feedback('~t~8|~w:~w/~d <-- ~w~n', [M, F, A, I]), 795 '$add_directive_wic'(qsave:restore_import(M, I, F/A)), 796 fail 797 ; true 798 ). 799 800default_import(To, Head, From) :- 801 '$get_predicate_attribute'(To:Head, (dynamic), 1), 802 predicate_property(From:Head, exported), 803 !, 804 fail. 805default_import(Into, _, From) :- 806 default_module(Into, From).
user, avoiding a message that the predicate is not
exported.814restore_import(To, user, PI) :- 815 !, 816 export(user:PI), 817 To:import(user:PI). 818restore_import(To, From, PI) :- 819 To:import(From:PI). 820 821 /******************************* 822 * PROLOG FLAGS * 823 *******************************/ 824 825save_prolog_flags :- 826 feedback('~nPROLOG FLAGS~n~n', []), 827 '$current_prolog_flag'(Flag, Value, _Scope, write, Type), 828 \+ no_save_flag(Flag), 829 feedback('~t~8|~w: ~w (type ~q)~n', [Flag, Value, Type]), 830 '$add_directive_wic'(qsave:restore_prolog_flag(Flag, Value, Type)), 831 fail. 832save_prolog_flags. 833 834no_save_flag(argv). 835no_save_flag(os_argv). 836no_save_flag(access_level). 837no_save_flag(tty_control). 838no_save_flag(readline). 839no_save_flag(associated_file). 840no_save_flag(cpu_count). 841no_save_flag(hwnd). % should be read-only, but comes 842 % from user-code
849restore_prolog_flag(Flag, Value, _Type) :- 850 current_prolog_flag(Flag, Value), 851 !. 852restore_prolog_flag(Flag, Value, _Type) :- 853 current_prolog_flag(Flag, _), 854 !, 855 catch(set_prolog_flag(Flag, Value), _, true). 856restore_prolog_flag(Flag, Value, Type) :- 857 create_prolog_flag(Flag, Value, [type(Type)]). 858 859 860 /******************************* 861 * OPERATORS * 862 *******************************/
system are
not saved because these are read-only anyway.869save_operators(Options) :- 870 !, 871 option(op(save), Options, save), 872 feedback('~nOPERATORS~n', []), 873 forall(current_module(M), save_module_operators(M)), 874 feedback('~n', []). 875save_operators(_). 876 877save_module_operators(system) :- !. 878save_module_operators(M) :- 879 forall('$local_op'(P,T,M:N), 880 ( feedback('~n~t~8|~w ', [op(P,T,M:N)]), 881 '$add_directive_wic'(op(P,T,M:N)) 882 )). 883 884 885 /******************************* 886 * FORMAT PREDICATES * 887 *******************************/ 888 889save_format_predicates :- 890 feedback('~nFORMAT PREDICATES~n', []), 891 current_format_predicate(Code, Head), 892 qualify_head(Head, QHead), 893 D = format_predicate(Code, QHead), 894 feedback('~n~t~8|~w ', [D]), 895 '$add_directive_wic'(D), 896 fail. 897save_format_predicates. 898 899qualify_head(T, T) :- 900 functor(T, :, 2), 901 !. 902qualify_head(T, user:T). 903 904 905 /******************************* 906 * FOREIGN LIBRARIES * 907 *******************************/
913save_foreign_libraries(RC, Options) :- 914 option(foreign(save), Options), 915 !, 916 current_prolog_flag(arch, HostArch), 917 feedback('~nHOST(~w) FOREIGN LIBRARIES~n', [HostArch]), 918 save_foreign_libraries1(HostArch, RC, Options). 919save_foreign_libraries(RC, Options) :- 920 option(foreign(arch(Archs)), Options), 921 !, 922 forall(member(Arch, Archs), 923 ( feedback('~n~w FOREIGN LIBRARIES~n', [Arch]), 924 save_foreign_libraries1(Arch, RC, Options) 925 )). 926save_foreign_libraries(_, _). 927 928save_foreign_libraries1(Arch, RC, _Options) :- 929 forall(current_foreign_library(FileSpec, _Predicates), 930 ( find_foreign_library(Arch, FileSpec, EntryName, File, Time), 931 term_to_atom(EntryName, Name), 932 zipper_append_file(RC, Name, File, [time(Time)]) 933 )).
strip -o <tmp>
<shared-object>. Note that (if stripped) the file is a Prolog tmp
file and will be deleted on halt.
947find_foreign_library(Arch, FileSpec, shlib(Arch,Name), SharedObject, Time) :-
948 FileSpec = foreign(Name),
949 ( catch(arch_find_shlib(Arch, FileSpec, File),
950 E,
951 print_message(error, E)),
952 exists_file(File)
953 -> true
954 ; throw(error(existence_error(architecture_shlib(Arch), FileSpec),_))
955 ),
956 time_file(File, Time),
957 strip_file(File, SharedObject).964strip_file(File, Stripped) :- 965 absolute_file_name(path(strip), Strip, 966 [ access(execute), 967 file_errors(fail) 968 ]), 969 tmp_file(shared, Stripped), 970 ( catch(do_strip_file(Strip, File, Stripped), E, 971 (print_message(warning, E), fail)) 972 -> true 973 ; print_message(warning, qsave(strip_failed(File))), 974 fail 975 ), 976 !. 977strip_file(File, File). 978 979do_strip_file(Strip, File, Stripped) :- 980 format(atom(Cmd), '"~w" -o "~w" "~w"', 981 [Strip, Stripped, File]), 982 shell(Cmd), 983 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.
997:- multifile arch_shlib/3. 998 999arch_find_shlib(Arch, FileSpec, File) :- 1000 arch_shlib(Arch, FileSpec, File), 1001 !. 1002arch_find_shlib(Arch, FileSpec, File) :- 1003 current_prolog_flag(arch, Arch), 1004 absolute_file_name(FileSpec, 1005 [ file_type(executable), 1006 access(read), 1007 file_errors(fail) 1008 ], File). 1009 1010 1011 /******************************* 1012 * UTIL * 1013 *******************************/ 1014 1015open_map(Options) :- 1016 option(map(Map), Options), 1017 !, 1018 open(Map, write, Fd), 1019 asserta(verbose(Fd)). 1020open_map(_) :- 1021 retractall(verbose(_)). 1022 1023close_map :- 1024 retract(verbose(Fd)), 1025 close(Fd), 1026 !. 1027close_map. 1028 1029feedback(Fmt, Args) :- 1030 verbose(Fd), 1031 !, 1032 format(Fd, Fmt, Args). 1033feedback(_, _). 1034 1035 1036check_options([]) :- !. 1037check_options([Var|_]) :- 1038 var(Var), 1039 !, 1040 throw(error(domain_error(save_options, Var), _)). 1041check_options([Name=Value|T]) :- 1042 !, 1043 ( save_option(Name, Type, _Comment) 1044 -> ( must_be(Type, Value) 1045 -> check_options(T) 1046 ; throw(error(domain_error(Type, Value), _)) 1047 ) 1048 ; throw(error(domain_error(save_option, Name), _)) 1049 ). 1050check_options([Term|T]) :- 1051 Term =.. [Name,Arg], 1052 !, 1053 check_options([Name=Arg|T]). 1054check_options([Var|_]) :- 1055 throw(error(domain_error(save_options, Var), _)). 1056check_options(Opt) :- 1057 throw(error(domain_error(list, Opt), _)).
1064zipper_append_file(_, Name, _, _) :- 1065 saved_resource_file(Name), 1066 !. 1067zipper_append_file(_, _, File, _) :- 1068 source_file(File), 1069 !. 1070zipper_append_file(Zipper, Name, File, Options) :- 1071 ( option(time(_), Options) 1072 -> Options1 = Options 1073 ; time_file(File, Stamp), 1074 Options1 = [time(Stamp)|Options] 1075 ), 1076 setup_call_cleanup( 1077 open(File, read, In, [type(binary)]), 1078 setup_call_cleanup( 1079 zipper_open_new_file_in_zip(Zipper, Name, Out, Options1), 1080 copy_stream_data(In, Out), 1081 close(Out)), 1082 close(In)), 1083 assertz(saved_resource_file(Name)).
time(Stamp).1090zipper_add_directory(Zipper, Name, Dir, Options) :- 1091 ( option(time(Stamp), Options) 1092 -> true 1093 ; time_file(Dir, Stamp) 1094 ), 1095 atom_concat(Name, /, DirName), 1096 ( saved_resource_file(DirName) 1097 -> true 1098 ; setup_call_cleanup( 1099 zipper_open_new_file_in_zip(Zipper, DirName, Out, 1100 [ method(store), 1101 time(Stamp) 1102 | Options 1103 ]), 1104 true, 1105 close(Out)), 1106 assertz(saved_resource_file(DirName)) 1107 ). 1108 1109add_parent_dirs(Zipper, Name, Dir, Options) :- 1110 ( option(time(Stamp), Options) 1111 -> true 1112 ; time_file(Dir, Stamp) 1113 ), 1114 file_directory_name(Name, Parent), 1115 ( Parent \== Name 1116 -> add_parent_dirs(Zipper, Parent, [time(Stamp)|Options]) 1117 ; true 1118 ). 1119 1120add_parent_dirs(_, '.', _) :- 1121 !. 1122add_parent_dirs(Zipper, Name, Options) :- 1123 zipper_add_directory(Zipper, Name, _, Options), 1124 file_directory_name(Name, Parent), 1125 ( Parent \== Name 1126 -> add_parent_dirs(Zipper, Parent, Options) 1127 ; true 1128 ).
1146zipper_append_directory(Zipper, Name, Dir, Options) :- 1147 exists_directory(Dir), 1148 !, 1149 add_parent_dirs(Zipper, Name, Dir, Options), 1150 zipper_add_directory(Zipper, Name, Dir, Options), 1151 directory_files(Dir, Members), 1152 forall(member(M, Members), 1153 ( reserved(M) 1154 -> true 1155 ; ignored(M, Options) 1156 -> true 1157 ; atomic_list_concat([Dir,M], /, Entry), 1158 atomic_list_concat([Name,M], /, Store), 1159 catch(zipper_append_directory(Zipper, Store, Entry, Options), 1160 E, 1161 print_message(warning, E)) 1162 )). 1163zipper_append_directory(Zipper, Name, File, Options) :- 1164 zipper_append_file(Zipper, Name, File, Options). 1165 1166reserved(.). 1167reserved(..).
include(Patterns) option that does not
match File or an exclude(Patterns) that does match File.1174ignored(File, Options) :- 1175 option(include(Patterns), Options), 1176 \+ ( ( is_list(Patterns) 1177 -> member(Pattern, Patterns) 1178 ; Pattern = Patterns 1179 ), 1180 wildcard_match(Pattern, File) 1181 ), 1182 !. 1183ignored(File, Options) :- 1184 option(exclude(Patterns), Options), 1185 ( is_list(Patterns) 1186 -> member(Pattern, Patterns) 1187 ; Pattern = Patterns 1188 ), 1189 wildcard_match(Pattern, File), 1190 !. 1191 1192 1193 /******************************** 1194 * SAVED STATE GENERATION * 1195 *********************************/
1201:- public 1202 qsave_toplevel/0. 1203 1204qsave_toplevel :- 1205 current_prolog_flag(os_argv, Argv), 1206 qsave_options(Argv, Files, Options), 1207 '$cmd_option_val'(compileout, Out), 1208 user:consult(Files), 1209 user:qsave_program(Out, Options). 1210 1211qsave_options([], [], []). 1212qsave_options([--|_], [], []) :- 1213 !. 1214qsave_options(['-c'|T0], Files, Options) :- 1215 !, 1216 argv_files(T0, T1, Files, FilesT), 1217 qsave_options(T1, FilesT, Options). 1218qsave_options([O|T0], Files, [Option|T]) :- 1219 string_concat("--", Opt, O), 1220 split_string(Opt, "=", "", [NameS|Rest]), 1221 atom_string(Name, NameS), 1222 qsave_option(Name, OptName, Rest, Value), 1223 !, 1224 Option =.. [OptName, Value], 1225 qsave_options(T0, Files, T). 1226qsave_options([_|T0], Files, T) :- 1227 qsave_options(T0, Files, T). 1228 1229argv_files([], [], Files, Files). 1230argv_files([H|T], [H|T], Files, Files) :- 1231 sub_atom(H, 0, _, _, -), 1232 !. 1233argv_files([H|T0], T, [H|Files0], Files) :- 1234 argv_files(T0, T, Files0, Files).
1238qsave_option(Name, Name, [], true) :- 1239 save_option(Name, boolean, _), 1240 !. 1241qsave_option(NoName, Name, [], false) :- 1242 atom_concat('no-', Name, NoName), 1243 save_option(Name, boolean, _), 1244 !. 1245qsave_option(Name, Name, ValueStrings, Value) :- 1246 save_option(Name, Type, _), 1247 !, 1248 atomics_to_string(ValueStrings, "=", ValueString), 1249 convert_option_value(Type, ValueString, Value). 1250qsave_option(Name, Name, _Chars, _Value) :- 1251 existence_error(save_option, Name). 1252 1253convert_option_value(integer, String, Value) :- 1254 ( number_string(Value, String) 1255 -> true 1256 ; domain_error(integer, String) 1257 ). 1258convert_option_value(callable, String, Value) :- 1259 term_string(Value, String). 1260convert_option_value(atom, String, Value) :- 1261 atom_string(Value, String). 1262convert_option_value(boolean, String, Value) :- 1263 atom_string(Value, String). 1264convert_option_value(oneof(_), String, Value) :- 1265 atom_string(Value, String). 1266convert_option_value(ground, String, Value) :- 1267 atom_string(Value, String). 1268convert_option_value(qsave_foreign_option, "save", save). 1269convert_option_value(qsave_foreign_option, StrArchList, arch(ArchList)) :- 1270 split_string(StrArchList, ",", ", \t", StrArchList1), 1271 maplist(atom_string, ArchList, StrArchList1). 1272 1273 1274 /******************************* 1275 * MESSAGES * 1276 *******************************/ 1277 1278:- multifile prolog:message/3. 1279 1280prologmessage(no_resource(Name, File)) --> 1281 [ 'Could not find resource ~w on ~w or system resources'- 1282 [Name, File] ]. 1283prologmessage(qsave(nondet)) --> 1284 [ '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.
*/