X-Git-Url: https://git.donarmstrong.com/?a=blobdiff_plain;f=scm%2Flily.scm;h=8780c12b24a9c7695078736b68cca72dce67b72e;hb=3e08e326e7c38c81d3355a3f2e7ef8eb48bd121e;hp=ee17b9fbc77c9f20f027b408c0b90d22cfab7c70;hpb=3d0c45c00d400d3430fc4c0beb41cf96ebd28889;p=lilypond.git diff --git a/scm/lily.scm b/scm/lily.scm index ee17b9fbc7..8780c12b24 100644 --- a/scm/lily.scm +++ b/scm/lily.scm @@ -20,18 +20,13 @@ (anti-alias-factor 1 "render at higher resolution and scale down result\nto prevent jaggies in PNG") (check-internal-types #f "check every property assignment for types") (clip-systems #f "Generate cut-out snippets of a score") - (debug-gc #f - "dump memory debugging statistics") - (debug-gc-assert-parsed-dead #f - "for memory debugging: ensure that all refs to parsed objects are dead.") - - (debug-midi #f "generate human readable MIDI") - (debug-parser #f "debug the bison parser") + (debug-gc #f "dump memory debugging statistics") + (debug-gc-assert-parsed-dead + #f "for memory debugging: ensure that all refs to parsed objects are dead.") (debug-lexer #f "debug the flex lexer") (debug-midi #f "generate human readable MIDI") (debug-parser #f "debug the bison parser") - (debug-lexer #f "debug the flex lexer") - (debug-midi #f "generate human readable MIDI") + (debug-skylines #f "debug skylines") (delete-intermediate-files #f "delete unusable PostScript files") (dump-signatures #f "dump output signatures of each system") @@ -40,11 +35,12 @@ "load fonts via Ghostscript.") (include-book-title-preview #t "include book-titles in preview images.") (include-eps-fonts #t "Include fonts in separate-system EPS files.") + (job-count #f "Process in parallel") (eps-box-padding #f "Pad EPS bounding box left edge by this much to guarantee alignment between systems") (gui #f "running from gui; redirect stderr to log file") - + (log-file #f "redirect output to log FILE.log") (old-relative #f "relative for simultaneous music works similar to chord syntax") @@ -52,19 +48,20 @@ similar to chord syntax") "experimental mechanism for remembering tweaks") (point-and-click #t "use point & click") (paper-size "a4" "the default paper size") + (pixmap-format "png16m" "GS format to use for pixel images") (protected-scheme-parsing #t "continue when finding errors in inline scheme are caught in the parser. If off, halt on errors, and print a stack trace.") (profile-property-accesses #f "keep statistics of get_property() calls.") - (resolution 101 "resolution for generating bitmaps") + (resolution 101 "resolution for generating PNG bitmaps") (read-file-list #f "Read files to be processed from command line arguments") (safe #f "Run safely") (strict-infinity-checking #f "If yes, crash on encountering Inf/NaN") (ttf-verbosity 0 - "how much verbosity for TTF font embedding?") + "how much verbosity for TTF font embedding?") (show-available-fonts #f "List font names available.") @@ -83,7 +80,7 @@ on errors, and print a stack trace.") (if (defined? 'set-debug-cell-accesses!) (set-debug-cell-accesses! #f)) -;(set-debug-cell-accesses! 1000) + ;(set-debug-cell-accesses! 1000) (use-modules (ice-9 regex) (ice-9 safe) @@ -110,6 +107,7 @@ on errors, and print a stack trace.") (if (ly:get-option 'verbose) (begin + (ly:set-option 'protected-scheme-parsing #f) (debug-enable 'debug) (debug-enable 'backtrace) (read-enable 'positions))) @@ -143,7 +141,7 @@ on errors, and print a stack trace.") (if (ly:get-option 'verbose) (ly:progress "[~A" file-name)) (if (not file-name) - (ly:error (_ "Can't find ~A" x))) + (ly:error (_ "cannot find: ~A") x)) (primitive-load file-name) (if (ly:get-option 'verbose) (ly:progress "]")))) @@ -180,7 +178,7 @@ on errors, and print a stack trace.") "//*" "/" (string-regexp-substitute "\\\\" "/" x)))) ;; FIXME: this prints a warning. - (define-public (ly-getcwd) + (define-public (ly-getcwd) (slashify (native-getcwd)))) (else (define-public ly-getcwd getcwd))) @@ -259,7 +257,7 @@ The syntax is the same as `define*-public'." (ly:set-default-scale (ly:make-scale #(0 2 4 5 7 9 11))) - + ;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;; ;; other files. @@ -351,8 +349,10 @@ The syntax is the same as `define*-public'." (,vector? . "vector"))) +;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;; ;; debug mem leaks +(define gc-dumping #f) (define gc-protect-stat-count 0) (define-public (dump-gc-protects) (set! gc-protect-stat-count (1+ gc-protect-stat-count)) @@ -367,34 +367,38 @@ The syntax is the same as `define*-public'." ".scm")) (outfile (open-file out-file-name "w"))) - (display (format "Dumping gc protected objs to ~a...\n" out-file-name)) + (set! gc-dumping #t) + (display (format "Dumping GC statistics ~a...\n" out-file-name)) (display (map (lambda (y) (let ((x (car y)) (c (cdr y))) - - (string-append - (string-join - (map object->string (list (object-address x) c x)) - " ") - "\n"))) - + (display + (format "~a (~a) = ~a\n" (object-address x) c x) + outfile))) (filter (lambda (x) (not (symbol? (car x)))) protects)) outfile) -; (display (ly:smob-protects)) + (format outfile "\nprotected symbols: ~a\n" + (length (filter symbol? (map car protects)))) + + + + ;; (display (ly:smob-protects)) (newline outfile) (if (defined? 'gc-live-object-stats) (let* ((stats #f)) (display "Live object statistics: GC'ing\n") + (ly:reset-all-fonts) (gc) (gc) (ly:set-option 'debug-gc-assert-parsed-dead #t) (gc) - + (ly:set-option 'debug-gc-assert-parsed-dead #f) + (set! stats (gc-live-object-stats)) (display "Dumping live object statistics.\n") @@ -403,11 +407,47 @@ The syntax is the same as `define*-public'." (format outfile "~a: ~a\n" (car x) (cdr x))) (sort (gc-live-object-stats) (lambda (x y) - (string count 0) + (let* + ((pid (primitive-fork))) + (if (= pid 0) + (1- count) + (helper (1- count) (cons pid acc)))) + acc)) + (helper count '())) + + (define-public (lilypond-main files) "Entry point for LilyPond." @@ -421,6 +461,64 @@ The syntax is the same as `define*-public'." (if (null? files) (no-files-handler)) + (if (ly:get-option 'read-file-list) + (set! files + (filter (lambda (s) + (> (string-length s) 0)) + (apply append + (map (lambda (f) (string-split (ly:gulp-file f) #\nl)) + files))) + )) + + (if (and (number? (ly:get-option 'job-count)) + (> (length files) (ly:get-option 'job-count))) + + (let* + ((count (ly:get-option 'job-count)) + (split-todo (split-list files count)) + (joblist (multi-fork count)) + (errors '())) + + (if (not (string-or-symbol? (ly:get-option 'log-file))) + (ly:set-option 'log-file "lilypond-multi-run")) + + (if (number? joblist) + (begin + (ly:set-option 'log-file (format "~a-~a" + (ly:get-option 'log-file) joblist)) + (set! files (vector-ref split-todo joblist))) + + (begin + (ly:progress "\nForking into jobs: ~a\n" joblist) + (for-each + (lambda (pid) + (let* ((stat (cdr (waitpid pid)))) + + (if (not (= stat 0)) + (set! errors (cons (list-element-index joblist pid) errors))))) + joblist) + + (for-each + (lambda (x) + (let* ((logfile (format "~a-~a.log" + (ly:get-option 'log-file) x)) + (log (ly:gulp-file logfile)) + (len (string-length log)) + (tail (substring log (max 0 (- len 1024))))) + + (display (format "\n\nlogfile ~a:\n\n ~a" logfile tail)))) + + errors) + + (if (pair? errors) + (ly:error "Children ~a exited with errors." errors)) + + (exit (if (null? errors) 0 1)))))) + + + (if (string-or-symbol? (ly:get-option 'log-file)) + (ly:stderr-redirect (format "~a.log" (ly:get-option 'log-file)) "w")) + (let ((failed (lilypond-all files))) (if (pair? failed) (begin @@ -432,14 +530,7 @@ The syntax is the same as `define*-public'." (exit 0))))) (define-public (lilypond-all files) - (if (ly:get-option 'read-file-list) - (set! files - (filter (lambda (s) - (> (string-length s) 0)) - (apply append - (map (lambda (f) (string-split (ly:gulp-file f) #\nl)) - files))) - )) + (if (ly:get-option 'show-available-fonts) (begin @@ -448,17 +539,25 @@ The syntax is the same as `define*-public'." )) (let* ((failed '()) + (first #t) (handler (lambda (key failed-file) (set! failed (append (list failed-file) failed))))) (for-each (lambda (x) - (ly:set-option 'debug-gc-assert-parsed-dead #f) + + ;; We don't carry info across file boundaries + (if first + (set! first #f) + (gc)) + (lilypond-file handler x) (ly:clear-anonymous-modules) (if (ly:get-option 'debug-gc) - (dump-gc-protects))) - + (dump-gc-protects) + (if (= (random 40) 1) + (ly:reset-all-fonts)))) + files) failed)) @@ -472,12 +571,14 @@ The syntax is the same as `define*-public'." (define-public (gui-main files) (if (null? files) (gui-no-files-handler)) - (let* ((base (basename (car files) ".ly")) - (log-name (string-append base ".log"))) - (if (not (ly:get-option 'gui)) - (ly:message (_ "Redirecting output to ~a...") log-name)) - (ly:stderr-redirect log-name "w") - (ly:message "# -*-compilation-*-") + + (if (not (string? (ly:get-option 'log-file))) + (let* ((base (basename (car files) ".ly")) + (log-name (string-append base ".log"))) + (if (not (ly:get-option 'gui)) + (ly:message (_ "Redirecting output to ~a...") log-name)) + (ly:stderr-redirect log-name "w") + (ly:message "# -*-compilation-*-")) (let ((failed (lilypond-all files))) (if (pair? failed)