1/* Part of SWI-Prolog 2 3 Author: Jan Wielemaker 4 E-mail: J.Wielemaker@vu.nl 5 WWW: https://www.swi-prolog.org 6 Copyright (c) 1995-2025, 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(home, atom, 92 "Home directory to use for running SWI-Prolog"). 93save_option(stand_alone, boolean, 94 "Add emulator at start"). 95save_option(traditional, boolean, 96 "Use traditional mode"). 97save_option(emulator, ground, 98 "Emulator to use"). 99save_option(foreign, qsave_foreign_option, 100 "Include foreign code in state"). 101save_option(obfuscate, boolean, 102 "Obfuscate identifiers"). 103save_option(verbose, boolean, 104 "Be more verbose about the state creation"). 105save_option(undefined, oneof([ignore,error]), 106 "How to handle undefined predicates"). 107save_option(on_error, oneof([print,halt,status]), 108 "How to handle errors"). 109save_option(on_warning, oneof([print,halt,status]), 110 "How to handle warnings"). 111save_option(zip, boolean, 112 "If true, create a clean `.zip` file"). 113 114term_expansion(save_pred_options, 115 (:- predicate_options(qsave_program/2, 2, Options))) :- 116 findall(O, 117 ( save_option(Name, Type, _), 118 O =.. [Name,Type] 119 ), 120 Options). 121 122save_pred_options. 123 124:- set_prolog_flag(generate_debug_info, false). 125 126:- dynamic 127 verbose/1, 128 saved_resource_file/1. 129:- volatile 130 verbose/1, % contains a stream-handle 131 saved_resource_file/1.
138qsave_program(File) :- 139 qsave_program(File, []). 140 141qsave_program(FileBase, Options0) :- 142 meta_options(is_meta, Options0, Options1), 143 check_options(Options1), 144 exe_file(FileBase, File, Options1), 145 option(class(SaveClass), Options1, runtime), 146 qsave_init_file_option(SaveClass, Options1, Options), 147 prepare_entry_points(Options), 148 save_autoload(Options), 149 qsave_state(File, SaveClass, Options). 150 151qsave_state(File, SaveClass, Options) :- 152 system_specific_join(Join, Options), 153 !, 154 current_prolog_flag(pid, PID), 155 format(atom(ZipFile), '_swipl_state_~d.zip', [PID]), 156 qsave_state(ZipFile, SaveClass, [zip(true)|Options]), 157 emulator(Emulator, Options), 158 call_cleanup( 159 join_exe_and_state(Join, Emulator, ZipFile, File), 160 delete_file(ZipFile)). 161qsave_state(File, SaveClass, Options) :- 162 setup_call_cleanup( 163 open_map(Options), 164 ( prepare_state(Options), 165 create_prolog_flag(saved_program, true, []), 166 create_prolog_flag(saved_program_class, SaveClass, []), 167 delete_if_exists(File), % truncate will crash a Prolog 168 % running on this state 169 setup_call_catcher_cleanup( 170 open(File, write, StateOut, [type(binary)]), 171 write_state(StateOut, SaveClass, File, Options), 172 Reason, 173 finalize_state(Reason, StateOut, File, Options)) 174 ), 175 close_map), 176 cleanup. 177 178write_state(StateOut, SaveClass, ExeFile, Options) :- 179 make_header(StateOut, SaveClass, Options), 180 setup_call_cleanup( 181 zip_open_stream(StateOut, RC, []), 182 write_zip_state(RC, SaveClass, ExeFile, Options), 183 zip_close(RC, [comment('SWI-Prolog saved state')])), 184 flush_output(StateOut). 185 186write_zip_state(RC, SaveClass, ExeFile, Options) :- 187 save_options(RC, SaveClass, Options), 188 save_resources(RC, SaveClass), 189 lock_files(SaveClass), 190 save_program(RC, SaveClass, Options), 191 save_foreign_libraries(RC, ExeFile, Options).
199finalize_state(exit, StateOut, _File, Options) :- 200 option(zip(true), Options), 201 !, 202 close(StateOut). 203finalize_state(exit, StateOut, File, _Options) :- 204 close(StateOut), 205 '$mark_executable'(File). 206finalize_state(!, StateOut, File, Options) :- 207 print_message(warning, qsave(nondet)), 208 finalize_state(exit, StateOut, File, Options). 209finalize_state(_, StateOut, File, _Options) :- 210 close(StateOut, [force(true)]), 211 catch(delete_file(File), 212 Error, 213 print_message(error, Error)). 214 215cleanup :- 216 retractall(saved_resource_file(_)). 217 218is_meta(goal). 219is_meta(toplevel).
.exe
to the given name on Windows.226exe_file(Base, Exe, Options) :- 227 current_prolog_flag(windows, true), 228 option(stand_alone(true), Options, true), 229 file_name_extension(_, '', Base), 230 !, 231 file_name_extension(Base, exe, Exe). 232exe_file(Base, Exe, Options) :- 233 option(zip(true), Options), 234 file_name_extension(_, '', Base), 235 !, 236 file_name_extension(Base, zip, Exe). 237exe_file(Exe, Exe, _). 238 239delete_if_exists(File) :- 240 ( exists_file(File) 241 -> delete_file(File) 242 ; true 243 ). 244 245qsave_init_file_option(runtime, Options1, Options) :- 246 \+ option(init_file(_), Options1), 247 !, 248 Options = [init_file(none)|Options1]. 249qsave_init_file_option(_, Options, Options).
strip(1) or gdb.
This predicate succeeds, indicating how to perform the join, if the current platform supports this feature. After the zip file is created, join_exe_and_state/4 is called to join the emulator to the zip file.
266system_specific_join(objcopy(Prog), Options) :-
267 current_prolog_flag(executable_format, elf),
268 option(stand_alone(true), Options),
269 \+ option(zip(true), Options),
270 absolute_file_name(path(objcopy), Prog,
271 [ access(execute),
272 file_errors(fail)
273 ]).swipl.
Note that we use shell/1 rather than process_create/3. This would be easier, but we do not want dependencies on foreign code that is not needed.
284join_exe_and_state(objcopy(Prog), Emulator, ZipFile, File) => 285 copy_file(Emulator, File), 286 '$mark_executable'(File), 287 shell_quote(Prog, QProg), 288 shell_quote(ZipFile, QZipFile), 289 shell_quote(File, QFile), 290 format(string(Cmd), 291 '~w --add-section .zipdata=~w \c 292 --set-section-flags .zipdata=readonly,data \c 293 ~w', 294 [QProg, QZipFile, QFile]), 295 shell(Cmd). 296 297copy_file(From, To) :- 298 setup_call_cleanup( 299 open(To, write, Out, [type(binary)]), 300 setup_call_cleanup( 301 open(From, read, In, [type(binary)]), 302 copy_stream_data(In, Out), 303 close(In)), 304 close(Out)).
$. Should
we ignore any name holding a quote or $?312shell_quote(Arg, QArg) :- 313 sub_atom(Arg, _, _, _, '\''), 314 !, 315 ( ( sub_atom(Arg, _, _, _, '"') 316 ; sub_atom(Arg, _, _, _, '$') 317 ) 318 -> domain_error(save_file, Arg) 319 ; format(string(QArg), '"~w"', [Arg]) 320 ). 321shell_quote(Arg, QArg) :- 322 format(string(QArg), '\'~w\'', [Arg]). 323 324 325 /******************************* 326 * HEADER * 327 *******************************/
swipl[.exe] or a shell script.334make_header(_Out, _, Options) :- 335 option(zip(true), Options), 336 !. 337make_header(Out, _, Options) :- 338 stand_alone(Options), 339 !, 340 emulator(Emulator, Options), 341 setup_call_cleanup( 342 open(Emulator, read, In, [type(binary)]), 343 copy_stream_data(In, Out), 344 close(In)). 345make_header(Out, SaveClass, Options) :- 346 current_prolog_flag(unix, true), 347 !, 348 emulator(Emulator, Options), 349 current_prolog_flag(posix_shell, Shell), 350 format(Out, '#!~w~n', [Shell]), 351 format(Out, '# SWI-Prolog saved state~n', []), 352 ( SaveClass == runtime 353 -> ArgSep = ' -- ' 354 ; ArgSep = ' ' 355 ), 356 format(Out, 'exec ${SWIPL:-~w} -x "$0"~w"$@"~n~n', [Emulator, ArgSep]). 357make_header(_, _, _). 358 359stand_alone(Options) :- 360 ( current_prolog_flag(windows, true) 361 -> DefStandAlone = true 362 ; DefStandAlone = false 363 ), 364 option(stand_alone(true), Options, DefStandAlone). 365 366emulator(Emulator, Options) :- 367 ( option(emulator(OptVal), Options) 368 -> absolute_file_name(OptVal, [access(read)], Emulator) 369 ; current_prolog_flag(executable, Emulator) 370 ). 371 372 373 374 /******************************* 375 * OPTIONS * 376 *******************************/ 377 378min_stack(stack_limit, 100_000). 379 380convert_option(Stack, Val, NewVal, '~w') :- % stack-sizes are in K-bytes 381 min_stack(Stack, Min), 382 !, 383 ( Val == 0 384 -> NewVal = Val 385 ; NewVal is max(Min, Val) 386 ). 387convert_option(toplevel, Callable, Callable, '~q') :- !. 388convert_option(_, Value, Value, '~w'). 389 390doption(Name) :- min_stack(Name, _). 391doption(init_file). 392doption(system_init_file). 393doption(class). 394doption(home). 395doption(nosignals).
The script files (-s script) are not saved at all. I think this is fine to avoid a save-script loading itself.
406save_options(RC, SaveClass, Options) :-
407 zipper_open_new_file_in_zip(RC, '$prolog/options.txt', Fd, []),
408 ( doption(OptionName),
409 ( OptTerm =.. [OptionName,OptionVal2],
410 option(OptTerm, Options)
411 -> convert_option(OptionName, OptionVal2, OptionVal, FmtVal)
412 ; '$cmd_option_val'(OptionName, OptionVal0),
413 save_option_value(SaveClass, OptionName, OptionVal0, OptionVal1),
414 OptionVal = OptionVal1,
415 FmtVal = '~w'
416 ),
417 atomics_to_string(['~w=', FmtVal, '~n'], Fmt),
418 format(Fd, Fmt, [OptionName, OptionVal]),
419 fail
420 ; true
421 ),
422 save_init_goals(Fd, Options),
423 close(Fd).427save_option_value(Class, class, _, Class) :- !. 428save_option_value(runtime, home, _, _) :- !, fail. 429save_option_value(_, _, Value, Value).
goal(Goal) option, use
that, else save the goals from '$cmd_option_val'/2.436save_init_goals(Out, Options) :- 437 option(goal(Goal), Options), 438 !, 439 format(Out, 'goal=~q~n', [Goal]), 440 save_toplevel_goal(Out, halt, Options). 441save_init_goals(Out, Options) :- 442 '$cmd_option_val'(goals, Goals), 443 forall(member(Goal, Goals), 444 format(Out, 'goal=~w~n', [Goal])), 445 ( Goals == [] 446 -> DefToplevel = default 447 ; DefToplevel = halt 448 ), 449 save_toplevel_goal(Out, DefToplevel, Options). 450 451save_toplevel_goal(Out, _Default, Options) :- 452 option(toplevel(Goal), Options), 453 !, 454 unqualify_reserved_goal(Goal, Goal1), 455 format(Out, 'toplevel=~q~n', [Goal1]). 456save_toplevel_goal(Out, _Default, _Options) :- 457 '$cmd_option_val'(toplevel, Toplevel), 458 Toplevel \== default, 459 !, 460 format(Out, 'toplevel=~w~n', [Toplevel]). 461save_toplevel_goal(Out, Default, _Options) :- 462 format(Out, 'toplevel=~q~n', [Default]). 463 464unqualify_reserved_goal(_:prolog, prolog) :- !. 465unqualify_reserved_goal(_:default, default) :- !. 466unqualify_reserved_goal(Goal, Goal). 467 468 469 /******************************* 470 * RESOURCES * 471 *******************************/ 472 473save_resources(_RC, development) :- !. 474save_resources(RC, _SaveClass) :- 475 feedback('~nRESOURCES~n~n', []), 476 copy_resources(RC), 477 forall(declared_resource(Name, FileSpec, Options), 478 save_resource(RC, Name, FileSpec, Options)). 479 480declared_resource(RcName, FileSpec, []) :- 481 current_predicate(_, M:resource(_,_)), 482 M:resource(Name, FileSpec), 483 mkrcname(M, Name, RcName). 484declared_resource(RcName, FileSpec, Options) :- 485 current_predicate(_, M:resource(_,_,_)), 486 M:resource(Name, A2, A3), 487 ( is_list(A3) 488 -> FileSpec = A2, 489 Options = A3 490 ; FileSpec = A3 491 ), 492 mkrcname(M, Name, RcName).
498mkrcname(user, Name0, Name) :- 499 !, 500 path_segments_to_atom(Name0, Name). 501mkrcname(M, Name0, RcName) :- 502 path_segments_to_atom(Name0, Name), 503 atomic_list_concat([M, :, Name], RcName). 504 505path_segments_to_atom(Name0, Name) :- 506 phrase(segments_to_atom(Name0), Atoms), 507 atomic_list_concat(Atoms, /, Name). 508 509segments_to_atom(Var) --> 510 { var(Var), !, 511 instantiation_error(Var) 512 }. 513segments_to_atom(A/B) --> 514 !, 515 segments_to_atom(A), 516 segments_to_atom(B). 517segments_to_atom(A) --> 518 [A].
524save_resource(RC, Name, FileSpec, _Options) :- 525 absolute_file_name(FileSpec, 526 [ access(read), 527 file_errors(fail) 528 ], File), 529 !, 530 feedback('~t~8|~w~t~32|~w~n', 531 [Name, File]), 532 zipper_append_file(RC, Name, File, []). 533save_resource(RC, Name, FileSpec, Options) :- 534 findall(Dir, 535 absolute_file_name(FileSpec, Dir, 536 [ access(read), 537 file_type(directory), 538 file_errors(fail), 539 solutions(all) 540 ]), 541 Dirs), 542 Dirs \== [], 543 !, 544 forall(member(Dir, Dirs), 545 ( feedback('~t~8|~w~t~32|~w~n', 546 [Name, Dir]), 547 zipper_append_directory(RC, Name, Dir, Options))). 548save_resource(RC, Name, _, _Options) :- 549 '$rc_handle'(SystemRC), 550 copy_resource(SystemRC, RC, Name), 551 !. 552save_resource(_, Name, FileSpec, _Options) :- 553 print_message(warning, 554 error(existence_error(resource, 555 resource(Name, FileSpec)), 556 _)). 557 558copy_resources(ToRC) :- 559 '$rc_handle'(FromRC), 560 zipper_members(FromRC, List), 561 ( member(Name, List), 562 \+ declared_resource(Name, _, _), 563 \+ reserved_resource(Name), 564 copy_resource(FromRC, ToRC, Name), 565 fail 566 ; true 567 ). 568 569reserved_resource('$prolog/state.qlf'). 570reserved_resource('$prolog/options.txt'). 571 572copy_resource(FromRC, ToRC, Name) :- 573 ( zipper_goto(FromRC, file(Name)) 574 -> true 575 ; existence_error(resource, Name) 576 ), 577 zipper_file_info(FromRC, _Name, Attrs), 578 get_dict(time, Attrs, Time), 579 setup_call_cleanup( 580 zipper_open_current(FromRC, FdIn, 581 [ type(binary), 582 time(Time) 583 ]), 584 setup_call_cleanup( 585 zipper_open_new_file_in_zip(ToRC, Name, FdOut, []), 586 ( feedback('~t~8|~w~t~24|~w~n', 587 [Name, '<Copied from running state>']), 588 copy_stream_data(FdIn, FdOut) 589 ), 590 close(FdOut)), 591 close(FdIn)). 592 593 594 /******************************* 595 * OBFUSCATE * 596 *******************************/
602:- multifile prolog:obfuscate_identifiers/1. 603 604create_mapping(Options) :- 605 option(obfuscate(true), Options), 606 !, 607 ( predicate_property(prolog:obfuscate_identifiers(_), number_of_clauses(N)), 608 N > 0 609 -> true 610 ; use_module(library(obfuscate)) 611 ), 612 ( catch(prolog:obfuscate_identifiers(Options), E, 613 print_message(error, E)) 614 -> true 615 ; print_message(warning, failed(obfuscate_identifiers)) 616 ). 617create_mapping(_).
runtime, lock all files such that when running the
program the system stops checking existence and modification time on
the filesystem.
627lock_files(runtime) :- 628 !, 629 '$set_source_files'(system). % implies from_state 630lock_files(_) :- 631 '$set_source_files'(from_state).
637save_program(RC, SaveClass, Options) :- 638 setup_call_cleanup( 639 ( zipper_open_new_file_in_zip(RC, '$prolog/state.qlf', StateFd, 640 [ zip64(true) 641 ]), 642 current_prolog_flag(access_level, OldLevel), 643 set_prolog_flag(access_level, system), % generate system modules 644 '$open_wic'(StateFd, Options) 645 ), 646 ( create_mapping(Options), 647 save_modules(SaveClass), 648 save_records, 649 save_flags, 650 save_prompt, 651 save_imports, 652 save_prolog_flags(Options), 653 save_operators(Options), 654 save_format_predicates 655 ), 656 ( '$close_wic', 657 set_prolog_flag(access_level, OldLevel), 658 close(StateFd) 659 )). 660 661 662 /******************************* 663 * MODULES * 664 *******************************/ 665 666save_modules(SaveClass) :- 667 forall(special_module(X), 668 save_module(X, SaveClass)), 669 forall((current_module(X), \+ special_module(X)), 670 save_module(X, SaveClass)). 671 672special_module(system). 673special_module(user).
682prepare_entry_points(Options) :- 683 define_init_goal(Options), 684 define_toplevel_goal(Options). 685 686define_init_goal(Options) :- 687 option(goal(Goal), Options), 688 !, 689 entry_point(Goal). 690define_init_goal(_). 691 692define_toplevel_goal(Options) :- 693 option(toplevel(Goal), Options), 694 !, 695 entry_point(Goal). 696define_toplevel_goal(_). 697 698entry_point(Goal) :- 699 define_predicate(Goal), 700 ( \+ predicate_property(Goal, built_in), 701 \+ predicate_property(Goal, imported_from(_)) 702 -> goal_pi(Goal, PI), 703 public(PI) 704 ; true 705 ). 706 707define_predicate(Head) :- 708 '$define_predicate'(Head), 709 !. % autoloader 710define_predicate(Head) :- 711 strip_module(Head, _, Term), 712 functor(Term, Name, Arity), 713 throw(error(existence_error(procedure, Name/Arity), _)). 714 715goal_pi(M:G, QPI) :- 716 !, 717 strip_module(M:G, Module, Goal), 718 functor(Goal, Name, Arity), 719 QPI = Module:Name/Arity. 720goal_pi(Goal, Name/Arity) :- 721 functor(Goal, Name, Arity).
prepare_state registered
initialization hooks.728prepare_state(_) :- 729 forall('$init_goal'(when(prepare_state), Goal, Ctx), 730 run_initialize(Goal, Ctx)). 731 732run_initialize(Goal, Ctx) :- 733 ( catch(Goal, E, true), 734 ( var(E) 735 -> true 736 ; throw(error(initialization_error(E, Goal, Ctx), _)) 737 ) 738 ; throw(error(initialization_error(failed, Goal, Ctx), _)) 739 ). 740 741 742 /******************************* 743 * AUTOLOAD * 744 *******************************/
753save_autoload(Options) :- 754 option(autoload(true), Options, true), 755 !, 756 setup_call_cleanup( 757 current_prolog_flag(autoload, Old), 758 autoload_all(Options), 759 set_prolog_flag(autoload, Old)). 760save_autoload(_). 761 762 763 /******************************* 764 * MODULES * 765 *******************************/
771save_module(M, SaveClass) :- 772 '$qlf_start_module'(M), 773 feedback('~n~nMODULE ~w~n', [M]), 774 save_unknown(M), 775 ( P = (M:_H), 776 current_predicate(_, P), 777 \+ predicate_property(P, imported_from(_)), 778 save_predicate(P, SaveClass), 779 fail 780 ; '$qlf_end_part', 781 feedback('~n', []) 782 ). 783 784save_predicate(P, _SaveClass) :- 785 predicate_property(P, foreign), 786 !, 787 P = (M:H), 788 functor(H, Name, Arity), 789 feedback('~npre-defining foreign ~w/~d ', [Name, Arity]), 790 '$add_directive_wic'('$predefine_foreign'(M:Name/Arity)), 791 save_attributes(P). 792save_predicate(P, SaveClass) :- 793 P = (M:H), 794 functor(H, F, A), 795 feedback('~nsaving ~w/~d ', [F, A]), 796 ( ( H = resource(_,_) 797 ; H = resource(_,_,_) 798 ) 799 -> ( SaveClass == development 800 -> true 801 ; save_attribute(P, (dynamic)), 802 ( M == user 803 -> save_attribute(P, (multifile)) 804 ), 805 feedback('(Skipped clauses)', []), 806 fail 807 ) 808 ; true 809 ), 810 ( no_save(P) 811 -> true 812 ; save_attributes(P), 813 \+ predicate_property(P, (volatile)), 814 ( nth_clause(P, _, Ref), 815 feedback('.', []), 816 '$qlf_assert_clause'(Ref, SaveClass), 817 fail 818 ; true 819 ) 820 ). 821 822no_save(P) :- 823 predicate_property(P, volatile), 824 \+ predicate_property(P, dynamic), 825 \+ predicate_property(P, multifile). 826 827pred_attrib(meta_predicate(Term), Head, meta_predicate(M:Term)) :- 828 !, 829 strip_module(Head, M, _). 830pred_attrib(Attrib, Head, 831 '$set_predicate_attribute'(M:Name/Arity, AttName, Val)) :- 832 attrib_name(Attrib, AttName, Val), 833 strip_module(Head, M, Term), 834 functor(Term, Name, Arity). 835 836attrib_name(dynamic, dynamic, true). 837attrib_name(incremental, incremental, true). 838attrib_name(volatile, volatile, true). 839attrib_name(thread_local, thread_local, true). 840attrib_name(multifile, multifile, true). 841attrib_name(public, public, true). 842attrib_name(transparent, transparent, true). 843attrib_name(discontiguous, discontiguous, true). 844attrib_name(notrace, trace, false). 845attrib_name(show_childs, hide_childs, false). 846attrib_name(built_in, system, true). 847attrib_name(nodebug, hide_childs, true). 848attrib_name(quasi_quotation_syntax, quasi_quotation_syntax, true). 849attrib_name(iso, iso, true). 850 851 852save_attribute(P, Attribute) :- 853 pred_attrib(Attribute, P, D), 854 ( Attribute == built_in % no need if there are clauses 855 -> ( predicate_property(P, number_of_clauses(0)) 856 -> true 857 ; predicate_property(P, volatile) 858 ) 859 ; Attribute == (dynamic) % no need if predicate is thread_local 860 -> \+ predicate_property(P, thread_local) 861 ; true 862 ), 863 '$add_directive_wic'(D), 864 feedback('(~w) ', [Attribute]). 865 866save_attributes(P) :- 867 ( predicate_property(P, Attribute), 868 save_attribute(P, Attribute), 869 fail 870 ; true 871 ). 872 873% Save status of the unknown flag 874 875save_unknown(M) :- 876 current_prolog_flag(Munknown, Unknown), 877 ( Unknown == error 878 -> true 879 ; '$add_directive_wic'(set_prolog_flag(Munknown, Unknown)) 880 ). 881 882 /******************************* 883 * RECORDS * 884 *******************************/ 885 886save_records :- 887 feedback('~nRECORDS~n', []), 888 ( current_key(X), 889 X \== '$topvar', % do not safe toplevel variables 890 feedback('~n~t~8|~w ', [X]), 891 recorded(X, V, _), 892 feedback('.', []), 893 '$add_directive_wic'(recordz(X, V, _)), 894 fail 895 ; true 896 ). 897 898 899 /******************************* 900 * FLAGS * 901 *******************************/ 902 903save_flags :- 904 feedback('~nFLAGS~n~n', []), 905 ( current_flag(X), 906 flag(X, V, V), 907 feedback('~t~8|~w = ~w~n', [X, V]), 908 '$add_directive_wic'(set_flag(X, V)), 909 fail 910 ; true 911 ). 912 913save_prompt :- 914 feedback('~nPROMPT~n~n', []), 915 prompt(Prompt, Prompt), 916 '$add_directive_wic'(prompt(_, Prompt)). 917 918 919 /******************************* 920 * IMPORTS * 921 *******************************/
931save_imports :- 932 feedback('~nIMPORTS~n~n', []), 933 ( predicate_property(M:H, imported_from(I)), 934 \+ default_import(M, H, I), 935 functor(H, F, A), 936 feedback('~t~8|~w:~w/~d <-- ~w~n', [M, F, A, I]), 937 '$add_directive_wic'(qsave:restore_import(M, I, F/A)), 938 fail 939 ; true 940 ). 941 942default_import(To, Head, From) :- 943 '$get_predicate_attribute'(To:Head, (dynamic), 1), 944 predicate_property(From:Head, exported), 945 !, 946 fail. 947default_import(Into, _, From) :- 948 default_module(Into, From).
user, avoiding a message that the predicate is not
exported.956restore_import(To, user, PI) :- 957 !, 958 export(user:PI), 959 To:import(user:PI). 960restore_import(To, From, PI) :- 961 To:import(From:PI). 962 963 /******************************* 964 * PROLOG FLAGS * 965 *******************************/ 966 967save_prolog_flags(Options) :- 968 feedback('~nPROLOG FLAGS~n~n', []), 969 '$current_prolog_flag'(Flag, Value0, _Scope, write, Type), 970 \+ no_save_flag(Flag), 971 map_flag(Flag, Value0, Value, Options), 972 feedback('~t~8|~w: ~w (type ~q)~n', [Flag, Value, Type]), 973 '$add_directive_wic'(qsave:restore_prolog_flag(Flag, Value, Type)), 974 fail. 975save_prolog_flags(_). 976 977no_save_flag(argv). 978no_save_flag(os_argv). 979no_save_flag(access_level). 980no_save_flag(tty_control). 981no_save_flag(readline). 982no_save_flag(associated_file). 983no_save_flag(cpu_count). 984no_save_flag(tmp_dir). 985no_save_flag(file_name_case_handling). 986no_save_flag(hwnd). % should be read-only, but comes 987 % from user-code 988map_flag(autoload, true, false, Options) :- 989 option(class(runtime), Options, runtime), 990 option(autoload(true), Options, true), 991 !. 992map_flag(_, Value, Value, _).
1000restore_prolog_flag(Flag, Value, _Type) :- 1001 current_prolog_flag(Flag, Value), 1002 !. 1003restore_prolog_flag(Flag, Value, _Type) :- 1004 current_prolog_flag(Flag, _), 1005 !, 1006 catch(set_prolog_flag(Flag, Value), _, true). 1007restore_prolog_flag(Flag, Value, Type) :- 1008 create_prolog_flag(Flag, Value, [type(Type)]). 1009 1010 1011 /******************************* 1012 * OPERATORS * 1013 *******************************/
system are
not saved because these are read-only anyway.1020save_operators(Options) :- 1021 !, 1022 option(op(save), Options, save), 1023 feedback('~nOPERATORS~n', []), 1024 forall(current_module(M), save_module_operators(M)), 1025 feedback('~n', []). 1026save_operators(_). 1027 1028save_module_operators(system) :- !. 1029save_module_operators(M) :- 1030 forall('$local_op'(P,T,M:N), 1031 ( feedback('~n~t~8|~w ', [op(P,T,M:N)]), 1032 '$add_directive_wic'(op(P,T,M:N)) 1033 )). 1034 1035 1036 /******************************* 1037 * FORMAT PREDICATES * 1038 *******************************/ 1039 1040save_format_predicates :- 1041 feedback('~nFORMAT PREDICATES~n', []), 1042 current_format_predicate(Code, Head), 1043 qualify_head(Head, QHead), 1044 D = format_predicate(Code, QHead), 1045 feedback('~n~t~8|~w ', [D]), 1046 '$add_directive_wic'(D), 1047 fail. 1048save_format_predicates. 1049 1050qualify_head(T, T) :- 1051 functor(T, :, 2), 1052 !. 1053qualify_head(T, user:T). 1054 1055 1056 /******************************* 1057 * FOREIGN LIBRARIES * 1058 *******************************/
1064save_foreign_libraries(RC, _, Options) :- 1065 option(foreign(save), Options), 1066 !, 1067 current_prolog_flag(arch, HostArch), 1068 feedback('~nHOST(~w) FOREIGN LIBRARIES~n', [HostArch]), 1069 save_foreign_libraries1(HostArch, RC, Options). 1070save_foreign_libraries(RC, _, Options) :- 1071 option(foreign(arch(Archs)), Options), 1072 !, 1073 forall(member(Arch, Archs), 1074 ( feedback('~n~w FOREIGN LIBRARIES~n', [Arch]), 1075 save_foreign_libraries1(Arch, RC, Options) 1076 )). 1077save_foreign_libraries(_RC, ExeFile, Options) :- 1078 option(foreign(copy), Options), 1079 !, 1080 copy_foreign_libraries(ExeFile, Options). 1081save_foreign_libraries(_, _, _). 1082 1083save_foreign_libraries1(Arch, RC, _Options) :- 1084 forall(current_foreign_library(FileSpec, _Predicates), 1085 ( find_foreign_library(Arch, FileSpec, EntryName, File, Time), 1086 term_to_atom(EntryName, Name), 1087 zipper_append_file(RC, Name, File, [time(Time)]) 1088 )).
1096:- if(current_prolog_flag(windows, true)). 1097copy_foreign_libraries(ExeFile, _Options) :- 1098 !, 1099 file_directory_name(ExeFile, Dir), 1100 win_process_modules(Modules), 1101 include(prolog_dll, Modules, PrologDLLs), 1102 maplist(copy_dll(Dir), PrologDLLs). 1103:- endif. 1104copy_foreign_libraries(_ExeFile, _Options) :- 1105 print_message(warning, qsave(copy_foreign_libraries)). 1106 1107prolog_dll(DLL) :- 1108 file_base_name(DLL, File), 1109 absolute_file_name(foreign(File), Abs, 1110 [ solutions(all) ]), 1111 same_file(DLL, Abs), 1112 !. 1113 1114copy_dll(Dest, DLL) :- 1115 print_message(informational, copy_foreign_library(DLL, Dest)), 1116 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.
1131find_foreign_library(Arch, FileSpec, shlib(Arch,Name), SharedObject, Time) :-
1132 FileSpec = foreign(Name),
1133 ( catch(arch_find_shlib(Arch, FileSpec, File),
1134 E,
1135 print_message(error, E)),
1136 exists_file(File)
1137 -> true
1138 ; throw(error(existence_error(architecture_shlib(Arch), FileSpec),_))
1139 ),
1140 time_file(File, Time),
1141 strip_file(File, SharedObject).1148strip_file(File, Stripped) :- 1149 absolute_file_name(path(strip), Strip, 1150 [ access(execute), 1151 file_errors(fail) 1152 ]), 1153 tmp_file(shared, Stripped), 1154 ( catch(do_strip_file(Strip, File, Stripped), E, 1155 (print_message(warning, E), fail)) 1156 -> true 1157 ; print_message(warning, qsave(strip_failed(File))), 1158 fail 1159 ), 1160 !. 1161strip_file(File, File). 1162 1163do_strip_file(Strip, File, Stripped) :- 1164 format(atom(Cmd), '"~w" -x -o "~w" "~w"', 1165 [Strip, Stripped, File]), 1166 shell(Cmd), 1167 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.
1181:- multifile arch_shlib/3. 1182 1183arch_find_shlib(Arch, FileSpec, File) :- 1184 arch_shlib(Arch, FileSpec, File), 1185 !. 1186arch_find_shlib(Arch, FileSpec, File) :- 1187 current_prolog_flag(arch, Arch), 1188 absolute_file_name(FileSpec, 1189 [ file_type(executable), 1190 access(read), 1191 file_errors(fail) 1192 ], File), 1193 !. 1194arch_find_shlib(Arch, foreign(Base), File) :- 1195 current_prolog_flag(arch, Arch), 1196 current_prolog_flag(windows, true), 1197 current_prolog_flag(executable, WinExe), 1198 prolog_to_os_filename(Exe, WinExe), 1199 file_directory_name(Exe, BinDir), 1200 file_name_extension(Base, dll, DllFile), 1201 atomic_list_concat([BinDir, /, DllFile], File), 1202 exists_file(File). 1203 1204 1205 /******************************* 1206 * UTIL * 1207 *******************************/ 1208 1209open_map(Options) :- 1210 option(map(Map), Options), 1211 !, 1212 open(Map, write, Fd), 1213 asserta(verbose(Fd)). 1214open_map(_) :- 1215 retractall(verbose(_)). 1216 1217close_map :- 1218 retract(verbose(Fd)), 1219 close(Fd), 1220 !. 1221close_map. 1222 1223feedback(Fmt, Args) :- 1224 verbose(Fd), 1225 !, 1226 format(Fd, Fmt, Args). 1227feedback(_, _). 1228 1229 1230check_options([]) :- !. 1231check_options([Var|_]) :- 1232 var(Var), 1233 !, 1234 throw(error(domain_error(save_options, Var), _)). 1235check_options([Name=Value|T]) :- 1236 !, 1237 ( save_option(Name, Type, _Comment) 1238 -> ( must_be(Type, Value) 1239 -> check_options(T) 1240 ; throw(error(domain_error(Type, Value), _)) 1241 ) 1242 ; throw(error(domain_error(save_option, Name), _)) 1243 ). 1244check_options([Term|T]) :- 1245 Term =.. [Name,Arg], 1246 !, 1247 check_options([Name=Arg|T]). 1248check_options([Var|_]) :- 1249 throw(error(domain_error(save_options, Var), _)). 1250check_options(Opt) :- 1251 throw(error(domain_error(list, Opt), _)).
1258zipper_append_file(_, Name, _, _) :- 1259 saved_resource_file(Name), 1260 !. 1261zipper_append_file(_, _, File, _) :- 1262 source_file(File), 1263 !. 1264zipper_append_file(Zipper, Name, File, Options) :- 1265 ( option(time(_), Options) 1266 -> Options1 = Options 1267 ; time_file(File, Stamp), 1268 Options1 = [time(Stamp)|Options] 1269 ), 1270 setup_call_cleanup( 1271 open(File, read, In, [type(binary)]), 1272 setup_call_cleanup( 1273 zipper_open_new_file_in_zip(Zipper, Name, Out, Options1), 1274 copy_stream_data(In, Out), 1275 close(Out)), 1276 close(In)), 1277 assertz(saved_resource_file(Name)).
time(Stamp).1284zipper_add_directory(Zipper, Name, Dir, Options) :- 1285 ( option(time(Stamp), Options) 1286 -> true 1287 ; time_file(Dir, Stamp) 1288 ), 1289 atom_concat(Name, /, DirName), 1290 ( saved_resource_file(DirName) 1291 -> true 1292 ; setup_call_cleanup( 1293 zipper_open_new_file_in_zip(Zipper, DirName, Out, 1294 [ method(store), 1295 time(Stamp) 1296 | Options 1297 ]), 1298 true, 1299 close(Out)), 1300 assertz(saved_resource_file(DirName)) 1301 ). 1302 1303add_parent_dirs(Zipper, Name, Dir, Options) :- 1304 ( option(time(Stamp), Options) 1305 -> true 1306 ; time_file(Dir, Stamp) 1307 ), 1308 file_directory_name(Name, Parent), 1309 ( Parent \== Name 1310 -> add_parent_dirs(Zipper, Parent, [time(Stamp)|Options]) 1311 ; true 1312 ). 1313 1314add_parent_dirs(_, '.', _) :- 1315 !. 1316add_parent_dirs(Zipper, Name, Options) :- 1317 zipper_add_directory(Zipper, Name, _, Options), 1318 file_directory_name(Name, Parent), 1319 ( Parent \== Name 1320 -> add_parent_dirs(Zipper, Parent, Options) 1321 ; true 1322 ).
1340zipper_append_directory(Zipper, Name, Dir, Options) :- 1341 exists_directory(Dir), 1342 !, 1343 add_parent_dirs(Zipper, Name, Dir, Options), 1344 zipper_add_directory(Zipper, Name, Dir, Options), 1345 directory_files(Dir, Members), 1346 forall(member(M, Members), 1347 ( reserved(M) 1348 -> true 1349 ; ignored(M, Options) 1350 -> true 1351 ; atomic_list_concat([Dir,M], /, Entry), 1352 atomic_list_concat([Name,M], /, Store), 1353 catch(zipper_append_directory(Zipper, Store, Entry, Options), 1354 E, 1355 print_message(warning, E)) 1356 )). 1357zipper_append_directory(Zipper, Name, File, Options) :- 1358 zipper_append_file(Zipper, Name, File, Options). 1359 1360reserved(.). 1361reserved(..).
include(Patterns) option that does not
match File or an exclude(Patterns) that does match File.1368ignored(File, Options) :- 1369 option(include(Patterns), Options), 1370 \+ ( ( is_list(Patterns) 1371 -> member(Pattern, Patterns) 1372 ; Pattern = Patterns 1373 ), 1374 glob_match(Pattern, File) 1375 ), 1376 !. 1377ignored(File, Options) :- 1378 option(exclude(Patterns), Options), 1379 ( is_list(Patterns) 1380 -> member(Pattern, Patterns) 1381 ; Pattern = Patterns 1382 ), 1383 glob_match(Pattern, File), 1384 !. 1385 1386glob_match(Pattern, File) :- 1387 current_prolog_flag(file_name_case_handling, case_sensitive), 1388 !, 1389 wildcard_match(Pattern, File). 1390glob_match(Pattern, File) :- 1391 wildcard_match(Pattern, File, [case_sensitive(false)]). 1392 1393 1394 /******************************** 1395 * SAVED STATE GENERATION * 1396 *********************************/
1402:- public 1403 qsave_toplevel/0. 1404 1405qsave_toplevel :- 1406 current_prolog_flag(os_argv, Argv), 1407 qsave_options(Argv, Files, Options), 1408 set_on_error(Options), 1409 '$cmd_option_val'(compileout, Out), 1410 user:consult(Files), 1411 maybe_exit_on_errors, 1412 qsave_program(Out, user:Options). 1413 1414set_on_error(Options) :- 1415 option(on_error(_), Options), !. 1416set_on_error(_Options) :- 1417 set_prolog_flag(on_error, status). 1418 1419maybe_exit_on_errors :- 1420 '$exit_code'(Code), 1421 ( Code =\= 0 1422 -> halt 1423 ; true 1424 ). 1425 1426qsave_options([], [], []). 1427qsave_options([--|_], [], []) :- 1428 !. 1429qsave_options(['-c'|T0], Files, Options) :- 1430 !, 1431 argv_files(T0, T1, Files, FilesT), 1432 qsave_options(T1, FilesT, Options). 1433qsave_options([O|T0], Files, [Option|T]) :- 1434 string_concat(--, Opt, O), 1435 split_string(Opt, =, '', [NameS|Rest]), 1436 split_string(NameS, '-', '', NameParts), 1437 atomic_list_concat(NameParts, '_', Name), 1438 qsave_option(Name, OptName, Rest, Value), 1439 !, 1440 Option =.. [OptName, Value], 1441 qsave_options(T0, Files, T). 1442qsave_options([_|T0], Files, T) :- 1443 qsave_options(T0, Files, T). 1444 1445argv_files([], [], Files, Files). 1446argv_files([H|T], [H|T], Files, Files) :- 1447 sub_atom(H, 0, _, _, -), 1448 !. 1449argv_files([H|T0], T, [H|Files0], Files) :- 1450 argv_files(T0, T, Files0, Files).
1454qsave_option(Name, Name, [], true) :- 1455 save_option(Name, boolean, _), 1456 !. 1457qsave_option(NoName, Name, [], false) :- 1458 atom_concat('no_', Name, NoName), 1459 save_option(Name, boolean, _), 1460 !. 1461qsave_option(Name, Name, ValueStrings, Value) :- 1462 save_option(Name, Type, _), 1463 !, 1464 atomics_to_string(ValueStrings, "=", ValueString), 1465 convert_option_value(Type, ValueString, Value). 1466qsave_option(Name, Name, _Chars, _Value) :- 1467 existence_error(save_option, Name). 1468 1469convert_option_value(integer, String, Value) => 1470 ( number_string(Value, String) 1471 -> true 1472 ; sub_string(String, 0, _, 1, SubString), 1473 sub_string(String, _, 1, 0, Suffix0), 1474 downcase_atom(Suffix0, Suffix), 1475 number_string(Number, SubString), 1476 suffix_multiplier(Suffix, Multiplier) 1477 -> Value is Number * Multiplier 1478 ; domain_error(integer, String) 1479 ). 1480convert_option_value(callable, String, Value) => 1481 term_string(Value, String). 1482convert_option_value(atom, String, Value) => 1483 atom_string(Value, String). 1484convert_option_value(boolean, String, Value) => 1485 atom_string(Value, String). 1486convert_option_value(oneof(_), String, Value) => 1487 atom_string(Value, String). 1488convert_option_value(ground, String, Value) => 1489 atom_string(Value, String). 1490convert_option_value(qsave_foreign_option, "save", Value) => 1491 Value = save. 1492convert_option_value(qsave_foreign_option, "copy", Value) => 1493 Value = copy. 1494convert_option_value(qsave_foreign_option, StrArchList, arch(ArchList)) => 1495 split_string(StrArchList, ",", ", \t", StrArchList1), 1496 maplist(atom_string, ArchList, StrArchList1). 1497 1498suffix_multiplier(b, 1). 1499suffix_multiplier(k, 1024). 1500suffix_multiplier(m, 1024 * 1024). 1501suffix_multiplier(g, 1024 * 1024 * 1024). 1502 1503 1504 /******************************* 1505 * MESSAGES * 1506 *******************************/ 1507 1508:- multifile prolog:message/3. 1509 1510prologmessage(no_resource(Name, File)) --> 1511 [ 'Could not find resource ~w on ~w or system resources'- 1512 [Name, File] ]. 1513prologmessage(qsave(nondet)) --> 1514 [ 'qsave_program/2 succeeded with a choice point'-[] ]. 1515prologmessage(copy_foreign_library(Lib,Dir)) --> 1516 [ '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.
*/