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