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