1 ;;;; This file is part of LilyPond, the GNU music typesetter.
3 ;;;; Copyright (C) 1998--2015 Jan Nieuwenhuizen <janneke@gnu.org>
4 ;;;; Han-Wen Nienhuys <hanwen@xs4all.nl>
6 ;;;; LilyPond is free software: you can redistribute it and/or modify
7 ;;;; it under the terms of the GNU General Public License as published by
8 ;;;; the Free Software Foundation, either version 3 of the License, or
9 ;;;; (at your option) any later version.
11 ;;;; LilyPond is distributed in the hope that it will be useful,
12 ;;;; but WITHOUT ANY WARRANTY; without even the implied warranty of
13 ;;;; MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE. See the
14 ;;;; GNU General Public License for more details.
16 ;;;; You should have received a copy of the GNU General Public License
17 ;;;; along with LilyPond. If not, see <http://www.gnu.org/licenses/>.
19 ;; Internationalisation: (_i "to be translated") gets an entry in the
20 ;; POT file; (gettext ...) must be invoked explicitly to do the actual
23 ;; (define-macro (_i x) x)
24 ;; (define-macro-public _i (x) x)
25 ;; (define-public-macro _i (x) x)
28 (defmacro-public _i (x) x)
30 ;;; Boolean thunk - are we integrating Guile V2.0 or higher with LilyPond?
31 (define-public (guile-v2)
32 (string>? (version) "1.9.10"))
34 (read-enable 'positions)
38 (debug-enable 'backtrace)
39 (debug-set! show-file-name #t)))
41 (define-public PLATFORM
44 (car (string-tokenize (utsname:sysname (uname)) char-set:letter)))))
46 ;; We don't use (srfi srfi-39) (parameter objects) here because that
47 ;; does not give us a name/handle to the underlying fluids themselves.
49 (define %parser (make-fluid))
50 (define %location (make-fluid))
51 ;; No public setters: should not get overwritten in action
52 (define-public (*parser*) (fluid-ref %parser))
53 (define-public (*location*) (fluid-ref %location))
54 ;; but properly scoped location should be fine
55 (defmacro-public with-location (loc . body)
56 `(with-fluids ((,%location ,loc)) ,@body))
58 ;; It would be nice to convert occurences of parser/location to
59 ;; (*parser*)/(*location*) using the syncase module but it is utterly
60 ;; broken in GUILE 1 and would require changing a lot of unrelated
61 ;; innocuous constructs which just happen to fall apart with
62 ;; inscrutable error messages.
65 ;; Session-handling variables and procedures.
67 ;; A "session" corresponds to one .ly file processed on a LilyPond
68 ;; command line. Every session gets to see a reasonably fresh state
69 ;; of LilyPond and should work independently from previous files.
71 ;; Session management relies on cooperation, namely the user not
72 ;; trying to change variables and data structures internal to
73 ;; LilyPond. It is not proof against in-place modification of data
74 ;; structures (as they are just reinitialized with the original
75 ;; identities), and it is not proof against tampering with internals.
77 ;; As a consequence, session management is not sufficient for
78 ;; separating multiple independent .ly files in "-dsafe" mode: you
79 ;; should give each its own LilyPond process when reliable separation
82 ;; For standard tasks and programming practices, multiple sessions in
83 ;; the same LilyPond job should work reasonably independently and
84 ;; without "bleed-over" while still loading and compiling the
85 ;; relevant .scm and .ly files only once.
88 (define lilypond-declarations '())
89 (define lilypond-exports '())
90 (define after-session-hook (make-hook))
92 (define-public (call-after-session thunk)
93 (if (ly:undead? lilypond-declarations)
94 (ly:error (_ "call-after-session used after session start")))
95 (add-hook! after-session-hook thunk #t))
97 (define (make-session-variable name value)
98 (if (ly:undead? lilypond-declarations)
99 (ly:error (_ "define-session used after session start")))
100 (let ((var (module-make-local-var! (current-module) name)))
101 (if (variable-bound? var)
102 (ly:error (_ "symbol ~S redefined") name))
103 (variable-set! var value)
106 (defmacro define-session (name value)
107 "This defines a variable @var{name} with the starting value
108 @var{value} that is reinitialized at the start of each session.
109 A@tie{}session basically corresponds to one LilyPond file on the
110 command line. The value is recorded at the start of the first session
111 after loading all initialization files and before loading the user
112 file and is reinstated for all of the following sessions. This
113 happens just by replacing the value, not by copying structures, so you
114 should not destructively modify them. For example, lists defined in
115 this manner should be changed within a session only be adding material
116 to their front or replacing them altogether, not by modifying parts of
117 them. It is an error to call @code{define-session} after the first
118 session has started."
119 (define (add-session-variable name value)
120 (set! lilypond-declarations
121 (cons (make-session-variable name value) lilypond-declarations)))
122 `(,add-session-variable ',name ,value))
124 (defmacro define-session-public (name value)
125 "Like @code{define-session}, but also exports @var{name} into parser modules."
126 (define (add-session-variable name value)
127 (set! lilypond-exports
128 (acons name (make-session-variable name value) lilypond-exports)))
130 ;; this is a bit icky: we place the variable right into every
131 ;; parser module so that both set! and define will affect the
132 ;; original variable in the (lily) module. However, we _also_
133 ;; export it normally from (lily) for the sake of other modules
134 ;; not sharing the name space of the parser.
135 (,add-session-variable ',name ,value)
138 (define (session-terminate)
139 (if (ly:undead? lilypond-declarations)
142 (lambda (p) (variable-set! (cadr p) (cddr p)))
143 (ly:get-undead lilypond-declarations))
144 (run-hook after-session-hook))))
146 (define lilypond-interfaces #f)
148 (define-public (session-initialize thunk)
149 "Initialize this session. The first session in a LilyPond run is
150 initialized by calling @var{thunk}, then recording the values of all
151 variables in the current module as well as those defined with
152 @code{define-session}. Subsequent calls of @code{session-initialize}
153 ignore @var{thunk} and instead just reinitialize all recorded
154 variables to their value after the initial call of @var{thunk}."
156 ;; We need to save the variables of the current module along with
157 ;; their values: functions defined in the module might refer to the
160 ;; The entries in lilypond-declarations consist of a cons* consisting
161 ;; of symbol, variable, and value. Variables defined with
162 ;; define-session have the symbol set to #f.
164 (if (ly:undead? lilypond-declarations)
166 (module-use-interfaces! (current-module) (reverse lilypond-interfaces))
171 (variable-set! var val)
173 (module-add! (current-module) (car p) var))))
174 (ly:get-undead lilypond-declarations)))
176 ;; import all public session variables natively into parser
177 ;; module. That makes them behave identically under define/set!
178 (for-each (lambda (v)
179 (module-add! (current-module) (car v) (cdr v)))
181 ;; Initialize first session
183 ;; lilypond-exports is no longer needed since we will grab its
184 ;; values from (current-module).
185 (set! lilypond-exports #f)
186 (set! lilypond-interfaces
187 (filter (lambda (m) (eq? 'interface (module-kind m)))
188 (module-uses (current-module))))
189 (let ((decl (map! (lambda (v)
190 (cons* #f v (variable-ref v)))
191 lilypond-declarations)))
194 (let ((val (variable-ref v)))
195 (if (not (ly:lily-parser? val))
201 (set! lilypond-declarations (ly:make-undead decl))))))
203 (define scheme-options-definitions
207 ;; - [subject-]object-object-verb +"ing"
208 ;; - [subject-]-verb-object-object
210 ;; Avoid overlong lines in `lilypond -dhelp'! Strings should not
211 ;; be longer than 48 characters per line.
214 "Render at higher resolution (using given factor)
215 and scale down result to prevent jaggies in
219 "Create .tex, .texi, .count files in the
223 "Select backend. Possible values: 'eps, 'null,
224 'ps, 'scm, 'socket, 'svg.")
225 (check-internal-types
227 "Check every property assignment for types.")
230 "Generate cut-out snippets of a score.")
233 "LilyPond prefix for data files (read-only).")
236 "Dump memory debugging statistics.")
237 (debug-gc-assert-parsed-dead
239 "For memory debugging: Ensure that all
240 references to parsed objects are dead. This is
241 an internal option, and is switched on
242 automatically for `-ddebug-gc'.")
245 "Debug the flex lexer.")
246 (debug-page-breaking-scoring
248 "Dump scores for many different page breaking
252 "Debug the bison parser.")
253 (debug-property-callbacks
255 "Debug cyclic callback chains.")
259 (delete-intermediate-files
261 "Delete unusable, intermediate PostScript files.")
264 "Dump memory and time information for each file.")
267 "Dump timing information (system-dependent).")
270 "Dump output signatures of each system. Used for
271 regression testing.")
274 "Embed the source files inside the generated PDF document.")
277 "Pad left edge of the output EPS bounding box by
278 given amount (in mm).")
281 "Directory for exporting fonts as PostScript files.")
284 "Load fonts via Ghostscript.")
287 "Load only LilyPond fonts via Ghostscript.")
288 (gs-never-embed-fonts
290 "Make Ghostscript embed only TrueType fonts and no other font format.")
293 "Run LilyPond from a GUI and redirect stderr to
298 (include-book-title-preview
300 "Include book titles in preview images.")
303 "Include fonts in separate-system EPS files.")
306 "Include file for global settings, included before the score is processed.")
309 "Process in parallel, using the given number of
313 "If string FOO is given as argument, redirect
314 output to log file `FOO.log'.")
317 "Maximum depth for the markup tree. If a markup has more levels,
318 assume it will not terminate on its own, print a warning and return a
319 null markup instead.")
320 (midi-extension ,(if (eq? PLATFORM 'windows)
323 "Set the default file extension for MIDI output
324 file to given string.")
325 (music-strings-to-paths
327 "Convert text strings to paths when glyphs belong
331 "Add point & click links to PDF and SVG output.")
334 "Set default paper size.")
337 "Set GhostScript's output format for pixel images.")
340 "Create preview images also.")
343 "Print pages in the normal way.")
344 (protected-scheme-parsing
346 "Continue when errors in inline scheme are caught
347 in the parser. If #f, halt on errors and print
349 (profile-property-accesses
351 "Keep statistics of get_property() calls.")
354 "Set resolution for generating PNG pixmaps to
355 given value (in dpi).")
358 "Specify name of a file which contains a list of
359 input files to be processed.")
362 "When processing an \\include command, look for
363 the included file relative to the current file\
364 \n(instead of the root file)")
367 "Run in safer mode.")
370 "For input files `FILE1.ly', `FILE2.ly', ...
371 output log data to files `FILE1.log',
373 (show-available-fonts
375 "List available font names.")
376 (strict-infinity-checking
378 "Force a crash on encountering Inf and NaN
379 floating point exceptions.")
382 "Don't use directories from input files while
383 constructing output file names.")
386 "Set the PostScript strokeadjust operator explicitly.
387 This employs different drawing primitives, resulting in
388 large PDF file size increases but often markedly better
392 "Use woff font files in SVG backend.")
393 (trace-memory-frequency
395 "Record Scheme cell usage this many times per
396 second. Dump results to `FILE.stacks' and
398 (trace-scheme-coverage
400 "Record coverage of Scheme files in `FILE.cov'.")
401 (verbose ,(ly:verbose-output?)
402 "Verbose output, i.e. loglevel at least DEBUG (read-only).")
405 "Change all warning and programming_error
406 messages into errors.")
409 ;; Need to do this in the beginning. Other parts of the Scheme
410 ;; initialization depend on these options.
412 (for-each (lambda (x)
413 (ly:add-option (car x) (cadr x) (caddr x)))
414 scheme-options-definitions)
416 (for-each (lambda (x)
417 (ly:set-option (car x) (cdr x)))
418 (eval-string (ly:command-line-options)))
422 (if (defined? 'set-debug-cell-accesses!)
423 (set-debug-cell-accesses! #f))
425 ;;(set-debug-cell-accesses! 1000)
427 (use-modules (ice-9 regex)
439 (scm safe-utility-defs))
441 (define-public _ gettext)
442 ;;; There are new modules defined in Guile V2.0 which we need to use.
444 ;; Modules and scheme files loaded by lily.scm use currying
445 ;; in Guile V2 this needs a module which is not present in Guile V1.8
450 (ly:debug (_ "Using (ice-9 curried-definitions) module\n"))
451 (use-modules (ice-9 curried-definitions)))
453 (ly:debug (_ "Guile 1.8\n"))))
455 ;; TODO add in modules for V1.8.7 deprecated in V2.0 and integrated
456 ;; into Guile base code, like (ice-9 syncase).
459 (define-public fancy-format
462 (define-public (ergonomic-simple-format dest . rest)
463 "Like ice-9's @code{format}, but without the memory consumption."
465 (apply simple-format #f dest rest)
466 (apply simple-format dest rest)))
469 ergonomic-simple-format)
472 (define-public (myd k v)
479 (define-public (print . args)
480 (apply format (current-output-port) args))
483 ;;; General settings.
485 ;;; Debugging evaluator is slower. This should have a more sensible
489 (if (or (ly:get-option 'verbose)
490 (ly:get-option 'trace-memory-frequency)
491 (ly:get-option 'trace-scheme-coverage))
493 (ly:set-option 'protected-scheme-parsing #f)
494 (debug-enable 'backtrace)
495 (read-enable 'positions)))
497 (if (ly:get-option 'trace-scheme-coverage)
500 (define music-string-to-path-backends
503 (if (memq (ly:get-option 'backend) music-string-to-path-backends)
504 (ly:set-option 'music-strings-to-paths #t))
506 (define-public (ly:load x)
507 (let* ((file-name (%search-load-path x)))
508 (ly:debug "[~A" file-name)
510 (ly:error (_ "cannot find: ~A") x))
511 (primitive-load-path file-name) ;; to support Guile V2 autocompile
512 ;; TODO: Any chance to use ly:debug here? Need to extend it to prevent
513 ;; a newline in this case
514 (if (ly:get-option 'verbose)
515 (ly:progress "]\n"))))
518 (let ((platform (string-tokenize
519 (vector-ref (uname) 0) char-set:letter+digit)))
520 (if (null? (cdr platform)) #f
521 (member (string-downcase (cadr platform)) '("95" "98" "me")))))
524 (if (string-index x #\\)
526 (string-regexp-substitute
528 (string-regexp-substitute "\\\\" "/" x))))
530 (define-public (ly-getcwd)
531 (if (eq? PLATFORM 'windows)
535 (define-public (is-absolute? file-name)
536 (let ((file-name-length (string-length file-name)))
537 (if (= file-name-length 0)
539 (or (eq? (string-ref file-name 0) #\/)
540 (and (eq? PLATFORM 'windows)
541 (> file-name-length 2)
542 (eq? (string-ref file-name 1) #\:)
543 (or (eq? (string-ref file-name 2) #\\)
544 (eq? (string-ref file-name 2) #\/)))))))
546 ;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;
547 ;;; If necessary, emulate Guile V2 module_export_all! for Guile V1.8.n
550 (define (module-export-all! mod)
551 (define (fresh-interface!)
552 (let ((iface (make-module)))
553 (set-module-name! iface (module-name mod))
554 ;; for guile 2: (set-module-version! iface (module-version mod))
555 (set-module-kind! iface 'interface)
556 (set-module-public-interface! mod iface)
558 (let ((iface (or (module-public-interface mod)
559 (fresh-interface!))))
560 (set-module-obarray! iface (module-obarray mod))))))
563 (define-safe-public (lilypond-version)
565 (map (lambda (x) (if (symbol? x)
571 ;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;
574 (ly:set-default-scale (ly:make-scale #(0 1 2 5/2 7/2 9/2 11/2)))
576 ;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;
580 ;; List of Scheme files to be loaded into the (lily) module.
582 ;; - Library definitions, need to be at the head of the list
583 (define init-scheme-files-lib
586 ;; - Files containing definitions used later by other files later in load
587 (define init-scheme-files-used
588 '("markup-macros.scm"
589 "parser-ly-from-scheme.scm"))
590 ;; - Main body of files to be loaded
591 (define init-scheme-files-body
593 "define-event-classes.scm"
594 "define-music-callbacks.scm"
595 "define-music-types.scm"
596 "define-note-names.scm"
601 "define-markup-commands.scm"
603 "modal-transforms.scm"
604 "chord-generic-names.scm"
605 "chord-ignatzek-names.scm"
606 "music-functions.scm"
609 "define-music-properties.scm"
611 "time-signature-settings.scm"
616 "define-context-properties.scm"
617 "translation-functions.scm"
631 "define-woodwind-diagrams.scm"
632 "display-woodwind-diagrams.scm"
633 "predefined-fretboards.scm"
634 "define-grob-properties.scm"
636 "define-grob-interfaces.scm"
637 "define-stencil-commands.scm"
638 "scheme-engravers.scm"
643 "backend-library.scm"
645 ;; - Files to be loaded last
646 (define init-scheme-files-tail
647 ;; - must be after everything has been defined
650 ;; Now construct the load list
652 (define init-scheme-files
653 (append init-scheme-files-lib
654 init-scheme-files-used
655 init-scheme-files-body
656 init-scheme-files-tail))
658 (for-each ly:load init-scheme-files)
660 (define-public r5rs-primary-predicates
661 `((,boolean? . "boolean")
662 (,char? . "character")
663 (,number? . "number")
666 (,procedure? . "procedure")
667 (,string? . "string")
668 (,symbol? . "symbol")
669 (,vector? . "vector")))
671 (define-public r5rs-secondary-predicates
672 `((,char-alphabetic? . "alphabetic character")
673 (,char-lower-case? . "lower-case character")
674 (,char-numeric? . "numeric character")
675 (,char-upper-case? . "upper-case character")
676 (,char-whitespace? . "whitespace character")
678 (,complex? . "complex number")
679 (,even? . "even number")
680 (,exact? . "exact number")
681 (,inexact? . "inexact number")
682 (,integer? . "integer")
683 (,negative? . "negative number")
684 (,odd? . "odd number")
685 (,positive? . "positive number")
686 (,rational? . "rational number")
687 (,real? . "real number")
693 (,input-port? . "input port")
694 (,output-port? . "output port")
696 ;; would this ever be used?
697 (,eof-object? . "end-of-file object")
700 (define-public guile-predicates
701 `((,hash-table? . "hash table")
704 (define-public lilypond-scheme-predicates
705 `((,boolean-or-symbol? . "boolean or symbol")
707 (,cheap-list? . "list")
708 (,fraction? . "fraction, as pair")
709 (,grob-list? . "list of grobs")
710 (,index? . "non-negative integer")
711 (,key? . "index or symbol")
712 (,key-list? . "list of indexes or symbols")
713 (,key-list-or-music? . "key list or music")
714 (,key-list-or-symbol? . "key list or symbol")
715 (,markup? . "markup")
716 (,markup-command-list? . "markup command list")
717 (,markup-list? . "markup list")
718 (,moment-pair? . "pair of moment objects")
719 (,number-list? . "number list")
720 (,number-or-grob? . "number or grob")
721 (,number-or-markup? . "number or markup")
722 (,number-or-pair? . "number or pair")
723 (,number-or-string? . "number or string")
724 (,number-pair? . "pair of numbers")
725 (,number-pair-list? . "list of number pairs")
726 (,rational-or-procedure? . "an exact rational or procedure")
727 (,rhythmic-location? . "rhythmic location")
728 (,scheme? . "any type")
729 (,string-or-pair? . "string or pair")
730 (,string-or-music? . "string or music")
731 (,string-or-symbol? . "string or symbol")
732 (,symbol-list? . "symbol list")
733 (,symbol-list-or-music? . "symbol list or music")
734 (,symbol-list-or-symbol? . "symbol list or symbol")
738 (define-public lilypond-exported-predicates
739 `((,ly:book? . "book")
741 (,ly:context? . "context")
742 (,ly:context-def? . "context definition")
743 (,ly:context-mod? . "context modification")
744 (,ly:dimension? . "dimension, in staff space")
745 (,ly:dir? . "direction")
746 (,ly:dispatcher? . "dispatcher")
747 (,ly:duration? . "duration")
748 (,ly:event? . "post event")
749 (,ly:font-metric? . "font metric")
750 (,ly:grob? . "graphical (layout) object")
751 (,ly:grob-array? . "array of grobs")
752 (,ly:grob-properties? . "grob properties")
753 (,ly:input-location? . "input location")
755 (,ly:iterator? . "iterator")
756 (,ly:lily-lexer? . "lily-lexer")
757 (,ly:lily-parser? . "lily-parser")
758 (,ly:listener? . "listener")
759 (,ly:moment? . "moment")
760 (,ly:music? . "music")
761 (,ly:music-function? . "music function")
762 (,ly:music-list? . "list of music objects")
763 (,ly:music-output? . "music output")
764 (,ly:otf-font? . "OpenType font")
765 (,ly:output-def? . "output definition")
766 (,ly:page-marker? . "page marker")
767 (,ly:pango-font? . "pango font")
768 (,ly:paper-book? . "paper book")
769 (,ly:paper-system? . "paper-system Prob")
770 (,ly:pitch? . "pitch")
771 (,ly:prob? . "property object")
772 (,ly:score? . "score")
773 (,ly:skyline? . "skyline")
774 (,ly:skyline-pair? . "pair of skylines")
775 (,ly:source-file? . "source file")
776 (,ly:spanner? . "spanner")
777 (,ly:spring? . "spring")
778 (,ly:stencil? . "stencil")
779 (,ly:stream-event? . "stream event")
780 (,ly:translator? . "translator")
781 (,ly:translator-group? . "translator group")
782 (,ly:undead? . "undead container")
783 (,ly:unpure-pure-container? . "unpure/pure container")
787 (set! type-p-name-alist
788 (append r5rs-primary-predicates
789 r5rs-secondary-predicates
791 lilypond-scheme-predicates
792 lilypond-exported-predicates))
795 ;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;
798 (define (profile-measurements)
801 (list (- (+ (tms:cutime t)
803 (assoc-get 'gc-time-taken stats))
804 (assoc-get 'total-cells-allocated stats 0))))
806 (define (dump-profile base last this)
807 (let* ((outname (format #f "~a.profile" (dir-basename base ".ly")))
808 (diff (map - this last)))
809 (ly:progress "\nWriting timing to ~a...\n" outname)
810 (format (open-file outname "w")
811 "time: ~a\ncells: ~a\n"
812 (if (ly:get-option 'dump-cpu-profile)
817 ;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;
818 ;; debug memory leaks
823 (define gc-protect-stat-count
826 ;; Undead objects that should be ignored after the first time round
828 (make-weak-key-hash-table 0))
830 (define-public (dump-live-object-stats outfile)
831 (for-each (lambda (x)
832 (format outfile "~a: ~a\n" (car x) (cdr x)))
833 (sort (gc-live-object-stats)
835 (string<? (car x) (car y))))))
837 (define-public (dump-gc-protects)
838 (set! gc-protect-stat-count (1+ gc-protect-stat-count))
839 (let* ((protects (sort (hash-table->alist (ly:protects))
841 (< (object-address (car a))
842 (object-address (car b))))))
843 (out-file-name (string-append
844 "gcstat-" (number->string gc-protect-stat-count)
846 (outfile (open-file out-file-name "w")))
848 (ly:progress "Dumping GC statistics ~a...\n" out-file-name)
849 (for-each (lambda (y)
852 (format outfile "~a (~a) = ~a\n" (object-address x) c x)))
855 (not (symbol? (car x))))
857 (format outfile "\nprotected symbols: ~a\n"
858 (apply + (map (lambda (obj-count)
859 (if (symbol? (car obj-count))
864 ;; (display (ly:smob-protects))
866 (if (defined? 'gc-live-object-stats)
868 (ly:progress "Live object statistics: GC'ing\n")
872 (ly:progress "Asserting dead objects\n")
873 (ly:set-option 'debug-gc-assert-parsed-dead #t)
875 (ly:set-option 'debug-gc-assert-parsed-dead #f)
878 (if (not (hashq-ref gc-zombies x))
880 (ly:programming-error "Parsed object should be dead: ~a" x)
881 (hashq-set! gc-zombies x #t))))
882 (ly:parsed-undead-list!))
883 (set! stats (gc-live-object-stats))
884 (ly:progress "Dumping live object statistics.\n")
885 (dump-live-object-stats outfile)))
887 (let* ((stats (gc-stats)))
888 (for-each (lambda (sym)
889 (format outfile "~a ~a ~a\n"
890 gc-protect-stat-count
892 (assoc-get sym stats "?")))
893 '(protected-objects bytes-malloced cell-heap-size)))
895 (close-port outfile)))
897 (define (check-memory)
898 "Read `/proc/self' to check up on memory use."
899 (define (gulp-file name)
900 (let* ((file (open-input-file name))
901 (text (read-delimited "" file)))
905 (let* ((stat (gulp-file "/proc/self/status"))
906 (lines (string-split stat #\newline))
907 (interesting (filter-map
909 (string-match "^VmData:[ \t]*([0-9]*) kB" l))
911 (mem (string->number (match:substring (car interesting) 1))))
912 (format #t "VMDATA: ~a\n" mem)
916 (begin (dump-gc-protects)
919 ;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;
921 (define (multi-fork count)
922 "Split this process into COUNT helpers. Returns either a list of
923 PIDs or the number of the process."
924 (define (helper count acc)
926 (let* ((pid (primitive-fork)))
929 (helper (1- count) (cons pid acc))))
934 ;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;
936 (define* (ly:exit status #:optional (silently #f))
937 "Exit function for lilypond"
940 ((0) (ly:basic-progress (_ "Success: compilation successfully completed")))
941 ((1) (ly:warning (_ "Compilation completed with warnings or errors")))
942 (else (ly:message ""))))
945 ;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;
947 (define-public (lilypond-main files)
948 "Entry point for LilyPond."
949 (eval-string (ly:command-line-code))
950 (if (ly:get-option 'help)
951 (begin (ly:option-usage)
953 (if (ly:get-option 'show-available-fonts)
954 (begin (ly:font-config-display-fonts)
956 (if (ly:get-option 'gui)
961 (if (ly:get-option 'read-file-list)
966 (string-split (string-delete (ly:gulp-file f) #\cr) #\nl))
968 (if (and (number? (ly:get-option 'job-count))
969 (>= (length files) (ly:get-option 'job-count)))
970 (let* ((count (ly:get-option 'job-count))
971 (split-todo (split-list files count))
972 (joblist (multi-fork count))
974 (if (not (string-or-symbol? (ly:get-option 'log-file)))
975 (ly:set-option 'log-file "lilypond-multi-run"))
976 (if (number? joblist)
977 (begin (ly:set-option
978 'log-file (format #f "~a-~a"
979 (ly:get-option 'log-file) joblist))
980 (set! files (vector-ref split-todo joblist)))
981 (begin (ly:progress "\nForking into jobs: ~a\n" joblist)
984 (let* ((stat (cdr (waitpid pid))))
987 (acons (list-element-index joblist pid)
994 (logfile (format #f "~a-~a.log"
995 (ly:get-option 'log-file) job))
996 (log (ly:gulp-file logfile))
997 (len (string-length log))
998 (tail (substring log (max 0 (- len 1024)))))
999 (if (status:term-sig state)
1002 (format #f (_ "job ~a terminated with signal: ~a")
1003 job (status:term-sig state)))
1005 (_ "logfile ~a (exit ~a):\n~a")
1006 logfile (status:exit-val state) tail))))
1009 (ly:error "Children ~a exited with errors."
1011 ;; must overwrite individual entries
1012 (if (ly:get-option 'dump-profile)
1013 (dump-profile "lily-run-total"
1014 '(0 0) (profile-measurements)))
1019 (if (string-or-symbol? (ly:get-option 'log-file))
1020 (ly:stderr-redirect (format #f "~a.log" (ly:get-option 'log-file)) "w"))
1021 (let ((failed (lilypond-all files)))
1022 (if (ly:get-option 'trace-scheme-coverage)
1024 (coverage:show-all (lambda (f)
1025 (string-contains f "lilypond")))))
1027 (begin (ly:error (_ "failed files: ~S") (string-join failed))
1033 (define-public (lilypond-all files)
1035 (separate-logs (ly:get-option 'separate-log-files))
1038 (if (string-or-symbol? (ly:get-option 'log-file))
1039 (open-file (format #f "~a.log" (ly:get-option 'log-file))
1041 (fdes->outport 2))))
1042 (do-measurements (ly:get-option 'dump-profile))
1043 (handler (lambda (key failed-file)
1044 (set! failed (append (list failed-file) failed)))))
1048 (let* ((start-measurements (if do-measurements
1049 (profile-measurements)
1051 (base (dir-basename x ".ly"))
1052 (all-settings (ly:all-options)))
1054 (ly:stderr-redirect (format #f "~a.log" base) "w"))
1056 (format ping-log "Processing ~a\n" base))
1057 (if (ly:get-option 'trace-memory-frequency)
1058 (mtrace:start-trace (ly:get-option 'trace-memory-frequency)))
1059 (lilypond-file handler x)
1060 (ly:check-expected-warnings)
1062 (if start-measurements
1063 (dump-profile x start-measurements (profile-measurements)))
1064 (if (ly:get-option 'trace-memory-frequency)
1065 (begin (mtrace:stop-trace)
1066 (mtrace:dump-results base)))
1067 (for-each (lambda (s)
1068 (ly:set-option (car s) (cdr s)))
1070 (ly:set-option 'debug-gc-assert-parsed-dead #t)
1072 (ly:set-option 'debug-gc-assert-parsed-dead #f)
1075 (if (not (hashq-ref gc-zombies x))
1077 (ly:programming-error "Parsed object should be dead: ~a" x)
1078 (hashq-set! gc-zombies x #t))))
1079 (ly:parsed-undead-list!))
1080 (if (ly:get-option 'debug-gc)
1082 (ly:reset-all-fonts))
1086 ;; Ensure a notice re failed files is written to aggregate logfile.
1088 (format ping-log "Failed files: ~a\n" failed))
1089 (if (ly:get-option 'dump-profile)
1090 (dump-profile "lily-run-total" '(0 0) (profile-measurements)))
1093 (define (lilypond-file handler file-name)
1094 (catch 'ly-file-failed
1095 (lambda () (ly:parse-file file-name))
1096 (lambda (x . args) (handler x file-name))))
1098 (use-modules (scm editor))
1100 (define-public (gui-main files)
1102 (gui-no-files-handler))
1103 (if (not (string? (ly:get-option 'log-file)))
1104 (let* ((base (dir-basename (car files) ".ly"))
1105 (log-name (string-append base ".log")))
1106 (if (not (ly:get-option 'gui))
1107 (ly:message (_ "Redirecting output to ~a...") log-name))
1108 (ly:stderr-redirect log-name "w")
1109 (ly:message "# -*-compilation-*-"))
1110 (let ((failed (lilypond-all files)))
1114 (ly:stderr-redirect "foo" "r")
1115 (system (get-editor-command log-name 0 0 0))
1116 (ly:error (_ "failed files: ~S") (string-join failed))
1121 (define (gui-no-files-handler)
1122 (let* ((ly (string-append (ly:effective-prefix) "/ly/"))
1123 ;; FIXME: soft-code, localize
1124 (welcome-ly (string-append ly "Welcome_to_LilyPond.ly"))
1125 (cmd (get-editor-command welcome-ly 0 0 0)))
1126 (ly:message (_ "Invoking `~a'...\n") cmd)