Merge branch 'master' of ssh+git://hanwen@git.sv.gnu.org/srv/git/lilypond

[lilypond.git] / scm / lily.scm

diff --git a/scm/lily.scm b/scm/lily.scm
index a403861990399ad17a94141c5b3a73ea910fd7ff..798df7ece4bb69200f701d6875e244428c7a49da 100644 (file)
--- a/scm/lily.scm
+++ b/scm/lily.scm
@@ -5,6 +5,14 @@
 ;;;; (c) 1998--2006 Jan Nieuwenhuizen <janneke@gnu.org>
 ;;;; Han-Wen Nienhuys <hanwen@xs4all.nl>
 
+;; 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)
 
 (define (define-scheme-options)
   (for-each (lambda (x)
@@ -29,8 +37,9 @@ ensure that all refs to parsed objects are dead.  This is an internal option, an
              (debug-skylines #f "debug skylines")
              (delete-intermediate-files #f
                                         "delete unusable PostScript files")
-             (dump-signatures #f "dump output signatures of each system")
+             (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")
              
              (eps-box-padding #f "Pad EPS bounding box left edge by this much to guarantee alignment between systems")
 
@@ -350,6 +359,34 @@ The syntax is the same as `define*-public'."
        (,symbol? . "symbol")
        (,vector? . "vector")))
 
+;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;
+;; timing
+
+(define (profile-measurements)
+  (let* ((t (times))
+        (stats (gc-stats)))
+    
+    (list
+     (- (tms:utime t)
+       (ly:assoc-get 'gc-time-taken stats))
+
+     (ly:assoc-get 'total-cells-allocated  stats 0)
+     ;; difficult to put memory amount stats into here.
+     
+     )))
+
+(define (dump-profile name last this)
+  (let*
+      ((outname (format "~a.profile" (basename name ".ly")))
+       (diff (map (lambda (y) (apply - y)) (zip this last))))
+    
+    (ly:progress "\nWriting timing to ~a..." outname)
+    (format (open-file outname "w")
+           "time: ~a\ncells: ~a\n"
+           (car diff)
+           (cadr diff)
+           )))
+
 
 ;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;
 ;; debug mem leaks
@@ -542,19 +579,21 @@ The syntax is the same as `define*-public'."
        ))
   
   (let* ((failed '())
-        (first #t)
+        (start-measurements (ly:get-option 'dump-profile))
         (handler (lambda (key failed-file)
                    (set! failed (append (list failed-file) failed)))))
 
     (for-each
      (lambda (x)
 
-       ;; We don't carry info across file boundaries
-       (if first
-          (set! first #f)
-          (gc))
-       
+       (gc)
+       (if start-measurements
+          (set! start-measurements (profile-measurements)))
        (lilypond-file handler x)
+       (if start-measurements
+          (dump-profile x start-measurements (profile-measurements)))
+       
+       
        (ly:clear-anonymous-modules)
        (if (ly:get-option 'debug-gc)
           (dump-gc-protects)