LEFT | RIGHT |
1 ;;;; This file is part of LilyPond, the GNU music typesetter. | 1 ;;;; This file is part of LilyPond, the GNU music typesetter. |
2 ;;;; | 2 ;;;; |
3 ;;;; Copyright (C) 1998--2011 Jan Nieuwenhuizen <janneke@gnu.org> | 3 ;;;; Copyright (C) 1998--2011 Jan Nieuwenhuizen <janneke@gnu.org> |
4 ;;;; Han-Wen Nienhuys <hanwen@xs4all.nl> | 4 ;;;; Han-Wen Nienhuys <hanwen@xs4all.nl> |
5 ;;;; | 5 ;;;; |
6 ;;;; LilyPond is free software: you can redistribute it and/or modify | 6 ;;;; LilyPond is free software: you can redistribute it and/or modify |
7 ;;;; it under the terms of the GNU General Public License as published by | 7 ;;;; it under the terms of the GNU General Public License as published by |
8 ;;;; the Free Software Foundation, either version 3 of the License, or | 8 ;;;; the Free Software Foundation, either version 3 of the License, or |
9 ;;;; (at your option) any later version. | 9 ;;;; (at your option) any later version. |
10 ;;;; | 10 ;;;; |
(...skipping 568 matching lines...) Expand 10 before | Expand all | Expand 10 after Loading... |
579 | 579 |
580 (define (profile-measurements) | 580 (define (profile-measurements) |
581 (let* ((t (times)) | 581 (let* ((t (times)) |
582 (stats (gc-stats))) | 582 (stats (gc-stats))) |
583 (list (- (+ (tms:cutime t) | 583 (list (- (+ (tms:cutime t) |
584 (tms:utime t)) | 584 (tms:utime t)) |
585 (assoc-get 'gc-time-taken stats)) | 585 (assoc-get 'gc-time-taken stats)) |
586 (assoc-get 'total-cells-allocated stats 0)))) | 586 (assoc-get 'total-cells-allocated stats 0)))) |
587 | 587 |
588 (define (dump-profile base last this) | 588 (define (dump-profile base last this) |
589 (let* ((outname (format "~a.profile" (dir-basename base ".ly"))) | 589 (let* ((outname (format #f "~a.profile" (dir-basename base ".ly"))) |
590 (diff (map (lambda (y) (apply - y)) (zip this last)))) | 590 (diff (map (lambda (y) (apply - y)) (zip this last)))) |
591 (ly:progress "\nWriting timing to ~a..." outname) | 591 (ly:progress "\nWriting timing to ~a..." outname) |
592 (format (open-file outname "w") | 592 (format (open-file outname "w") |
593 "time: ~a\ncells: ~a\n" | 593 "time: ~a\ncells: ~a\n" |
594 (if (ly:get-option 'dump-cpu-profile) | 594 (if (ly:get-option 'dump-cpu-profile) |
595 (car diff) | 595 (car diff) |
596 0) | 596 0) |
597 (cadr diff)))) | 597 (cadr diff)))) |
598 | 598 |
599 ;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;; | 599 ;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;; |
(...skipping 16 matching lines...) Expand all Loading... |
616 (set! gc-protect-stat-count (1+ gc-protect-stat-count)) | 616 (set! gc-protect-stat-count (1+ gc-protect-stat-count)) |
617 (let* ((protects (sort (hash-table->alist (ly:protects)) | 617 (let* ((protects (sort (hash-table->alist (ly:protects)) |
618 (lambda (a b) | 618 (lambda (a b) |
619 (< (object-address (car a)) | 619 (< (object-address (car a)) |
620 (object-address (car b)))))) | 620 (object-address (car b)))))) |
621 (out-file-name (string-append | 621 (out-file-name (string-append |
622 "gcstat-" (number->string gc-protect-stat-count) | 622 "gcstat-" (number->string gc-protect-stat-count) |
623 ".scm")) | 623 ".scm")) |
624 (outfile (open-file out-file-name "w"))) | 624 (outfile (open-file out-file-name "w"))) |
625 (set! gc-dumping #t) | 625 (set! gc-dumping #t) |
626 (display (format "Dumping GC statistics ~a...\n" out-file-name)) | 626 (format #t "Dumping GC statistics ~a...\n" out-file-name) |
627 (display (map (lambda (y) | 627 (for-each (lambda (y) |
628 » » (let ((x (car y)) | 628 » » (let ((x (car y)) |
629 » » » (c (cdr y))) | 629 » » (c (cdr y))) |
630 » » (display | 630 » » (format outfile "~a (~a) = ~a\n" (object-address x) c x))) |
631 » » (format "~a (~a) = ~a\n" (object-address x) c x) | 631 » (filter |
632 » » outfile))) | 632 » (lambda (x) |
633 » » (filter | 633 » » (not (symbol? (car x)))) |
634 » » (lambda (x) | 634 » protects)) |
635 » » (not (symbol? (car x)))) | |
636 » » protects)) | |
637 » outfile) | |
638 (format outfile "\nprotected symbols: ~a\n" | 635 (format outfile "\nprotected symbols: ~a\n" |
639 (apply + (map (lambda (obj-count) | 636 (apply + (map (lambda (obj-count) |
640 (if (symbol? (car obj-count)) | 637 (if (symbol? (car obj-count)) |
641 (cdr obj-count) | 638 (cdr obj-count) |
642 0)) | 639 0)) |
643 protects))) | 640 protects))) |
644 | 641 |
645 ;; (display (ly:smob-protects)) | 642 ;; (display (ly:smob-protects)) |
646 (newline outfile) | 643 (newline outfile) |
647 (if (defined? 'gc-live-object-stats) | 644 (if (defined? 'gc-live-object-stats) |
648 (let* ((stats #f)) | 645 (let* ((stats #f)) |
649 (display "Live object statistics: GC'ing\n") | 646 (display "Live object statistics: GC'ing\n") |
650 (ly:reset-all-fonts) | 647 (ly:reset-all-fonts) |
651 (gc) | 648 (gc) |
652 (gc) | 649 (gc) |
653 (display "Asserting dead objects\n") | 650 (display "Asserting dead objects\n") |
654 (ly:set-option 'debug-gc-assert-parsed-dead #t) | 651 (ly:set-option 'debug-gc-assert-parsed-dead #t) |
655 (gc) | 652 (gc) |
656 (ly:set-option 'debug-gc-assert-parsed-dead #f) | 653 (ly:set-option 'debug-gc-assert-parsed-dead #f) |
657 (set! stats (gc-live-object-stats)) | 654 (set! stats (gc-live-object-stats)) |
658 (display "Dumping live object statistics.\n") | 655 (display "Dumping live object statistics.\n") |
659 (dump-live-object-stats outfile))) | 656 (dump-live-object-stats outfile))) |
660 (newline outfile) | 657 (newline outfile) |
661 (let* ((stats (gc-stats))) | 658 (let* ((stats (gc-stats))) |
662 (for-each (lambda (sym) | 659 (for-each (lambda (sym) |
663 » » (display | 660 » » (format outfile "~a ~a ~a\n" |
664 » » (format "~a ~a ~a\n" | 661 » » » gc-protect-stat-count |
665 » » » gc-protect-stat-count | 662 » » » sym |
666 » » » sym | 663 » » » (assoc-get sym stats "?"))) |
667 » » » (assoc-get sym stats "?")) | |
668 | |
669 » » outfile)) | |
670 '(protected-objects bytes-malloced cell-heap-size))) | 664 '(protected-objects bytes-malloced cell-heap-size))) |
671 (set! gc-dumping #f) | 665 (set! gc-dumping #f) |
672 (close-port outfile))) | 666 (close-port outfile))) |
673 | 667 |
674 (define (check-memory) | 668 (define (check-memory) |
675 "Read `/proc/self' to check up on memory use." | 669 "Read `/proc/self' to check up on memory use." |
676 (define (gulp-file name) | 670 (define (gulp-file name) |
677 (let* ((file (open-input-file name)) | 671 (let* ((file (open-input-file name)) |
678 (text (read-delimited "" file))) | 672 (text (read-delimited "" file))) |
679 (close file) | 673 (close file) |
680 text)) | 674 text)) |
681 | 675 |
682 (let* ((stat (gulp-file "/proc/self/status")) | 676 (let* ((stat (gulp-file "/proc/self/status")) |
683 (lines (string-split stat #\newline)) | 677 (lines (string-split stat #\newline)) |
684 (interesting (filter identity | 678 (interesting (filter identity |
685 (map | 679 (map |
686 (lambda (l) | 680 (lambda (l) |
687 (string-match "^VmData:[ \t]*([0-9]*) kB" l)) | 681 (string-match "^VmData:[ \t]*([0-9]*) kB" l)) |
688 lines))) | 682 lines))) |
689 (mem (string->number (match:substring (car interesting) 1)))) | 683 (mem (string->number (match:substring (car interesting) 1)))) |
690 (display (format "VMDATA: ~a\n" mem)) | 684 (format #t "VMDATA: ~a\n" mem) |
691 (display (gc-stats)) | 685 (display (gc-stats)) |
692 (if (> mem 100000) | 686 (if (> mem 100000) |
693 (begin (dump-gc-protects) | 687 (begin (dump-gc-protects) |
694 (raise 1))))) | 688 (raise 1))))) |
695 | 689 |
696 ;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;; | 690 ;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;; |
697 | 691 |
698 (define (multi-fork count) | 692 (define (multi-fork count) |
699 "Split this process into COUNT helpers. Returns either a list of | 693 "Split this process into COUNT helpers. Returns either a list of |
700 PIDs or the number of the process." | 694 PIDs or the number of the process." |
(...skipping 45 matching lines...) Expand 10 before | Expand all | Expand 10 after Loading... |
746 (if (and (number? (ly:get-option 'job-count)) | 740 (if (and (number? (ly:get-option 'job-count)) |
747 (>= (length files) (ly:get-option 'job-count))) | 741 (>= (length files) (ly:get-option 'job-count))) |
748 (let* ((count (ly:get-option 'job-count)) | 742 (let* ((count (ly:get-option 'job-count)) |
749 (split-todo (split-list files count)) | 743 (split-todo (split-list files count)) |
750 (joblist (multi-fork count)) | 744 (joblist (multi-fork count)) |
751 (errors '())) | 745 (errors '())) |
752 (if (not (string-or-symbol? (ly:get-option 'log-file))) | 746 (if (not (string-or-symbol? (ly:get-option 'log-file))) |
753 (ly:set-option 'log-file "lilypond-multi-run")) | 747 (ly:set-option 'log-file "lilypond-multi-run")) |
754 (if (number? joblist) | 748 (if (number? joblist) |
755 (begin (ly:set-option | 749 (begin (ly:set-option |
756 » » 'log-file (format "~a-~a" | 750 » » 'log-file (format #f "~a-~a" |
757 (ly:get-option 'log-file) joblist)) | 751 (ly:get-option 'log-file) joblist)) |
758 (set! files (vector-ref split-todo joblist))) | 752 (set! files (vector-ref split-todo joblist))) |
759 (begin (ly:progress "\nForking into jobs: ~a\n" joblist) | 753 (begin (ly:progress "\nForking into jobs: ~a\n" joblist) |
760 (for-each | 754 (for-each |
761 (lambda (pid) | 755 (lambda (pid) |
762 (let* ((stat (cdr (waitpid pid)))) | 756 (let* ((stat (cdr (waitpid pid)))) |
763 (if (not (= stat 0)) | 757 (if (not (= stat 0)) |
764 (set! errors | 758 (set! errors |
765 (acons (list-element-index joblist pid) | 759 (acons (list-element-index joblist pid) |
766 stat errors))))) | 760 stat errors))))) |
767 joblist) | 761 joblist) |
768 (for-each | 762 (for-each |
769 (lambda (x) | 763 (lambda (x) |
770 (let* ((job (car x)) | 764 (let* ((job (car x)) |
771 (state (cdr x)) | 765 (state (cdr x)) |
772 » » » (logfile (format "~a-~a.log" | 766 » » » (logfile (format #f "~a-~a.log" |
773 (ly:get-option 'log-file) job)) | 767 (ly:get-option 'log-file) job)) |
774 (log (ly:gulp-file logfile)) | 768 (log (ly:gulp-file logfile)) |
775 (len (string-length log)) | 769 (len (string-length log)) |
776 (tail (substring log (max 0 (- len 1024))))) | 770 (tail (substring log (max 0 (- len 1024))))) |
777 (if (status:term-sig state) | 771 (if (status:term-sig state) |
778 (ly:message | 772 (ly:message |
779 "\n\n~a\n" | 773 "\n\n~a\n" |
780 » » » (format (_ "job ~a terminated with signal: ~a") | 774 » » » (format #f (_ "job ~a terminated with signal: ~a") |
781 job (status:term-sig state))) | 775 job (status:term-sig state))) |
782 (ly:message | 776 (ly:message |
783 (_ "logfile ~a (exit ~a):\n~a") | 777 (_ "logfile ~a (exit ~a):\n~a") |
784 logfile (status:exit-val state) tail)))) | 778 logfile (status:exit-val state) tail)))) |
785 errors) | 779 errors) |
786 (if (pair? errors) | 780 (if (pair? errors) |
787 (ly:error "Children ~a exited with errors." | 781 (ly:error "Children ~a exited with errors." |
788 (map car errors))) | 782 (map car errors))) |
789 ;; must overwrite individual entries | 783 ;; must overwrite individual entries |
790 (if (ly:get-option 'dump-profile) | 784 (if (ly:get-option 'dump-profile) |
791 (dump-profile "lily-run-total" | 785 (dump-profile "lily-run-total" |
792 '(0 0) (profile-measurements))) | 786 '(0 0) (profile-measurements))) |
793 (if (null? errors) | 787 (if (null? errors) |
794 (ly:exit 0 #f) | 788 (ly:exit 0 #f) |
795 (ly:exit 1 #f)))))) | 789 (ly:exit 1 #f)))))) |
796 | 790 |
797 (if (string-or-symbol? (ly:get-option 'log-file)) | 791 (if (string-or-symbol? (ly:get-option 'log-file)) |
798 (ly:stderr-redirect (format "~a.log" (ly:get-option 'log-file)) "w")) | 792 (ly:stderr-redirect (format #f "~a.log" (ly:get-option 'log-file)) "w")) |
799 (let ((failed (lilypond-all files))) | 793 (let ((failed (lilypond-all files))) |
800 (if (ly:get-option 'trace-scheme-coverage) | 794 (if (ly:get-option 'trace-scheme-coverage) |
801 (begin | 795 (begin |
802 (coverage:show-all (lambda (f) | 796 (coverage:show-all (lambda (f) |
803 (string-contains f "lilypond"))))) | 797 (string-contains f "lilypond"))))) |
804 (if (pair? failed) | 798 (if (pair? failed) |
805 (begin (ly:error (_ "failed files: ~S") (string-join failed)) | 799 (begin (ly:error (_ "failed files: ~S") (string-join failed)) |
806 (ly:exit 1 #f)) | 800 (ly:exit 1 #f)) |
807 (begin | 801 (begin |
808 (ly:exit 0 #f))))) | 802 (ly:exit 0 #f))))) |
809 | 803 |
810 | 804 |
811 (define-public (lilypond-all files) | 805 (define-public (lilypond-all files) |
812 (let* ((failed '()) | 806 (let* ((failed '()) |
813 (separate-logs (ly:get-option 'separate-log-files)) | 807 (separate-logs (ly:get-option 'separate-log-files)) |
814 (ping-log | 808 (ping-log |
815 (if separate-logs | 809 (if separate-logs |
816 (open-file (if (string-or-symbol? (ly:get-option 'log-file)) | 810 (open-file (if (string-or-symbol? (ly:get-option 'log-file)) |
817 » » » (format "~a.log" (ly:get-option 'log-file)) | 811 » » » (format #f "~a.log" (ly:get-option 'log-file)) |
818 "/dev/stderr") "a") #f)) | 812 "/dev/stderr") "a") #f)) |
819 (do-measurements (ly:get-option 'dump-profile)) | 813 (do-measurements (ly:get-option 'dump-profile)) |
820 (handler (lambda (key failed-file) | 814 (handler (lambda (key failed-file) |
821 (set! failed (append (list failed-file) failed))))) | 815 (set! failed (append (list failed-file) failed))))) |
822 (gc) | 816 (gc) |
823 (for-each | 817 (for-each |
824 (lambda (x) | 818 (lambda (x) |
825 (let* ((start-measurements (if do-measurements | 819 (let* ((start-measurements (if do-measurements |
826 (profile-measurements) | 820 (profile-measurements) |
827 #f)) | 821 #f)) |
828 (base (dir-basename x ".ly")) | 822 (base (dir-basename x ".ly")) |
829 (all-settings (ly:all-options))) | 823 (all-settings (ly:all-options))) |
830 (if separate-logs | 824 (if separate-logs |
831 » (ly:stderr-redirect (format "~a.log" base) "w")) | 825 » (ly:stderr-redirect (format #f "~a.log" base) "w")) |
832 (if ping-log | 826 (if ping-log |
833 (format ping-log "Processing ~a\n" base)) | 827 (format ping-log "Processing ~a\n" base)) |
834 (if (ly:get-option 'trace-memory-frequency) | 828 (if (ly:get-option 'trace-memory-frequency) |
835 (mtrace:start-trace (ly:get-option 'trace-memory-frequency))) | 829 (mtrace:start-trace (ly:get-option 'trace-memory-frequency))) |
836 (lilypond-file handler x) | 830 (lilypond-file handler x) |
837 (if start-measurements | 831 (if start-measurements |
838 (dump-profile x start-measurements (profile-measurements))) | 832 (dump-profile x start-measurements (profile-measurements))) |
839 (if (ly:get-option 'trace-memory-frequency) | 833 (if (ly:get-option 'trace-memory-frequency) |
840 (begin (mtrace:stop-trace) | 834 (begin (mtrace:stop-trace) |
841 (mtrace:dump-results base))) | 835 (mtrace:dump-results base))) |
(...skipping 44 matching lines...) Expand 10 before | Expand all | Expand 10 after Loading... |
886 (ly:exit 0 #f))))) | 880 (ly:exit 0 #f))))) |
887 | 881 |
888 (define (gui-no-files-handler) | 882 (define (gui-no-files-handler) |
889 (let* ((ly (string-append (ly:effective-prefix) "/ly/")) | 883 (let* ((ly (string-append (ly:effective-prefix) "/ly/")) |
890 ;; FIXME: soft-code, localize | 884 ;; FIXME: soft-code, localize |
891 (welcome-ly (string-append ly "Welcome_to_LilyPond.ly")) | 885 (welcome-ly (string-append ly "Welcome_to_LilyPond.ly")) |
892 (cmd (get-editor-command welcome-ly 0 0 0))) | 886 (cmd (get-editor-command welcome-ly 0 0 0))) |
893 (ly:message (_ "Invoking `~a'...\n") cmd) | 887 (ly:message (_ "Invoking `~a'...\n") cmd) |
894 (system cmd) | 888 (system cmd) |
895 (ly:exit 1 #f))) | 889 (ly:exit 1 #f))) |
LEFT | RIGHT |