+
+
+;; debug mem leaks
+
+(define gc-protect-stat-count 0)
+(define-public (dump-gc-protects)
+ (set! gc-protect-stat-count (1+ gc-protect-stat-count) )
+ (let*
+ ((protects (sort
+ (hash-table->alist (ly:protects))
+ (lambda (a b)
+ (< (object-address (car a))
+ (object-address (car b))))))
+ (outfile (open-file (string-append
+ "gcstat-" (number->string gc-protect-stat-count)
+ ".scm"
+ ) "w")))
+
+ (display "DUMPING...\n")
+ (display
+ (filter
+ (lambda (x) (not (symbol? x)))
+ (map (lambda (y)
+ (let
+ ((x (car y))
+ (c (cdr y)))
+
+ (string-append
+ (string-join
+ (map object->string (list (object-address x) c x))
+ " ")
+ "\n")))
+ protects))
+ outfile)))
+
+
+;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;
+
+(define-public (postscript->pdf papersize name)
+ (let* ((cmd (string-append "ps2pdf -sPAPERSIZE=" papersize " " name))
+ (output-name
+ (regexp-substitute/global #f "\\.ps" name 'pre ".pdf" 'post)))
+
+ (newline (current-error-port))
+ (display (format (_ "Converting to `~a'...") output-name)
+ (current-error-port))
+ (newline (current-error-port))
+
+ (if (ly:get-option 'verbose)
+ (display (format "Invoking `~a'..." cmd) (current-error-port)))
+
+ (system cmd)))
+
+(define-public (postscript->png resolution name)
+ (let
+ ((cmd (string-append
+ "ps2png --resolution="
+ (if (number? resolution)
+ (number->string resolution)
+ "90")
+ (if (ly:get-option 'verbose)
+ "--verbose "
+ " ")
+ name)))
+ (if (ly:get-option 'verbose)
+ (begin
+ (display (format (_ "Invoking `~a'...") cmd) (current-error-port))
+ (newline (current-error-port))))
+ (system cmd)))
+
+(define-public (lilypond-main files)
+ "Entry point for LilyPond."
+ (let* ((failed '())
+ (handler (lambda (key arg) (set! failed (cons arg failed)))))
+ (for-each
+ (lambda (f)
+ (catch 'ly-file-failed (lambda () (ly:parse-file f)) handler)
+;;; (dump-gc-protects)
+ )
+ files)
+
+ (if (pair? failed)
+ (begin
+ (newline (current-error-port))
+ (display (_ "error: failed files: ") (current-error-port))
+ (display (string-join failed) (current-error-port))
+ (newline (current-error-port))
+ (newline (current-error-port))
+ (exit 1))
+ (exit 0))))