X-Git-Url: https://git.donarmstrong.com/?a=blobdiff_plain;f=scm%2Flily.scm;h=183b71e4902b1f46d9ec2ddd68a81fc2e2343f20;hb=bc01e841f1a486ec8bf55010af3f987a7df5caad;hp=5daa01c53d6225a81b44ccc5a09c16e4f410fd98;hpb=bc106da1e5f1a29dbbd2092aaca1f8b681066d86;p=lilypond.git

diff --git a/scm/lily.scm b/scm/lily.scm
index 5daa01c53d..183b71e490 100644
--- a/scm/lily.scm
+++ b/scm/lily.scm
@@ -14,6 +14,10 @@
 ;; Abbrv-PWR!
 (defmacro-public _i (x) x)
 
+(read-enable 'positions)
+(debug-enable 'debug)
+
+
 (define (define-scheme-options)
   (for-each (lambda (x)
 	      (ly:add-option (car x) (cadr x) (caddr x)))
@@ -32,13 +36,11 @@
 	      (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.  Used for regression testing.")
 	      
 	      (eps-box-padding #f "Pad EPS bounding box left edge.  Guarantee alignment between systems in LaTeX.")
@@ -54,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")
@@ -70,12 +70,19 @@ on errors, and print a stack trace.")
 	      (safe #f "Run safely")
 	      (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.")
+	      (trace-scheme-coverage #f "Record coverage of Scheme files") 
 	      (ttf-verbosity 0
 			     "how much verbosity for TTF font embedding?")
 	      (show-available-fonts #f
 				    "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
@@ -83,6 +90,8 @@ on errors, and print a stack trace.")
 ;;
 (define-scheme-options)
 
+
+
 (debug-set! stack 0)
 
 (if (defined? 'set-debug-cell-accesses!)
@@ -92,12 +101,15 @@ 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)
+	     (scm coverage)
 	     )
 
 ;; my display
@@ -112,13 +124,20 @@ on errors, and print a stack trace.")
 ;;; debugging evaluator is slower.  This should
 ;;; have a more sensible default.
 
-(if (ly:get-option 'verbose)
+(if (or (ly:get-option 'verbose)
+	(ly:get-option 'trace-memory-frequencency)
+	(ly:get-option 'trace-scheme-coverage)
+	)
     (begin
       (ly:set-option 'protected-scheme-parsing #f)
       (debug-enable 'debug)
       (debug-enable 'backtrace)
       (read-enable 'positions)))
 
+
+(if (ly:get-option 'trace-scheme-coverage)
+    (coverage:enable))
+
 (define-public tex-backend?
   (member (ly:output-backend) '("texstr" "tex")))
 
@@ -268,9 +287,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"
@@ -317,6 +337,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")
@@ -388,6 +413,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)
+	   (string<? (car x) (car y))))))
+
 (define-public (dump-gc-protects)
   (set! gc-protect-stat-count (1+ gc-protect-stat-count))
   (let* ((protects (sort
@@ -436,14 +470,7 @@ The syntax is the same as `define*-public'."
 
 	  (set! stats (gc-live-object-stats))
 	  (display "Dumping live object statistics.\n")
-	  
-	  (for-each
-	   (lambda (x)
-	     (format outfile "~a: ~a\n" (car x) (cdr x)))
-	   (sort (gc-live-object-stats)
-		 (lambda (x y)
-		   (string<? (car x) (car y)))))))
-
+	  (dump-live-object-stats outfile)))
 
     (newline outfile)
     (let*
@@ -465,6 +492,36 @@ The syntax is the same as `define*-public'."
 			   )))
 
     (set! gc-dumping #f)
+    (close-port outfile)
+    
+    ))
+
+
+(define (check-memory)
+  "read /proc/self to check up on memory use." 
+  (define (gulp-file name)
+    (let* ((file (open-input-file name))
+	   (text (read-delimited "" file)))
+      (close file)
+      text))
+  (let*
+      ((stat (gulp-file "/proc/self/status"))
+       (lines (string-split stat #\newline))
+       (interesting (filter identity
+			    (map
+			     (lambda (l)
+			       (string-match "^VmData:[ \t]*([0-9]*) kB" l))
+			     lines)))
+       (mem (string->number (match:substring (car interesting) 1)))
+       )
+
+    
+    (display (format  "VMDATA: ~a\n" mem))
+    (display (gc-stats))
+    (if (> mem 100000)
+	(begin
+	  (dump-gc-protects)
+	  (raise 1)))
     
     ))
 
@@ -485,11 +542,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))
 
@@ -564,8 +623,16 @@ The syntax is the same as `define*-public'."
 	   
   (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 (ly:get-option 'trace-scheme-coverage)
+	(begin
+	  (coverage:disable)
+	  (coverage:show-all (lambda (f) (string-contains f "lilypond"))
+			     )))
+	  
+    
     (if (pair? failed)
 	(begin
 	  (ly:error (_ "failed files: ~S") (string-join failed))
@@ -576,7 +643,7 @@ The syntax is the same as `define*-public'."
 	  (exit 0)))))
 
 (define-public (lilypond-all files)
-
+  
 
   (if (ly:get-option 'show-available-fonts)
       (begin
@@ -602,21 +669,28 @@ The syntax is the same as `define*-public'."
 
 	 (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)
@@ -634,7 +708,7 @@ The syntax is the same as `define*-public'."
 
     (if (ly:get-option 'dump-profile)
 	(dump-profile "lily-run-total" '(0 0) (profile-measurements)))
-    
+
     failed))
 
 (define (lilypond-file handler file-name)