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(associated_file). 980no_save_flag(cpu_count). 981no_save_flag(tmp_dir). 982no_save_flag(file_name_case_handling). 983no_save_flag(hwnd). % should be read-only, but comes 984 % from user-code 985map_flag(autoload, true, false, Options) :- 986 option(class(runtime), Options, runtime), 987 option(autoload(true), Options, true), 988 !. 989map_flag(_, Value, Value, _).
997restore_prolog_flag(Flag, Value, _Type) :- 998 current_prolog_flag(Flag, Value), 999 !. 1000restore_prolog_flag(Flag, Value, _Type) :- 1001 current_prolog_flag(Flag, _), 1002 !, 1003 catch(set_prolog_flag(Flag, Value), _, true). 1004restore_prolog_flag(Flag, Value, Type) :- 1005 create_prolog_flag(Flag, Value, [type(Type)]). 1006 1007 1008 /******************************* 1009 * OPERATORS * 1010 *******************************/
system are
not saved because these are read-only anyway.1017save_operators(Options) :- 1018 !, 1019 option(op(save), Options, save), 1020 feedback('~nOPERATORS~n', []), 1021 forall(current_module(M), save_module_operators(M)), 1022 feedback('~n', []). 1023save_operators(_). 1024 1025save_module_operators(system) :- !. 1026save_module_operators(M) :- 1027 forall('$local_op'(P,T,M:N), 1028 ( feedback('~n~t~8|~w ', [op(P,T,M:N)]), 1029 '$add_directive_wic'(op(P,T,M:N)) 1030 )). 1031 1032 1033 /******************************* 1034 * FORMAT PREDICATES * 1035 *******************************/ 1036 1037save_format_predicates :- 1038 feedback('~nFORMAT PREDICATES~n', []), 1039 current_format_predicate(Code, Head), 1040 qualify_head(Head, QHead), 1041 D = format_predicate(Code, QHead), 1042 feedback('~n~t~8|~w ', [D]), 1043 '$add_directive_wic'(D), 1044 fail. 1045save_format_predicates. 1046 1047qualify_head(T, T) :- 1048 functor(T, :, 2), 1049 !. 1050qualify_head(T, user:T). 1051 1052 1053 /******************************* 1054 * FOREIGN LIBRARIES * 1055 *******************************/
1061save_foreign_libraries(RC, _, Options) :- 1062 option(foreign(save), Options), 1063 !, 1064 current_prolog_flag(arch, HostArch), 1065 feedback('~nHOST(~w) FOREIGN LIBRARIES~n', [HostArch]), 1066 save_foreign_libraries1(HostArch, RC, Options). 1067save_foreign_libraries(RC, _, Options) :- 1068 option(foreign(arch(Archs)), Options), 1069 !, 1070 forall(member(Arch, Archs), 1071 ( feedback('~n~w FOREIGN LIBRARIES~n', [Arch]), 1072 save_foreign_libraries1(Arch, RC, Options) 1073 )). 1074save_foreign_libraries(_RC, ExeFile, Options) :- 1075 option(foreign(copy), Options), 1076 !, 1077 copy_foreign_libraries(ExeFile, Options). 1078save_foreign_libraries(_, _, _). 1079 1080save_foreign_libraries1(Arch, RC, _Options) :- 1081 forall(current_foreign_library(FileSpec, _Predicates), 1082 ( find_foreign_library(Arch, FileSpec, EntryName, File, Time), 1083 term_to_atom(EntryName, Name), 1084 zipper_append_file(RC, Name, File, [time(Time)]) 1085 )).
1093:- if(current_prolog_flag(windows, true)). 1094copy_foreign_libraries(ExeFile, _Options) :- 1095 !, 1096 file_directory_name(ExeFile, Dir), 1097 win_process_modules(Modules), 1098 include(prolog_dll, Modules, PrologDLLs), 1099 maplist(copy_dll(Dir), PrologDLLs). 1100:- endif. 1101copy_foreign_libraries(_ExeFile, _Options) :- 1102 print_message(warning, qsave(copy_foreign_libraries)). 1103 1104prolog_dll(DLL) :- 1105 file_base_name(DLL, File), 1106 absolute_file_name(foreign(File), Abs, 1107 [ solutions(all) ]), 1108 same_file(DLL, Abs), 1109 !. 1110 1111copy_dll(Dest, DLL) :- 1112 print_message(informational, copy_foreign_library(DLL, Dest)), 1113 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.
1128find_foreign_library(Arch, FileSpec, shlib(Arch,Name), SharedObject, Time) :-
1129 FileSpec = foreign(Name),
1130 ( catch(arch_find_shlib(Arch, FileSpec, File),
1131 E,
1132 print_message(error, E)),
1133 exists_file(File)
1134 -> true
1135 ; throw(error(existence_error(architecture_shlib(Arch), FileSpec),_))
1136 ),
1137 time_file(File, Time),
1138 strip_file(File, SharedObject).1145strip_file(File, Stripped) :- 1146 absolute_file_name(path(strip), Strip, 1147 [ access(execute), 1148 file_errors(fail) 1149 ]), 1150 tmp_file(shared, Stripped), 1151 ( catch(do_strip_file(Strip, File, Stripped), E, 1152 (print_message(warning, E), fail)) 1153 -> true 1154 ; print_message(warning, qsave(strip_failed(File))), 1155 fail 1156 ), 1157 !. 1158strip_file(File, File). 1159 1160do_strip_file(Strip, File, Stripped) :- 1161 format(atom(Cmd), '"~w" -x -o "~w" "~w"', 1162 [Strip, Stripped, File]), 1163 shell(Cmd), 1164 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.
1178:- multifile arch_shlib/3. 1179 1180arch_find_shlib(Arch, FileSpec, File) :- 1181 arch_shlib(Arch, FileSpec, File), 1182 !. 1183arch_find_shlib(Arch, FileSpec, File) :- 1184 current_prolog_flag(arch, Arch), 1185 absolute_file_name(FileSpec, 1186 [ file_type(executable), 1187 access(read), 1188 file_errors(fail) 1189 ], File), 1190 !. 1191arch_find_shlib(Arch, foreign(Base), File) :- 1192 current_prolog_flag(arch, Arch), 1193 current_prolog_flag(windows, true), 1194 current_prolog_flag(executable, WinExe), 1195 prolog_to_os_filename(Exe, WinExe), 1196 file_directory_name(Exe, BinDir), 1197 file_name_extension(Base, dll, DllFile), 1198 atomic_list_concat([BinDir, /, DllFile], File), 1199 exists_file(File). 1200 1201 1202 /******************************* 1203 * UTIL * 1204 *******************************/ 1205 1206open_map(Options) :- 1207 option(map(Map), Options), 1208 !, 1209 open(Map, write, Fd), 1210 asserta(verbose(Fd)). 1211open_map(_) :- 1212 retractall(verbose(_)). 1213 1214close_map :- 1215 retract(verbose(Fd)), 1216 close(Fd), 1217 !. 1218close_map. 1219 1220feedback(Fmt, Args) :- 1221 verbose(Fd), 1222 !, 1223 format(Fd, Fmt, Args). 1224feedback(_, _). 1225 1226 1227check_options([]) :- !. 1228check_options([Var|_]) :- 1229 var(Var), 1230 !, 1231 throw(error(domain_error(save_options, Var), _)). 1232check_options([Name=Value|T]) :- 1233 !, 1234 ( save_option(Name, Type, _Comment) 1235 -> ( must_be(Type, Value) 1236 -> check_options(T) 1237 ; throw(error(domain_error(Type, Value), _)) 1238 ) 1239 ; throw(error(domain_error(save_option, Name), _)) 1240 ). 1241check_options([Term|T]) :- 1242 Term =.. [Name,Arg], 1243 !, 1244 check_options([Name=Arg|T]). 1245check_options([Var|_]) :- 1246 throw(error(domain_error(save_options, Var), _)). 1247check_options(Opt) :- 1248 throw(error(domain_error(list, Opt), _)).
1255zipper_append_file(_, Name, _, _) :- 1256 saved_resource_file(Name), 1257 !. 1258zipper_append_file(_, _, File, _) :- 1259 source_file(File), 1260 !. 1261zipper_append_file(Zipper, Name, File, Options) :- 1262 ( option(time(_), Options) 1263 -> Options1 = Options 1264 ; time_file(File, Stamp), 1265 Options1 = [time(Stamp)|Options] 1266 ), 1267 setup_call_cleanup( 1268 open(File, read, In, [type(binary)]), 1269 setup_call_cleanup( 1270 zipper_open_new_file_in_zip(Zipper, Name, Out, Options1), 1271 copy_stream_data(In, Out), 1272 close(Out)), 1273 close(In)), 1274 assertz(saved_resource_file(Name)).
time(Stamp).1281zipper_add_directory(Zipper, Name, Dir, Options) :- 1282 ( option(time(Stamp), Options) 1283 -> true 1284 ; time_file(Dir, Stamp) 1285 ), 1286 atom_concat(Name, /, DirName), 1287 ( saved_resource_file(DirName) 1288 -> true 1289 ; setup_call_cleanup( 1290 zipper_open_new_file_in_zip(Zipper, DirName, Out, 1291 [ method(store), 1292 time(Stamp) 1293 | Options 1294 ]), 1295 true, 1296 close(Out)), 1297 assertz(saved_resource_file(DirName)) 1298 ). 1299 1300add_parent_dirs(Zipper, Name, Dir, Options) :- 1301 ( option(time(Stamp), Options) 1302 -> true 1303 ; time_file(Dir, Stamp) 1304 ), 1305 file_directory_name(Name, Parent), 1306 ( Parent \== Name 1307 -> add_parent_dirs(Zipper, Parent, [time(Stamp)|Options]) 1308 ; true 1309 ). 1310 1311add_parent_dirs(_, '.', _) :- 1312 !. 1313add_parent_dirs(Zipper, Name, Options) :- 1314 zipper_add_directory(Zipper, Name, _, Options), 1315 file_directory_name(Name, Parent), 1316 ( Parent \== Name 1317 -> add_parent_dirs(Zipper, Parent, Options) 1318 ; true 1319 ).
1337zipper_append_directory(Zipper, Name, Dir, Options) :- 1338 exists_directory(Dir), 1339 !, 1340 add_parent_dirs(Zipper, Name, Dir, Options), 1341 zipper_add_directory(Zipper, Name, Dir, Options), 1342 directory_files(Dir, Members), 1343 forall(member(M, Members), 1344 ( reserved(M) 1345 -> true 1346 ; ignored(M, Options) 1347 -> true 1348 ; atomic_list_concat([Dir,M], /, Entry), 1349 atomic_list_concat([Name,M], /, Store), 1350 catch(zipper_append_directory(Zipper, Store, Entry, Options), 1351 E, 1352 print_message(warning, E)) 1353 )). 1354zipper_append_directory(Zipper, Name, File, Options) :- 1355 zipper_append_file(Zipper, Name, File, Options). 1356 1357reserved(.). 1358reserved(..).
include(Patterns) option that does not
match File or an exclude(Patterns) that does match File.1365ignored(File, Options) :- 1366 option(include(Patterns), Options), 1367 \+ ( ( is_list(Patterns) 1368 -> member(Pattern, Patterns) 1369 ; Pattern = Patterns 1370 ), 1371 glob_match(Pattern, File) 1372 ), 1373 !. 1374ignored(File, Options) :- 1375 option(exclude(Patterns), Options), 1376 ( is_list(Patterns) 1377 -> member(Pattern, Patterns) 1378 ; Pattern = Patterns 1379 ), 1380 glob_match(Pattern, File), 1381 !. 1382 1383glob_match(Pattern, File) :- 1384 current_prolog_flag(file_name_case_handling, case_sensitive), 1385 !, 1386 wildcard_match(Pattern, File). 1387glob_match(Pattern, File) :- 1388 wildcard_match(Pattern, File, [case_sensitive(false)]). 1389 1390 1391 /******************************** 1392 * SAVED STATE GENERATION * 1393 *********************************/
1399:- public 1400 qsave_toplevel/0. 1401 1402qsave_toplevel :- 1403 current_prolog_flag(os_argv, Argv), 1404 qsave_options(Argv, Files, Options), 1405 set_on_error(Options), 1406 '$cmd_option_val'(compileout, Out), 1407 user:consult(Files), 1408 maybe_exit_on_errors, 1409 qsave_program(Out, user:Options). 1410 1411set_on_error(Options) :- 1412 option(on_error(_), Options), !. 1413set_on_error(_Options) :- 1414 set_prolog_flag(on_error, status). 1415 1416maybe_exit_on_errors :- 1417 '$exit_code'(Code), 1418 ( Code =\= 0 1419 -> halt 1420 ; true 1421 ). 1422 1423qsave_options([], [], []). 1424qsave_options([--|_], [], []) :- 1425 !. 1426qsave_options(['-c'|T0], Files, Options) :- 1427 !, 1428 argv_files(T0, T1, Files, FilesT), 1429 qsave_options(T1, FilesT, Options). 1430qsave_options([O|T0], Files, [Option|T]) :- 1431 string_concat(--, Opt, O), 1432 split_string(Opt, =, '', [NameS|Rest]), 1433 split_string(NameS, '-', '', NameParts), 1434 atomic_list_concat(NameParts, '_', Name), 1435 qsave_option(Name, OptName, Rest, Value), 1436 !, 1437 Option =.. [OptName, Value], 1438 qsave_options(T0, Files, T). 1439qsave_options([_|T0], Files, T) :- 1440 qsave_options(T0, Files, T). 1441 1442argv_files([], [], Files, Files). 1443argv_files([H|T], [H|T], Files, Files) :- 1444 sub_atom(H, 0, _, _, -), 1445 !. 1446argv_files([H|T0], T, [H|Files0], Files) :- 1447 argv_files(T0, T, Files0, Files).
1451qsave_option(Name, Name, [], true) :- 1452 save_option(Name, boolean, _), 1453 !. 1454qsave_option(NoName, Name, [], false) :- 1455 atom_concat('no_', Name, NoName), 1456 save_option(Name, boolean, _), 1457 !. 1458qsave_option(Name, Name, ValueStrings, Value) :- 1459 save_option(Name, Type, _), 1460 !, 1461 atomics_to_string(ValueStrings, "=", ValueString), 1462 convert_option_value(Type, ValueString, Value). 1463qsave_option(Name, Name, _Chars, _Value) :- 1464 existence_error(save_option, Name). 1465 1466convert_option_value(integer, String, Value) => 1467 ( number_string(Value, String) 1468 -> true 1469 ; sub_string(String, 0, _, 1, SubString), 1470 sub_string(String, _, 1, 0, Suffix0), 1471 downcase_atom(Suffix0, Suffix), 1472 number_string(Number, SubString), 1473 suffix_multiplier(Suffix, Multiplier) 1474 -> Value is Number * Multiplier 1475 ; domain_error(integer, String) 1476 ). 1477convert_option_value(callable, String, Value) => 1478 term_string(Value, String). 1479convert_option_value(atom, String, Value) => 1480 atom_string(Value, String). 1481convert_option_value(boolean, String, Value) => 1482 atom_string(Value, String). 1483convert_option_value(oneof(_), String, Value) => 1484 atom_string(Value, String). 1485convert_option_value(ground, String, Value) => 1486 atom_string(Value, String). 1487convert_option_value(qsave_foreign_option, "save", Value) => 1488 Value = save. 1489convert_option_value(qsave_foreign_option, "copy", Value) => 1490 Value = copy. 1491convert_option_value(qsave_foreign_option, StrArchList, arch(ArchList)) => 1492 split_string(StrArchList, ",", ", \t", StrArchList1), 1493 maplist(atom_string, ArchList, StrArchList1). 1494 1495suffix_multiplier(b, 1). 1496suffix_multiplier(k, 1024). 1497suffix_multiplier(m, 1024 * 1024). 1498suffix_multiplier(g, 1024 * 1024 * 1024). 1499 1500 1501 /******************************* 1502 * MESSAGES * 1503 *******************************/ 1504 1505:- multifile prolog:message/3. 1506 1507prologmessage(no_resource(Name, File)) --> 1508 [ 'Could not find resource ~w on ~w or system resources'- 1509 [Name, File] ]. 1510prologmessage(qsave(nondet)) --> 1511 [ 'qsave_program/2 succeeded with a choice point'-[] ]. 1512prologmessage(copy_foreign_library(Lib,Dir)) --> 1513 [ '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.