X-Git-Url: https://git.donarmstrong.com/?a=blobdiff_plain;f=scm%2Flily.scm;h=f455829be69924bc8456c847c1ea80a4e9487fe7;hb=c5a3f0c024f4cb629811cff9eb04abff36e94138;hp=c0e6fd911fa424cfa9bd0d90450d4286c3586573;hpb=711cf44d0ab28f3159230c84d63c0b19199408b0;p=lilypond.git

diff --git a/scm/lily.scm b/scm/lily.scm
index c0e6fd911f..f455829be6 100644
--- a/scm/lily.scm
+++ b/scm/lily.scm
@@ -14,74 +14,81 @@
 ;; Abbrv-PWR!
 (defmacro-public _i (x) x)
 
-(define (define-scheme-options)
-  (for-each (lambda (x)
-	      (ly:add-option (car x) (cadr x) (caddr x)))
-	  
-	    `(
+(read-enable 'positions)
+(debug-enable 'debug)
+
+
+
+(define scheme-options-definitions
+  `(
 
-	      ;; NAMING: either
+    ;; NAMING: either
 
-	      ;; - [subject-]object-object-verb +"ing"
-	      ;; - [subject-]-verb-object-object
+    ;; - [subject-]object-object-verb +"ing"
+    ;; - [subject-]-verb-object-object
 
-	      (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:
+    (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.  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.")
-	      (gs-load-fonts #f
-			    "load fonts via Ghostscript.")
-	      (gui #f "running from gui; redirect stderr to log file")
-
-	      (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") 
-	      (log-file #f "redirect output to log FILE.log")
-
-	      (old-relative #f
-			    "relative for simultaneous music works
+    (debug-lexer #f "debug the flex lexer")
+    (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-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.")
+    (gs-load-fonts #f
+		   "load fonts via Ghostscript.")
+    (gui #f "running from gui; redirect stderr to log file")
+    (help #f "show this help.") 
+    (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") 
+    (log-file #f "redirect output to log FILE.log")
+
+    (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")
-	      (protected-scheme-parsing #t "continue when finding errors in inline
+    (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 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.")
-	      (separate-log-files #f "Output to FILE.log per file.")
-	      (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")
-	      )))
-
+    (profile-property-accesses #f "keep statistics of get_property() calls.")
+    
+    (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.")
+    (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")
+    ))
 
 ;; need to do this in the beginning. Other parts of the
 ;; Scheme init depend on these options.
 ;;
-(define-scheme-options)
+(for-each
+ (lambda (x)
+   (ly:add-option (car x) (cadr x) (caddr x)))
+ scheme-options-definitions)
+
+(for-each
+ (lambda (x)
+   (ly:set-option (car x) (cdr x)))
+ (eval-string (ly:command-line-options)))
 
 (debug-set! stack 0)
 
@@ -92,12 +99,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 +122,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 +285,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 +335,9 @@ 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 +409,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 +466,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 +488,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 +538,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))
 
@@ -528,25 +583,32 @@ 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)
@@ -557,20 +619,30 @@ 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:show-all (lambda (f) (string-contains f "lilypond"))
+			     )))
+	  
+    
     (if (pair? failed)
 	(begin
 	  (ly:error (_ "failed files: ~S") (string-join failed))
 	  (exit 1))
 	(begin
+	  (ly:do-atexit)
 	  ;; HACK: be sure to exit with single newline
 	  (ly:message "")
 	  (exit 0)))))
 
 (define-public (lilypond-all files)
-
-
+  (if (ly:get-option 'help)
+      (begin
+	(ly:option-usage)
+	(exit 0)))
   (if (ly:get-option 'show-available-fonts)
       (begin
 	(ly:font-config-display-fonts)
@@ -583,30 +655,41 @@ The syntax is the same as `define*-public'."
 	 (handler (lambda (key failed-file)
 		    (set! failed (append (list failed-file) failed)))))
 
+    (gc)
     (for-each
      (lambda (x)
        (let*
 	   ((start-measurements (if do-measurements
-				    (begin
-				      (gc)
-				      (profile-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)
@@ -623,7 +706,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)