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

[lilypond.git] / scm / lily.scm

diff --git a/scm/lily.scm b/scm/lily.scm
index 30d8e6b1aa8201c2a3a9a5db7d3a08c17b1c5115..32ab98e88e2a486b72c88d054380da72f3e9063b 100644 (file)
--- a/scm/lily.scm
+++ b/scm/lily.scm
@@ -26,6 +26,7 @@
              (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-signatures #f "dump output signatures of each system")
@@ -138,7 +139,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 (_ "Can't find ~A") x))
     (primitive-load file-name)
     (if (ly:get-option 'verbose)
        (ly:progress "]"))))
@@ -362,34 +363,37 @@ 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))
+    (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")
          
@@ -398,7 +402,29 @@ 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<? (car x) (car y)))))))))
+                  (string<? (car x) (car y)))))))
+
+
+    (newline outfile)
+    (let*
+       ((stats (gc-stats)))
+      
+      (for-each
+       (lambda (sym)
+        (display
+         (format "~a ~a ~a\n"
+                 gc-protect-stat-count
+                 sym
+                 (let ((sym-stat (assoc sym stats)))
+                   (if sym-stat 
+                       (cdr sym-stat)
+                       "?")))
+         outfile))
+       '(protected-objects bytes-malloced cell-heap-size
+                          
+                          )))
+    
+    ))
 
 ;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;
 
@@ -428,6 +454,15 @@ 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)))
       
@@ -447,6 +482,7 @@ The syntax is the same as `define*-public'."
              (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))))
@@ -461,7 +497,7 @@ The syntax is the same as `define*-public'."
                                          (ly:get-option 'log-file) x))
                        (log (ly:gulp-file logfile))
                        (len (string-length log))
-                       (tail (substring log (- len 1024))))
+                       (tail (substring  log (max 0 (- len 1024)))))
 
                   (display (format "\n\nlogfile ~a:\n\n ~a" logfile tail))))
 
@@ -487,14 +523,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
@@ -508,12 +537,13 @@ The syntax is the same as `define*-public'."
 
     (for-each
      (lambda (x)
-       (ly:set-option 'debug-gc-assert-parsed-dead #f)
        (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))