From: Joe Neeman Date: Thu, 18 Jan 2007 20:28:05 +0000 (+0200) Subject: Merge with master X-Git-Tag: release/2.11.16-1^2~15 X-Git-Url: https://git.donarmstrong.com/?a=commitdiff_plain;h=87eedcd59f4082cb0841528ad5bc82cb1d1191e3;hp=-c;p=lilypond.git Merge with master --- 87eedcd59f4082cb0841528ad5bc82cb1d1191e3 diff --combined lily/main.cc index 68fc2a03cb,508b4b8f5b..7a524d77dc --- a/lily/main.cc +++ b/lily/main.cc @@@ -3,7 -3,7 +3,7 @@@ source file of the GNU LilyPond music typesetter - (c) 1997--2006 Han-Wen Nienhuys + (c) 1997--2007 Han-Wen Nienhuys */ #include "main.hh" @@@ -77,8 -77,8 +77,8 @@@ bool be_verbose_global = false /* Scheme code to execute before parsing, after .scm init. This is where -e arguments are appended to. */ - string init_scheme_code_string; - string init_scheme_variables; + string init_scheme_code_global; + string init_scheme_variables_global; /* Generate preview of first system. */ bool make_preview = false; @@@ -150,24 -150,24 +150,24 @@@ static Getopt_long *option_parser = 0 static Long_option_init options_static[] = { - {_i ("BACK"), "backend", 'b', _i ("use backend BACK (gnome, ps,eps,\nscm, svg, tex, texstr)\ndefault: PS")}, + {_i ("BACK"), "backend", 'b', _i ("use backend BACK (eps, gnome, ps [default],\nscm, svg, tex, texstr)")}, - {_i ("SYM=VAL"), "define-default", 'd', - _i ("set a Scheme program option. Uses #t if VAL is not specified\n" - "Try -dhelp for help.")}, + {_i ("SYM[=VAL]"), "define-default", 'd', + _i ("set Scheme option SYM to VAL (default: #t).\n" + "Use -dhelp for help.")}, {_i ("EXPR"), "evaluate", 'e', _i ("evaluate scheme code")}, /* Bug in option parser: --output =foe is taken as an abbreviation for --output-format. */ {_i ("FORMATs"), "formats", 'f', _i ("dump FORMAT,... Also as separate options:")}, {0, "dvi", 0, _i ("generate DVI (tex backend only)")}, - {0, "relocate", 0, _i ("relocate using directory of lilypond program")}, {0, "pdf", 0, _i ("generate PDF (default)")}, {0, "png", 0, _i ("generate PNG")}, {0, "ps", 0, _i ("generate PostScript")}, {0, "tex", 0, _i ("generate TeX (tex backend only)")}, - {0, "help", 'h', _i ("print this help")}, - {_i ("FIELD"), "header", 'H', _i ("dump a header field to file BASENAME.FIELD")}, + {0, "help", 'h', _i ("show this help and exit")}, + {_i ("FIELD"), "header", 'H', _i ("dump header field FIELD to file\n" + "named BASENAME.FIELD")}, {_i ("DIR"), "include", 'I', _i ("add DIR to search path")}, {_i ("FILE"), "init", 'i', _i ("use FILE as init file")}, #if HAVE_CHROOT @@@ -177,8 -177,8 +177,8 @@@ {0, "no-print", 0, _i ("do not generate printed output")}, {_i ("FILE"), "output", 'o', _i ("write output to FILE (suffix will be added)")}, {0, "preview", 'p', _i ("generate a preview of the first system")}, - {0, "safe-mode", 's', _i ("disallow unsafe Scheme and PostScript operations")}, - {0, "version", 'v', _i ("print version number")}, + {0, "relocate", 0, _i ("relocate using directory of lilypond program")}, + {0, "version", 'v', _i ("show version number and exit")}, {0, "verbose", 'V', _i ("be verbose")}, {0, "warranty", 'w', _i ("show warranty and copyright")}, {0, 0, 0, 0} @@@ -220,7 -220,7 +220,7 @@@ static voi copyright () { printf (_f ("Copyright (c) %s by\n%s and others.", - "1996--2006", + "1996--2007", AUTHORS).c_str ()); printf ("\n"); } @@@ -320,7 -320,7 +320,7 @@@ do_chroot_jail ( if (errno == 0) error (_f ("no such user: %s", components[USER_NAME])); else - error (_f ("can't get user id from user name: %s: %s", + error (_f ("cannot get user id from user name: %s: %s", components[USER_NAME], strerror (errno))); exit (3); @@@ -337,7 -337,7 +337,7 @@@ if (errno == 0) error (_f ("no such group: %s", components[GROUP_NAME])); else - error (_f ("can't get group id from group name: %s: %s", + error (_f ("cannot get group id from group name: %s: %s", components[GROUP_NAME], strerror (errno))); exit (3); @@@ -345,26 -345,26 +345,26 @@@ if (chroot (components[JAIL].c_str ())) { - error (_f ("can't chroot to: %s: %s", components[JAIL], + error (_f ("cannot chroot to: %s: %s", components[JAIL], strerror (errno))); exit (3); } if (setgid (gid)) { - error (_f ("can't change group id to: %d: %s", gid, strerror (errno))); + error (_f ("cannot change group id to: %d: %s", gid, strerror (errno))); exit (3); } if (setuid (uid)) { - error (_f ("can't change user id to: %d: %s", uid, strerror (errno))); + error (_f ("cannot change user id to: %d: %s", uid, strerror (errno))); exit (3); } if (chdir (components[DIR].c_str ())) { - error (_f ("can't change working directory to: %s: %s", components[DIR], + error (_f ("cannot change working directory to: %s: %s", components[DIR], strerror (errno))); exit (3); } @@@ -386,33 -386,16 +386,16 @@@ main_with_guile (void *, int, char ** || output_backend_global == "texstr"); is_pango_format_global = !is_TeX_format_global; + init_scheme_variables_global = "(list " + init_scheme_variables_global + ")"; + init_scheme_code_global = "(begin " + init_scheme_code_global + ")"; ly_c_init_guile (); call_constructors (); - init_global_tweak_registry (); init_fontconfig (); init_freetype (); ly_reset_all_fonts (); - if (!init_scheme_variables.empty () - || !init_scheme_code_string.empty ()) - { - init_scheme_variables = "(map (lambda (x) (ly:set-option (car x) (cdr x))) (list " - + init_scheme_variables + "))"; - - init_scheme_code_string - = "(begin #t " - + init_scheme_variables - + init_scheme_code_string - + ")"; - - char const *str0 = init_scheme_code_string.c_str (); - - if (be_verbose_global) - progress_indication (_f ("Evaluating %s", str0)); - scm_c_eval_string ((char *) str0); - } /* We accept multiple independent music files on the command line to reduce compile time when processing lots of small files. @@@ -422,7 -405,7 +405,7 @@@ SCM *tail = &files; while (char const *arg = option_parser->get_next_arg ()) { - *tail = scm_cons (scm_makfrom0str (arg), SCM_EOL); + *tail = scm_cons (scm_from_locale_string (arg), SCM_EOL); tail = SCM_CDRLOC (*tail); } @@@ -504,10 -487,10 +487,10 @@@ parse_argv (int argc, char **argv if (eq != NPOS) { key = arg.substr (0, eq); - val = arg.substr (eq + 1, key.length () - 1); + val = arg.substr (eq + 1, arg.length () - 1); } - init_scheme_variables + init_scheme_variables_global += "(cons \'" + key + " " + val + ")\n"; } break; @@@ -526,8 -509,9 +509,9 @@@ case 'j': jail_spec = option_parser->optional_argument_str0_; break; + case 'e': - init_scheme_code_string += option_parser->optional_argument_str0_; + init_scheme_code_global += option_parser->optional_argument_str0_ + string (" "); break; case 'w': warranty (); @@@ -562,12 -546,6 +546,6 @@@ break; case 'V': be_verbose_global = true; - break; - case 's': - be_safe_global = true; - init_scheme_variables - += "(cons \'safe #t)\n"; - break; case 'p': make_preview = true; @@@ -649,25 -627,3 +627,25 @@@ main (int argc, char **argv /* Only reachable if GUILE exits. That is an error. */ return 1; } + +SCM atexit_list = SCM_EOL; + +LY_DEFINE (ly_atexit, "ly:atexit", + 2, 0, 0, (SCM proc, SCM args), + "Just before exiting, call the procedure given. " +"If this is called multiple times, the procedures are called " +"in LIFO order.") +{ + atexit_list = scm_cons (scm_cons (proc, args), atexit_list); + scm_gc_protect_object (atexit_list); + return SCM_UNSPECIFIED; +} + +LY_DEFINE (ly_do_atexit, "ly:do-atexit", + 0, 0, 0, (), + "Call the atexit procedures.") +{ + for (SCM s = atexit_list; scm_is_pair (s); s = scm_cdr (s)) + scm_apply_0 (scm_caar (s), scm_cdar (s)); + return SCM_UNSPECIFIED; +} diff --combined scm/lily.scm index a016901bcb,a0940d9be9..e98897fca8 --- a/scm/lily.scm +++ b/scm/lily.scm @@@ -5,6 -5,18 +5,18 @@@ ;;;; (c) 1998--2006 Jan Nieuwenhuizen ;;;; Han-Wen Nienhuys + ;; Internationalisation: (_i "to be translated") gets an entry in the + ;; POT file (gettext ) must be invoked explicitely to do the actual + ;; "translation". + ;;(define-macro (_i x) x) + ;;(define-macro-public _i (x) x) + ;;(define-public-macro _i (x) x) + ;; Abbrv-PWR! + (defmacro-public _i (x) x) + + (read-enable 'positions) + (debug-enable 'debug) + (define (define-scheme-options) (for-each (lambda (x) @@@ -21,31 -33,29 +33,29 @@@ (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.") + (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-signatures #f "dump output signatures of each system") - (dump-tweaks #f "dump page layout and tweaks for each score having the tweak-key layout property set.") + (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") + (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") - - (eps-box-padding #f "Pad EPS bounding box left edge by this much to guarantee alignment between systems") - - (gui #f "running from gui; redirect stderr to log file") (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") @@@ -58,16 -68,20 +68,20 @@@ on errors, and print a stack trace." (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") - + (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.") (ttf-verbosity 0 "how much verbosity for TTF font embedding?") - (show-available-fonts #f - "List font names available.") - + "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 @@@ -75,6 -89,8 +89,8 @@@ ;; (define-scheme-options) + + (debug-set! stack 0) (if (defined? 'set-debug-cell-accesses!) @@@ -84,18 -100,19 +100,19 @@@ (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) ) - ;; my display - (define-public (myd k v) (display k) (display ": ") (display v) (display ", ")) + (define-public (myd k v) (display k) (display ": ") (display v) (display ", ") + v) (define-public (print . args) (apply format (cons (current-output-port) args))) @@@ -141,7 -158,7 +158,7 @@@ (if (ly:get-option 'verbose) (ly:progress "[~A" file-name)) (if (not file-name) - (ly:error (_ "Can't find ~A") x)) + (ly:error (_ "cannot find: ~A") x)) (primitive-load file-name) (if (ly:get-option 'verbose) (ly:progress "]")))) @@@ -254,16 -271,17 +271,17 @@@ The syntax is the same as `define*-publ ;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;; ;; init pitch system - (ly:set-default-scale (ly:make-scale #(0 2 4 5 7 9 11))) + (ly:set-default-scale (ly:make-scale #(0 1 2 5/2 7/2 9/2 11/2))) ;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;; ;; 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" @@@ -310,6 -328,11 +328,11 @@@ "safe-lily.scm")) + + + (for-each ly:load init-scheme-files) + + (set! type-p-name-alist `( (,boolean-or-symbol? . "boolean or symbol") @@@ -348,12 -371,48 +371,48 @@@ (,symbol? . "symbol") (,vector? . "vector"))) + ;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;; + ;; timing + + (define (profile-measurements) + (let* ((t (times)) + (stats (gc-stats))) + + (list + (- (+ (tms:cutime t) + (tms:utime t)) + (ly:assoc-get 'gc-time-taken stats)) + + (ly:assoc-get 'total-cells-allocated stats 0) + ))) + + (define (dump-profile base last this) + (let* + ((outname (format "~a.profile" (basename base ".ly"))) + (diff (map (lambda (y) (apply - y)) (zip this last)))) + + (ly:progress "\nWriting timing to ~a..." outname) + (format (open-file outname "w") + "time: ~a\ncells: ~a\n" + (car diff) + (cadr diff) + ))) + ;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;; ;; debug mem leaks (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) + (stringnumber (match:substring (car interesting) 1))) + ) + + + (display (format "VMDATA: ~a\n" mem)) + (display (gc-stats)) + (if (> mem 100000) + (begin + (dump-gc-protects) + (raise 1))) )) @@@ -450,11 -533,13 +533,13 @@@ (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)) @@@ -471,7 -556,7 +556,7 @@@ )) (if (and (number? (ly:get-option 'job-count)) - (> (length files) (ly:get-option 'job-count))) + (>= (length files) (ly:get-option 'job-count))) (let* ((count (ly:get-option 'job-count)) @@@ -493,31 -578,43 +578,43 @@@ (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) + (dump-profile "lily-run-total" '(0 0) (profile-measurements))) (exit (if (null? errors) 0 1)))))) (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 (pair? failed) @@@ -525,13 -622,12 +622,13 @@@ (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 'show-available-fonts) (begin @@@ -540,26 -636,63 +637,63 @@@ )) (let* ((failed '()) - (first #t) + (separate-logs (ly:get-option 'separate-log-files)) + (do-measurements (ly:get-option 'dump-profile)) (handler (lambda (key failed-file) (set! failed (append (list failed-file) failed))))) + (gc) (for-each (lambda (x) - - ;; We don't carry info across file boundaries - (if first - (set! first #f) - (gc)) - - (lilypond-file handler x) - (ly:clear-anonymous-modules) - (if (ly:get-option 'debug-gc) - (dump-gc-protects) - (if (= (random 40) 1) - (ly:reset-all-fonts)))) + (let* + ((start-measurements (if do-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) + (ly:reset-all-fonts))))) files) + + ;; we want the failed-files notice in the aggregrate logfile. + (if (ly:get-option 'separate-logs) + (ly:stderr-redirect + (if (string-or-symbol? (ly:get-option 'log-file)) + (format "~a.log" (ly:get-option 'log-file)) + "/dev/tty") "a")) + + (if (ly:get-option 'dump-profile) + (dump-profile "lily-run-total" '(0 0) (profile-measurements))) + failed)) (define (lilypond-file handler file-name)