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 setup_call_cleanup( 578 zipper_open_current(FromRC, FdIn, 579 [ type(binary) 580 ]), 581 setup_call_cleanup( 582 zipper_open_new_file_in_zip(ToRC, Name, FdOut, []), 583 ( feedback('~t~8|~w~t~24|~w~n', 584 [Name, '<Copied from running state>']), 585 copy_stream_data(FdIn, FdOut) 586 ), 587 close(FdOut)), 588 close(FdIn)). 589 590 591 /******************************* 592 * OBFUSCATE * 593 *******************************/
599:- multifile prolog:obfuscate_identifiers/1. 600 601create_mapping(Options) :- 602 option(obfuscate(true), Options), 603 !, 604 ( predicate_property(prolog:obfuscate_identifiers(_), number_of_clauses(N)), 605 N > 0 606 -> true 607 ; use_module(library(obfuscate)) 608 ), 609 ( catch(prolog:obfuscate_identifiers(Options), E, 610 print_message(error, E)) 611 -> true 612 ; print_message(warning, failed(obfuscate_identifiers)) 613 ). 614create_mapping(_).
runtime, lock all files such that when running the
program the system stops checking existence and modification time on
the filesystem.
624lock_files(runtime) :- 625 !, 626 '$set_source_files'(system). % implies from_state 627lock_files(_) :- 628 '$set_source_files'(from_state).
634save_program(RC, SaveClass, Options) :- 635 setup_call_cleanup( 636 ( zipper_open_new_file_in_zip(RC, '$prolog/state.qlf', StateFd, 637 [ zip64(true) 638 ]), 639 current_prolog_flag(access_level, OldLevel), 640 set_prolog_flag(access_level, system), % generate system modules 641 '$open_wic'(StateFd, Options) 642 ), 643 ( create_mapping(Options), 644 save_modules(SaveClass), 645 save_records, 646 save_flags, 647 save_prompt, 648 save_imports, 649 save_prolog_flags(Options), 650 save_operators(Options), 651 save_format_predicates 652 ), 653 ( '$close_wic', 654 set_prolog_flag(access_level, OldLevel), 655 close(StateFd) 656 )). 657 658 659 /******************************* 660 * MODULES * 661 *******************************/ 662 663save_modules(SaveClass) :- 664 forall(special_module(X), 665 save_module(X, SaveClass)), 666 forall((current_module(X), \+ special_module(X)), 667 save_module(X, SaveClass)). 668 669special_module(system). 670special_module(user).
679prepare_entry_points(Options) :- 680 define_init_goal(Options), 681 define_toplevel_goal(Options). 682 683define_init_goal(Options) :- 684 option(goal(Goal), Options), 685 !, 686 entry_point(Goal). 687define_init_goal(_). 688 689define_toplevel_goal(Options) :- 690 option(toplevel(Goal), Options), 691 !, 692 entry_point(Goal). 693define_toplevel_goal(_). 694 695entry_point(Goal) :- 696 define_predicate(Goal), 697 ( \+ predicate_property(Goal, built_in), 698 \+ predicate_property(Goal, imported_from(_)) 699 -> goal_pi(Goal, PI), 700 public(PI) 701 ; true 702 ). 703 704define_predicate(Head) :- 705 '$define_predicate'(Head), 706 !. % autoloader 707define_predicate(Head) :- 708 strip_module(Head, _, Term), 709 functor(Term, Name, Arity), 710 throw(error(existence_error(procedure, Name/Arity), _)). 711 712goal_pi(M:G, QPI) :- 713 !, 714 strip_module(M:G, Module, Goal), 715 functor(Goal, Name, Arity), 716 QPI = Module:Name/Arity. 717goal_pi(Goal, Name/Arity) :- 718 functor(Goal, Name, Arity).
prepare_state registered
initialization hooks.725prepare_state(_) :- 726 forall('$init_goal'(when(prepare_state), Goal, Ctx), 727 run_initialize(Goal, Ctx)). 728 729run_initialize(Goal, Ctx) :- 730 ( catch(Goal, E, true), 731 ( var(E) 732 -> true 733 ; throw(error(initialization_error(E, Goal, Ctx), _)) 734 ) 735 ; throw(error(initialization_error(failed, Goal, Ctx), _)) 736 ). 737 738 739 /******************************* 740 * AUTOLOAD * 741 *******************************/
750save_autoload(Options) :- 751 option(autoload(true), Options, true), 752 !, 753 setup_call_cleanup( 754 current_prolog_flag(autoload, Old), 755 autoload_all(Options), 756 set_prolog_flag(autoload, Old)). 757save_autoload(_). 758 759 760 /******************************* 761 * MODULES * 762 *******************************/
768save_module(M, SaveClass) :- 769 '$qlf_start_module'(M), 770 feedback('~n~nMODULE ~w~n', [M]), 771 save_unknown(M), 772 ( P = (M:_H), 773 current_predicate(_, P), 774 \+ predicate_property(P, imported_from(_)), 775 save_predicate(P, SaveClass), 776 fail 777 ; '$qlf_end_part', 778 feedback('~n', []) 779 ). 780 781save_predicate(P, _SaveClass) :- 782 predicate_property(P, foreign), 783 !, 784 P = (M:H), 785 functor(H, Name, Arity), 786 feedback('~npre-defining foreign ~w/~d ', [Name, Arity]), 787 '$add_directive_wic'('$predefine_foreign'(M:Name/Arity)), 788 save_attributes(P). 789save_predicate(P, SaveClass) :- 790 P = (M:H), 791 functor(H, F, A), 792 feedback('~nsaving ~w/~d ', [F, A]), 793 ( ( H = resource(_,_) 794 ; H = resource(_,_,_) 795 ) 796 -> ( SaveClass == development 797 -> true 798 ; save_attribute(P, (dynamic)), 799 ( M == user 800 -> save_attribute(P, (multifile)) 801 ), 802 feedback('(Skipped clauses)', []), 803 fail 804 ) 805 ; true 806 ), 807 ( no_save(P) 808 -> true 809 ; save_attributes(P), 810 \+ predicate_property(P, (volatile)), 811 ( nth_clause(P, _, Ref), 812 feedback('.', []), 813 '$qlf_assert_clause'(Ref, SaveClass), 814 fail 815 ; true 816 ) 817 ). 818 819no_save(P) :- 820 predicate_property(P, volatile), 821 \+ predicate_property(P, dynamic), 822 \+ predicate_property(P, multifile). 823 824pred_attrib(meta_predicate(Term), Head, meta_predicate(M:Term)) :- 825 !, 826 strip_module(Head, M, _). 827pred_attrib(Attrib, Head, 828 '$set_predicate_attribute'(M:Name/Arity, AttName, Val)) :- 829 attrib_name(Attrib, AttName, Val), 830 strip_module(Head, M, Term), 831 functor(Term, Name, Arity). 832 833attrib_name(dynamic, dynamic, true). 834attrib_name(incremental, incremental, true). 835attrib_name(volatile, volatile, true). 836attrib_name(thread_local, thread_local, true). 837attrib_name(multifile, multifile, true). 838attrib_name(public, public, true). 839attrib_name(transparent, transparent, true). 840attrib_name(discontiguous, discontiguous, true). 841attrib_name(notrace, trace, false). 842attrib_name(show_childs, hide_childs, false). 843attrib_name(built_in, system, true). 844attrib_name(nodebug, hide_childs, true). 845attrib_name(quasi_quotation_syntax, quasi_quotation_syntax, true). 846attrib_name(iso, iso, true). 847 848 849save_attribute(P, Attribute) :- 850 pred_attrib(Attribute, P, D), 851 ( Attribute == built_in % no need if there are clauses 852 -> ( predicate_property(P, number_of_clauses(0)) 853 -> true 854 ; predicate_property(P, volatile) 855 ) 856 ; Attribute == (dynamic) % no need if predicate is thread_local 857 -> \+ predicate_property(P, thread_local) 858 ; true 859 ), 860 '$add_directive_wic'(D), 861 feedback('(~w) ', [Attribute]). 862 863save_attributes(P) :- 864 ( predicate_property(P, Attribute), 865 save_attribute(P, Attribute), 866 fail 867 ; true 868 ). 869 870% Save status of the unknown flag 871 872save_unknown(M) :- 873 current_prolog_flag(Munknown, Unknown), 874 ( Unknown == error 875 -> true 876 ; '$add_directive_wic'(set_prolog_flag(Munknown, Unknown)) 877 ). 878 879 /******************************* 880 * RECORDS * 881 *******************************/ 882 883save_records :- 884 feedback('~nRECORDS~n', []), 885 ( current_key(X), 886 X \== '$topvar', % do not safe toplevel variables 887 feedback('~n~t~8|~w ', [X]), 888 recorded(X, V, _), 889 feedback('.', []), 890 '$add_directive_wic'(recordz(X, V, _)), 891 fail 892 ; true 893 ). 894 895 896 /******************************* 897 * FLAGS * 898 *******************************/ 899 900save_flags :- 901 feedback('~nFLAGS~n~n', []), 902 ( current_flag(X), 903 flag(X, V, V), 904 feedback('~t~8|~w = ~w~n', [X, V]), 905 '$add_directive_wic'(set_flag(X, V)), 906 fail 907 ; true 908 ). 909 910save_prompt :- 911 feedback('~nPROMPT~n~n', []), 912 prompt(Prompt, Prompt), 913 '$add_directive_wic'(prompt(_, Prompt)). 914 915 916 /******************************* 917 * IMPORTS * 918 *******************************/
928save_imports :- 929 feedback('~nIMPORTS~n~n', []), 930 ( predicate_property(M:H, imported_from(I)), 931 \+ default_import(M, H, I), 932 functor(H, F, A), 933 feedback('~t~8|~w:~w/~d <-- ~w~n', [M, F, A, I]), 934 '$add_directive_wic'(qsave:restore_import(M, I, F/A)), 935 fail 936 ; true 937 ). 938 939default_import(To, Head, From) :- 940 '$get_predicate_attribute'(To:Head, (dynamic), 1), 941 predicate_property(From:Head, exported), 942 !, 943 fail. 944default_import(Into, _, From) :- 945 default_module(Into, From).
user, avoiding a message that the predicate is not
exported.953restore_import(To, user, PI) :- 954 !, 955 export(user:PI), 956 To:import(user:PI). 957restore_import(To, From, PI) :- 958 To:import(From:PI). 959 960 /******************************* 961 * PROLOG FLAGS * 962 *******************************/ 963 964save_prolog_flags(Options) :- 965 feedback('~nPROLOG FLAGS~n~n', []), 966 '$current_prolog_flag'(Flag, Value0, _Scope, write, Type), 967 \+ no_save_flag(Flag), 968 map_flag(Flag, Value0, Value, Options), 969 feedback('~t~8|~w: ~w (type ~q)~n', [Flag, Value, Type]), 970 '$add_directive_wic'(qsave:restore_prolog_flag(Flag, Value, Type)), 971 fail. 972save_prolog_flags(_). 973 974no_save_flag(argv). 975no_save_flag(os_argv). 976no_save_flag(access_level). 977no_save_flag(tty_control). 978no_save_flag(readline). 979no_save_flag(color_term). % depends on the terminal we run on 980no_save_flag(hyperlink_term). % idem 981no_save_flag(associated_file). 982no_save_flag(cpu_count). 983no_save_flag(tmp_dir). 984no_save_flag(file_name_case_handling). 985no_save_flag(hwnd). % should be read-only, but comes 986 % from user-code 987map_flag(autoload, true, false, Options) :- 988 option(class(runtime), Options, runtime), 989 option(autoload(true), Options, true), 990 !. 991map_flag(_, Value, Value, _).
999restore_prolog_flag(Flag, Value, _Type) :- 1000 current_prolog_flag(Flag, Value), 1001 !. 1002restore_prolog_flag(Flag, Value, _Type) :- 1003 current_prolog_flag(Flag, _), 1004 !, 1005 catch(set_prolog_flag(Flag, Value), _, true). 1006restore_prolog_flag(Flag, Value, Type) :- 1007 create_prolog_flag(Flag, Value, [type(Type)]). 1008 1009 1010 /******************************* 1011 * OPERATORS * 1012 *******************************/
system are
not saved because these are read-only anyway.1019save_operators(Options) :- 1020 !, 1021 option(op(save), Options, save), 1022 feedback('~nOPERATORS~n', []), 1023 forall(current_module(M), save_module_operators(M)), 1024 feedback('~n', []). 1025save_operators(_). 1026 1027save_module_operators(system) :- !. 1028save_module_operators(M) :- 1029 forall('$local_op'(P,T,M:N), 1030 ( feedback('~n~t~8|~w ', [op(P,T,M:N)]), 1031 '$add_directive_wic'(op(P,T,M:N)) 1032 )). 1033 1034 1035 /******************************* 1036 * FORMAT PREDICATES * 1037 *******************************/ 1038 1039save_format_predicates :- 1040 feedback('~nFORMAT PREDICATES~n', []), 1041 current_format_predicate(Code, Head), 1042 qualify_head(Head, QHead), 1043 D = format_predicate(Code, QHead), 1044 feedback('~n~t~8|~w ', [D]), 1045 '$add_directive_wic'(D), 1046 fail. 1047save_format_predicates. 1048 1049qualify_head(T, T) :- 1050 functor(T, :, 2), 1051 !. 1052qualify_head(T, user:T). 1053 1054 1055 /******************************* 1056 * FOREIGN LIBRARIES * 1057 *******************************/
1063save_foreign_libraries(RC, _, Options) :- 1064 option(foreign(save), Options), 1065 !, 1066 current_prolog_flag(arch, HostArch), 1067 feedback('~nHOST(~w) FOREIGN LIBRARIES~n', [HostArch]), 1068 save_foreign_libraries1(HostArch, RC, Options). 1069save_foreign_libraries(RC, _, Options) :- 1070 option(foreign(arch(Archs)), Options), 1071 !, 1072 forall(member(Arch, Archs), 1073 ( feedback('~n~w FOREIGN LIBRARIES~n', [Arch]), 1074 save_foreign_libraries1(Arch, RC, Options) 1075 )). 1076save_foreign_libraries(_RC, ExeFile, Options) :- 1077 option(foreign(copy), Options), 1078 !, 1079 copy_foreign_libraries(ExeFile, Options). 1080save_foreign_libraries(_, _, _). 1081 1082save_foreign_libraries1(Arch, RC, _Options) :- 1083 forall(current_foreign_library(FileSpec, _Predicates), 1084 ( find_foreign_library(Arch, FileSpec, EntryName, File, Time), 1085 term_to_atom(EntryName, Name), 1086 zipper_append_file(RC, Name, File, [time(Time)]) 1087 )).
1095:- if(current_prolog_flag(windows, true)). 1096copy_foreign_libraries(ExeFile, _Options) :- 1097 !, 1098 file_directory_name(ExeFile, Dir), 1099 win_process_modules(Modules), 1100 include(prolog_dll, Modules, PrologDLLs), 1101 maplist(copy_dll(Dir), PrologDLLs). 1102:- endif. 1103copy_foreign_libraries(_ExeFile, _Options) :- 1104 print_message(warning, qsave(copy_foreign_libraries)). 1105 1106prolog_dll(DLL) :- 1107 file_base_name(DLL, File), 1108 absolute_file_name(foreign(File), Abs, 1109 [ solutions(all) ]), 1110 same_file(DLL, Abs), 1111 !. 1112 1113copy_dll(Dest, DLL) :- 1114 print_message(informational, copy_foreign_library(DLL, Dest)), 1115 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.
1130find_foreign_library(Arch, FileSpec, shlib(Arch,Name), SharedObject, Time) :-
1131 FileSpec = foreign(Name),
1132 ( catch(arch_find_shlib(Arch, FileSpec, File),
1133 E,
1134 print_message(error, E)),
1135 exists_file(File)
1136 -> true
1137 ; throw(error(existence_error(architecture_shlib(Arch), FileSpec),_))
1138 ),
1139 time_file(File, Time),
1140 strip_file(File, SharedObject).1147strip_file(File, Stripped) :- 1148 absolute_file_name(path(strip), Strip, 1149 [ access(execute), 1150 file_errors(fail) 1151 ]), 1152 tmp_file(shared, Stripped), 1153 ( catch(do_strip_file(Strip, File, Stripped), E, 1154 (print_message(warning, E), fail)) 1155 -> true 1156 ; print_message(warning, qsave(strip_failed(File))), 1157 fail 1158 ), 1159 !. 1160strip_file(File, File). 1161 1162do_strip_file(Strip, File, Stripped) :- 1163 format(atom(Cmd), '"~w" -x -o "~w" "~w"', 1164 [Strip, Stripped, File]), 1165 shell(Cmd), 1166 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.
1180:- multifile arch_shlib/3. 1181 1182arch_find_shlib(Arch, FileSpec, File) :- 1183 arch_shlib(Arch, FileSpec, File), 1184 !. 1185arch_find_shlib(Arch, FileSpec, File) :- 1186 current_prolog_flag(arch, Arch), 1187 absolute_file_name(FileSpec, 1188 [ file_type(executable), 1189 access(read), 1190 file_errors(fail) 1191 ], File), 1192 !. 1193arch_find_shlib(Arch, foreign(Base), File) :- 1194 current_prolog_flag(arch, Arch), 1195 current_prolog_flag(windows, true), 1196 current_prolog_flag(executable, WinExe), 1197 prolog_to_os_filename(Exe, WinExe), 1198 file_directory_name(Exe, BinDir), 1199 file_name_extension(Base, dll, DllFile), 1200 atomic_list_concat([BinDir, /, DllFile], File), 1201 exists_file(File). 1202 1203 1204 /******************************* 1205 * UTIL * 1206 *******************************/ 1207 1208open_map(Options) :- 1209 option(map(Map), Options), 1210 !, 1211 open(Map, write, Fd), 1212 asserta(verbose(Fd)). 1213open_map(_) :- 1214 retractall(verbose(_)). 1215 1216close_map :- 1217 retract(verbose(Fd)), 1218 close(Fd), 1219 !. 1220close_map. 1221 1222feedback(Fmt, Args) :- 1223 verbose(Fd), 1224 !, 1225 format(Fd, Fmt, Args). 1226feedback(_, _). 1227 1228 1229check_options([]) :- !. 1230check_options([Var|_]) :- 1231 var(Var), 1232 !, 1233 throw(error(domain_error(save_options, Var), _)). 1234check_options([Name=Value|T]) :- 1235 !, 1236 ( save_option(Name, Type, _Comment) 1237 -> ( must_be(Type, Value) 1238 -> check_options(T) 1239 ; throw(error(domain_error(Type, Value), _)) 1240 ) 1241 ; throw(error(domain_error(save_option, Name), _)) 1242 ). 1243check_options([Term|T]) :- 1244 Term =.. [Name,Arg], 1245 !, 1246 check_options([Name=Arg|T]). 1247check_options([Var|_]) :- 1248 throw(error(domain_error(save_options, Var), _)). 1249check_options(Opt) :- 1250 throw(error(domain_error(list, Opt), _)).
1257zipper_append_file(_, Name, _, _) :- 1258 saved_resource_file(Name), 1259 !. 1260zipper_append_file(_, _, File, _) :- 1261 source_file(File), 1262 !. 1263zipper_append_file(Zipper, Name, File, Options) :- 1264 ( option(time(_), Options) 1265 -> Options1 = Options 1266 ; time_file(File, Stamp), 1267 Options1 = [time(Stamp)|Options] 1268 ), 1269 setup_call_cleanup( 1270 open(File, read, In, [type(binary)]), 1271 setup_call_cleanup( 1272 zipper_open_new_file_in_zip(Zipper, Name, Out, Options1), 1273 copy_stream_data(In, Out), 1274 close(Out)), 1275 close(In)), 1276 assertz(saved_resource_file(Name)).
time(Stamp).1283zipper_add_directory(Zipper, Name, Dir, Options) :- 1284 ( option(time(Stamp), Options) 1285 -> true 1286 ; time_file(Dir, Stamp) 1287 ), 1288 atom_concat(Name, /, DirName), 1289 ( saved_resource_file(DirName) 1290 -> true 1291 ; setup_call_cleanup( 1292 zipper_open_new_file_in_zip(Zipper, DirName, Out, 1293 [ method(store), 1294 time(Stamp) 1295 | Options 1296 ]), 1297 true, 1298 close(Out)), 1299 assertz(saved_resource_file(DirName)) 1300 ). 1301 1302add_parent_dirs(Zipper, Name, Dir, Options) :- 1303 ( option(time(Stamp), Options) 1304 -> true 1305 ; time_file(Dir, Stamp) 1306 ), 1307 file_directory_name(Name, Parent), 1308 ( Parent \== Name 1309 -> add_parent_dirs(Zipper, Parent, [time(Stamp)|Options]) 1310 ; true 1311 ). 1312 1313add_parent_dirs(_, '.', _) :- 1314 !. 1315add_parent_dirs(Zipper, Name, Options) :- 1316 zipper_add_directory(Zipper, Name, _, Options), 1317 file_directory_name(Name, Parent), 1318 ( Parent \== Name 1319 -> add_parent_dirs(Zipper, Parent, Options) 1320 ; true 1321 ).
1339zipper_append_directory(Zipper, Name, Dir, Options) :- 1340 exists_directory(Dir), 1341 !, 1342 add_parent_dirs(Zipper, Name, Dir, Options), 1343 zipper_add_directory(Zipper, Name, Dir, Options), 1344 directory_files(Dir, Members), 1345 forall(member(M, Members), 1346 ( reserved(M) 1347 -> true 1348 ; ignored(M, Options) 1349 -> true 1350 ; atomic_list_concat([Dir,M], /, Entry), 1351 atomic_list_concat([Name,M], /, Store), 1352 catch(zipper_append_directory(Zipper, Store, Entry, Options), 1353 E, 1354 print_message(warning, E)) 1355 )). 1356zipper_append_directory(Zipper, Name, File, Options) :- 1357 zipper_append_file(Zipper, Name, File, Options). 1358 1359reserved(.). 1360reserved(..).
include(Patterns) option that does not
match File or an exclude(Patterns) that does match File.1367ignored(File, Options) :- 1368 option(include(Patterns), Options), 1369 \+ ( ( is_list(Patterns) 1370 -> member(Pattern, Patterns) 1371 ; Pattern = Patterns 1372 ), 1373 glob_match(Pattern, File) 1374 ), 1375 !. 1376ignored(File, Options) :- 1377 option(exclude(Patterns), Options), 1378 ( is_list(Patterns) 1379 -> member(Pattern, Patterns) 1380 ; Pattern = Patterns 1381 ), 1382 glob_match(Pattern, File), 1383 !. 1384 1385glob_match(Pattern, File) :- 1386 current_prolog_flag(file_name_case_handling, case_sensitive), 1387 !, 1388 wildcard_match(Pattern, File). 1389glob_match(Pattern, File) :- 1390 wildcard_match(Pattern, File, [case_sensitive(false)]). 1391 1392 1393 /******************************** 1394 * SAVED STATE GENERATION * 1395 *********************************/
1401:- public 1402 qsave_toplevel/0. 1403 1404qsave_toplevel :- 1405 current_prolog_flag(os_argv, Argv), 1406 qsave_options(Argv, Files, Options), 1407 set_on_error(Options), 1408 '$cmd_option_val'(compileout, Out), 1409 user:consult(Files), 1410 maybe_exit_on_errors, 1411 qsave_program(Out, user:Options). 1412 1413set_on_error(Options) :- 1414 option(on_error(_), Options), !. 1415set_on_error(_Options) :- 1416 set_prolog_flag(on_error, status). 1417 1418maybe_exit_on_errors :- 1419 '$exit_code'(Code), 1420 ( Code =\= 0 1421 -> halt 1422 ; true 1423 ). 1424 1425qsave_options([], [], []). 1426qsave_options([--|_], [], []) :- 1427 !. 1428qsave_options(['-c'|T0], Files, Options) :- 1429 !, 1430 argv_files(T0, T1, Files, FilesT), 1431 qsave_options(T1, FilesT, Options). 1432qsave_options([O|T0], Files, [Option|T]) :- 1433 string_concat(--, Opt, O), 1434 split_string(Opt, =, '', [NameS|Rest]), 1435 split_string(NameS, '-', '', NameParts), 1436 atomic_list_concat(NameParts, '_', Name), 1437 qsave_option(Name, OptName, Rest, Value), 1438 !, 1439 Option =.. [OptName, Value], 1440 qsave_options(T0, Files, T). 1441qsave_options([_|T0], Files, T) :- 1442 qsave_options(T0, Files, T). 1443 1444argv_files([], [], Files, Files). 1445argv_files([H|T], [H|T], Files, Files) :- 1446 sub_atom(H, 0, _, _, -), 1447 !. 1448argv_files([H|T0], T, [H|Files0], Files) :- 1449 argv_files(T0, T, Files0, Files).
1453qsave_option(Name, Name, [], true) :- 1454 save_option(Name, boolean, _), 1455 !. 1456qsave_option(NoName, Name, [], false) :- 1457 atom_concat('no_', Name, NoName), 1458 save_option(Name, boolean, _), 1459 !. 1460qsave_option(Name, Name, ValueStrings, Value) :- 1461 save_option(Name, Type, _), 1462 !, 1463 atomics_to_string(ValueStrings, "=", ValueString), 1464 convert_option_value(Type, ValueString, Value). 1465qsave_option(Name, Name, _Chars, _Value) :- 1466 existence_error(save_option, Name). 1467 1468convert_option_value(integer, String, Value) => 1469 ( number_string(Value, String) 1470 -> true 1471 ; sub_string(String, 0, _, 1, SubString), 1472 sub_string(String, _, 1, 0, Suffix0), 1473 downcase_atom(Suffix0, Suffix), 1474 number_string(Number, SubString), 1475 suffix_multiplier(Suffix, Multiplier) 1476 -> Value is Number * Multiplier 1477 ; domain_error(integer, String) 1478 ). 1479convert_option_value(callable, String, Value) => 1480 term_string(Value, String). 1481convert_option_value(atom, String, Value) => 1482 atom_string(Value, String). 1483convert_option_value(boolean, String, Value) => 1484 atom_string(Value, String). 1485convert_option_value(oneof(_), String, Value) => 1486 atom_string(Value, String). 1487convert_option_value(ground, String, Value) => 1488 atom_string(Value, String). 1489convert_option_value(qsave_foreign_option, "save", Value) => 1490 Value = save. 1491convert_option_value(qsave_foreign_option, "copy", Value) => 1492 Value = copy. 1493convert_option_value(qsave_foreign_option, StrArchList, arch(ArchList)) => 1494 split_string(StrArchList, ",", ", \t", StrArchList1), 1495 maplist(atom_string, ArchList, StrArchList1). 1496 1497suffix_multiplier(b, 1). 1498suffix_multiplier(k, 1024). 1499suffix_multiplier(m, 1024 * 1024). 1500suffix_multiplier(g, 1024 * 1024 * 1024). 1501 1502 1503 /******************************* 1504 * MESSAGES * 1505 *******************************/ 1506 1507:- multifile prolog:message/3. 1508 1509prologmessage(no_resource(Name, File)) --> 1510 [ 'Could not find resource ~w on ~w or system resources'- 1511 [Name, File] ]. 1512prologmessage(qsave(nondet)) --> 1513 [ 'qsave_program/2 succeeded with a choice point'-[] ]. 1514prologmessage(copy_foreign_library(Lib,Dir)) --> 1515 [ '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.