X-Git-Url: https://git.donarmstrong.com/?a=blobdiff_plain;f=scm%2Flily.scm;h=a0940d9be99ccaa37db7a749bd575d75d8e02bfb;hb=7c05d44fd79e07fd35a1bea9d1af7cc15a435647;hp=bd6a95be446af7e8eca09ce7d145dad1d7465261;hpb=ba3045ce76cd37a4e11fd775fa04ce4b7586ad77;p=lilypond.git diff --git a/scm/lily.scm b/scm/lily.scm index bd6a95be44..a0940d9be9 100644 --- a/scm/lily.scm +++ b/scm/lily.scm @@ -5,6 +5,18 @@ ;;;; (c) 1998--2006 Jan Nieuwenhuizen ;;;; Han-Wen Nienhuys +;; Internationalisation: (_i "to be translated") gets an entry in the +;; POT file (gettext ) must be invoked explicitely to do the actual +;; "translation". +;;(define-macro (_i x) x) +;;(define-macro-public _i (x) x) +;;(define-public-macro _i (x) x) +;; Abbrv-PWR! +(defmacro-public _i (x) x) + +(read-enable 'positions) +(debug-enable 'debug) + (define (define-scheme-options) (for-each (lambda (x) @@ -24,17 +36,14 @@ (debug-gc-assert-parsed-dead #f "for memory debugging: ensure that all refs to parsed objects are dead. This is an internal option, and is switched on automatically for -ddebug-gc.") (debug-lexer #f "debug the flex lexer") - (debug-midi #f "generate human readable MIDI") (debug-parser #f "debug the bison parser") (debug-skylines #f "debug skylines") (delete-intermediate-files #f "delete unusable PostScript files") (dump-profile #f "dump timing information for each file") - (dump-tweaks #f "dump page layout and tweaks for each score having the tweak-key layout property set.") - (dump-signatures #f "dump output signatures of each system") + (dump-signatures #f "dump output signatures of each system. Used for regression testing.") - (eps-box-padding #f "Pad EPS bounding box left edge by this much to guarantee alignment between systems") - + (eps-box-padding #f "Pad EPS bounding box left edge. Guarantee alignment between systems in LaTeX.") (gs-load-fonts #f "load fonts via Ghostscript.") (gui #f "running from gui; redirect stderr to log file") @@ -47,8 +56,6 @@ ensure that all refs to parsed objects are dead. This is an internal option, an (old-relative #f "relative for simultaneous music works similar to chord syntax") - (object-keys #f - "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") @@ -61,16 +68,20 @@ on errors, and print a stack trace.") (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") - + (strict-infinity-checking #f "If yes, crash on encountering Inf/NaN.") + (separate-log-files #f "Output to FILE.log per file.") + (trace-memory-frequency #f "Record Scheme cell usage this many times per second, and dump to file.") (ttf-verbosity 0 "how much verbosity for TTF font embedding?") - (show-available-fonts #f - "List font names available.") - + "List font names available.") (verbose ,(ly:command-line-verbose?) "value for the --verbose flag") - ))) + )) + + (map + (lambda (x) + (ly:set-option (car x) (cdr x))) + (eval-string (ly:command-line-options)))) ;; need to do this in the beginning. Other parts of the @@ -78,6 +89,8 @@ on errors, and print a stack trace.") ;; (define-scheme-options) + + (debug-set! stack 0) (if (defined? 'set-debug-cell-accesses!) @@ -87,18 +100,19 @@ on errors, and print a stack trace.") (use-modules (ice-9 regex) (ice-9 safe) + (ice-9 rdelim) (ice-9 optargs) (oop goops) (srfi srfi-1) (srfi srfi-13) (srfi srfi-14) (scm clip-region) - + (scm memory-trace) ) - ;; my display -(define-public (myd k v) (display k) (display ": ") (display v) (display ", ")) +(define-public (myd k v) (display k) (display ": ") (display v) (display ", ") + v) (define-public (print . args) (apply format (cons (current-output-port) args))) @@ -264,9 +278,10 @@ The syntax is the same as `define*-public'." ;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;; ;; other files. -(for-each ly:load - ;; load-from-path - '("lily-library.scm" + +(define + init-scheme-files + '("lily-library.scm" "file-cache.scm" "define-event-classes.scm" "define-music-types.scm" @@ -313,6 +328,11 @@ The syntax is the same as `define*-public'." "safe-lily.scm")) + + +(for-each ly:load init-scheme-files) + + (set! type-p-name-alist `( (,boolean-or-symbol? . "boolean or symbol") @@ -357,26 +377,26 @@ The syntax is the same as `define*-public'." (define (profile-measurements) (let* ((t (times)) (stats (gc-stats))) - + (list - (- (+ (tms:utime t) - (tms:stime t)) + (- (+ (tms:cutime t) + (tms:utime t)) (ly:assoc-get 'gc-time-taken stats)) - - ;; difficult to put memory amount stats into here. + (ly:assoc-get 'total-cells-allocated stats 0) ))) -(define (dump-profile name last this) +(define (dump-profile base last this) (let* - ((outname (format "~a.profile" (basename name ".ly"))) + ((outname (format "~a.profile" (basename base ".ly"))) (diff (map (lambda (y) (apply - y)) (zip this last)))) - (display diff) (ly:progress "\nWriting timing to ~a..." outname) (format (open-file outname "w") - "time: ~a" - (car diff)))) + "time: ~a\ncells: ~a\n" + (car diff) + (cadr diff) + ))) ;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;; @@ -384,6 +404,15 @@ The syntax is the same as `define*-public'." (define gc-dumping #f) (define gc-protect-stat-count 0) + +(define-public (dump-live-object-stats outfile) + (for-each + (lambda (x) + (format outfile "~a: ~a\n" (car x) (cdr x))) + (sort (gc-live-object-stats) + (lambda (x y) + (stringnumber (match:substring (car interesting) 1))) + ) + + + (display (format "VMDATA: ~a\n" mem)) + (display (gc-stats)) + (if (> mem 100000) + (begin + (dump-gc-protects) + (raise 1))) )) @@ -481,11 +533,13 @@ The syntax is the same as `define*-public'." (define-public (lilypond-main files) "Entry point for LilyPond." - + (define (no-files-handler) (ly:usage) (exit 2)) + (eval-string (ly:command-line-code)) + (if (ly:get-option 'gui) (gui-main files)) @@ -502,7 +556,7 @@ The syntax is the same as `define*-public'." )) (if (and (number? (ly:get-option 'job-count)) - (> (length files) (ly:get-option 'job-count))) + (>= (length files) (ly:get-option 'job-count))) (let* ((count (ly:get-option 'job-count)) @@ -524,31 +578,43 @@ The syntax is the same as `define*-public'." (for-each (lambda (pid) (let* ((stat (cdr (waitpid pid)))) - + (if (not (= stat 0)) - (set! errors (cons (list-element-index joblist pid) errors))))) + (set! errors (acons (list-element-index joblist pid) stat errors))))) joblist) (for-each (lambda (x) - (let* ((logfile (format "~a-~a.log" - (ly:get-option 'log-file) x)) + (let* ((job (car x)) + (state (cdr x)) + (logfile (format "~a-~a.log" + (ly:get-option 'log-file) job)) (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)))) + (if (status:term-sig state) + (ly:message "\n\n~a\n" + (format (_ "job ~a terminated with signal: ~a") + job + (status:term-sig state))) + (ly:message (_ "logfile ~a (exit ~a):\n~a") logfile (status:exit-val state) tail)))) errors) (if (pair? errors) - (ly:error "Children ~a exited with errors." errors)) + (ly:error "Children ~a exited with errors." (map car errors))) + + ;; must overwrite individual entries + (if (ly:get-option 'dump-profile) + (dump-profile "lily-run-total" '(0 0) (profile-measurements))) (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) @@ -561,7 +627,7 @@ The syntax is the same as `define*-public'." (exit 0))))) (define-public (lilypond-all files) - + (if (ly:get-option 'show-available-fonts) (begin @@ -570,27 +636,63 @@ The syntax is the same as `define*-public'." )) (let* ((failed '()) - (start-measurements #f) + (separate-logs (ly:get-option 'separate-log-files)) + (do-measurements (ly:get-option 'dump-profile)) (handler (lambda (key failed-file) (set! failed (append (list failed-file) failed))))) + (gc) (for-each (lambda (x) - - (gc) - (set! start-measurements (profile-measurements)) - (lilypond-file handler x) - (if (ly:get-option 'dump-profile) - (dump-profile x start-measurements (profile-measurements))) - - - (ly:clear-anonymous-modules) - (if (ly:get-option 'debug-gc) - (dump-gc-protects) - (if (= (random 40) 1) - (ly:reset-all-fonts)))) + (let* + ((start-measurements (if do-measurements + (profile-measurements) + #f)) + (base (basename x ".ly")) + (all-settings (ly:all-options))) + + (if separate-logs + (ly:stderr-redirect (format "~a.log" base) "w")) + (if (ly:get-option 'trace-memory-frequency) + (mtrace:start-trace (ly:get-option 'trace-memory-frequency))) + + (lilypond-file handler x) + (if start-measurements + (dump-profile x start-measurements (profile-measurements))) + + (if (ly:get-option 'trace-memory-frequency) + (begin + (mtrace:stop-trace) + (mtrace:dump-results base))) + + (for-each + (lambda (s) + (ly:set-option (car s) (cdr s))) + all-settings) + + (ly:clear-anonymous-modules) + (ly:set-option 'debug-gc-assert-parsed-dead #t) + (gc) + (ly:set-option 'debug-gc-assert-parsed-dead #f) + + + (if (ly:get-option 'debug-gc) + (dump-gc-protects) + (if (= (random 40) 1) + (ly:reset-all-fonts))))) files) + + ;; we want the failed-files notice in the aggregrate logfile. + (if (ly:get-option 'separate-logs) + (ly:stderr-redirect + (if (string-or-symbol? (ly:get-option 'log-file)) + (format "~a.log" (ly:get-option 'log-file)) + "/dev/tty") "a")) + + (if (ly:get-option 'dump-profile) + (dump-profile "lily-run-total" '(0 0) (profile-measurements))) + failed)) (define (lilypond-file handler file-name)