From 9af00fcfb4782168ae583a3d66058095815725e3 Mon Sep 17 00:00:00 2001 From: Matthew Flatt Date: Thu, 17 Jul 2008 15:20:17 +0000 Subject: [PATCH] v4.0.2.4: logging svn: r10818 --- collects/algol60/cfg-parser.ss | 2 +- collects/compiler/to-core.ss | 2 +- collects/framework/private/text.ss | 3 +- collects/games/gcalc/gcalc.ss | 2 +- collects/games/gl-board-game/gl-board.ss | 4 +- collects/gui-debugger/marks.ss | 3 +- collects/lang/run-teaching-program.ss | 2 +- .../2/2/private/raw-red-black-tree-set.scm | 18 +- collects/macro-debugger/util/notify.ss | 2 +- collects/mred/private/afm.ss | 131 ++-- collects/mred/private/snipfile.ss | 4 +- collects/mzlib/port.ss | 2 +- collects/net/url-unit.ss | 2 +- collects/r6rs/private/find-version.ss | 2 +- collects/rnrs/base-6.ss | 2 +- collects/scheme/match/define-forms.ss | 4 +- collects/scheme/mzscheme.ss | 7 +- collects/scheme/private/for.ss | 6 +- collects/scheme/private/more-scheme.ss | 22 +- collects/scheme/private/old-procs.ss | 12 +- collects/scribblings/reference/evts.scrbl | 117 +-- collects/scribblings/reference/logging.scrbl | 174 +++++ .../reference/module-reflect.scrbl | 24 +- .../scribblings/reference/namespaces.scrbl | 7 +- collects/scribblings/reference/os.scrbl | 1 + collects/scribblings/reference/startup.scrbl | 22 +- collects/srfi/19/time.ss | 3 +- collects/tests/mzscheme/logger.ss | 72 ++ collects/tests/mzscheme/mz.ss | 1 + collects/texpict/face.ss | 2 +- doc/release-notes/mzscheme/HISTORY.txt | 5 + src/mzscheme/cmdline.inc | 79 ++ src/mzscheme/gc2/compact.c | 1 + src/mzscheme/gc2/gc2.h | 1 + src/mzscheme/gc2/newgc.c | 7 +- src/mzscheme/include/mzscheme.exp | 3 + src/mzscheme/include/mzscheme3m.exp | 3 + src/mzscheme/include/mzwin.def | 3 + src/mzscheme/include/mzwin3m.def | 3 + src/mzscheme/include/scheme.h | 14 +- src/mzscheme/sconfig.h | 12 + src/mzscheme/src/cstartup.inc | 380 +++++----- src/mzscheme/src/env.c | 1 + src/mzscheme/src/error.c | 676 +++++++++++++++++- src/mzscheme/src/eval.c | 272 +++++-- src/mzscheme/src/file.c | 15 +- src/mzscheme/src/fun.c | 14 +- src/mzscheme/src/module.c | 20 +- src/mzscheme/src/mzmark.c | 62 ++ src/mzscheme/src/mzmarksrc.c | 24 + src/mzscheme/src/schemef.h | 5 + src/mzscheme/src/schemex.h | 4 + src/mzscheme/src/schemex.inc | 3 + src/mzscheme/src/schemexm.h | 3 + src/mzscheme/src/schminc.h | 2 +- src/mzscheme/src/schpriv.h | 36 +- src/mzscheme/src/schvers.h | 4 +- src/mzscheme/src/sema.c | 13 + src/mzscheme/src/stypes.h | 142 ++-- src/mzscheme/src/syntax.c | 8 +- src/mzscheme/src/thread.c | 27 +- src/mzscheme/src/type.c | 6 + src/mzscheme/uconfig.h | 2 + 63 files changed, 1944 insertions(+), 561 deletions(-) create mode 100644 collects/scribblings/reference/logging.scrbl create mode 100644 collects/tests/mzscheme/logger.ss diff --git a/collects/algol60/cfg-parser.ss b/collects/algol60/cfg-parser.ss index ab6744896e..04a22975ef 100644 --- a/collects/algol60/cfg-parser.ss +++ b/collects/algol60/cfg-parser.ss @@ -686,7 +686,7 @@ #f "bad grammar clause" stx - (car #f))] + (car clauses))] [_else (loop (cdr clauses) cfg-start diff --git a/collects/compiler/to-core.ss b/collects/compiler/to-core.ss index 700df91932..7d777bef2c 100644 --- a/collects/compiler/to-core.ss +++ b/collects/compiler/to-core.ss @@ -403,7 +403,7 @@ stx (#,set-stx #,id #,(add-identifier/pos (apply-certs certs #'x) li trans?) #,(loop #'e))))] [(#%variable-reference e) - (add-literal stx li)] + (add-literal stx li safe-vector-ref-stx id)] [(if e ...) (quasisyntax/loc+props stx diff --git a/collects/framework/private/text.ss b/collects/framework/private/text.ss index 3a5bf0dc4a..9e7d71fc82 100644 --- a/collects/framework/private/text.ss +++ b/collects/framework/private/text.ss @@ -2822,7 +2822,8 @@ designates the character that triggers autocompletion [else (raise (make-exn:fail:contract (string->immutable-string - (format "parameter ~a: expected ~a, given: ~e" name description v))))])))) + (format "parameter ~a: expected ~a, given: ~e" name description v)) + (current-continuation-marks)))])))) (define autocomplete-append-after (make-guarded-parameter 'append-after "string" "" string?)) diff --git a/collects/games/gcalc/gcalc.ss b/collects/games/gcalc/gcalc.ss index e33910c5b2..2756e8c539 100644 --- a/collects/games/gcalc/gcalc.ss +++ b/collects/games/gcalc/gcalc.ss @@ -576,7 +576,7 @@ (message-box "Open" (format "~s is not a GCalc file." f) gcalc-frame '(ok)))]) - (or (equal? "GCALC" (read)) (error)) + (or (equal? "GCALC" (read)) (error "gcalc")) (set-file-name! f) (for-each (lambda (c) ((custom-setter c) (read))) customs) (send main-cell set-contents! (validate-contents (read))) diff --git a/collects/games/gl-board-game/gl-board.ss b/collects/games/gl-board-game/gl-board.ss index 05aba051b8..a7ac2f83d1 100644 --- a/collects/games/gl-board-game/gl-board.ss +++ b/collects/games/gl-board-game/gl-board.ss @@ -106,7 +106,7 @@ pieces)]) (if p (set-piece-enabled?! p (and on? #t)) - (raise-mismatch-error "no matching piece: " info)))) + (raise-mismatch-error 'enable-piece "no matching piece: " info)))) ;; enabled?: info -> boolean (define/public (enabled? info) @@ -115,7 +115,7 @@ pieces))) (if p (piece-enabled? p) - (raise-mismatch-error "no matching piece: " info)))) + (raise-mismatch-error 'enabled? "no matching piece: " info)))) ;; remove-piece: info -> ;; Removes all pieces whose info is equal? to p-i from this board. diff --git a/collects/gui-debugger/marks.ss b/collects/gui-debugger/marks.ss index 68c7ad3ae3..2b881e18d9 100644 --- a/collects/gui-debugger/marks.ss +++ b/collects/gui-debugger/marks.ss @@ -16,7 +16,7 @@ (provide/contract ;[make-debug-info (-> any? binding-set? varref-set? any? boolean? syntax?)] ; (location tail-bound free label lifting? -> mark-stx) [expose-mark (-> mark? (list/c any/c symbol? (listof (list/c identifier? any/c))))] - [make-top-level-mark (syntax? . -> . syntax?)] + ;[make-top-level-mark (syntax? . -> . syntax?)] [lookup-all-bindings ((identifier? . -> . boolean?) mark-list? . -> . (listof any/c))] [lookup-first-binding ((identifier? . -> . boolean?) mark-list? ( -> any) . -> . any)] [lookup-binding (mark-list? identifier? . -> . any)]) @@ -179,5 +179,6 @@ (define (assemble-debug-info tail-bound free-vars label lifting?) (map make-mark-binding-stx free-vars)) + #; (define (make-top-level-mark source-expr) (make-full-mark source-expr 'top-level null))) diff --git a/collects/lang/run-teaching-program.ss b/collects/lang/run-teaching-program.ss index 1ccee80a69..558e6e8e81 100644 --- a/collects/lang/run-teaching-program.ss +++ b/collects/lang/run-teaching-program.ss @@ -49,7 +49,7 @@ (with-handlers ((exn:fail? (λ (x) (error 'teachpack (missing-tp-message tp))))) (unless (file-exists? (build-path (apply collection-path (cddr tp)) (cadr tp))) - (error)))) + (error "fail")))) teachpacks) (rewrite-module (expand diff --git a/collects/little-helper/indexer/planet/galore.plt/2/2/private/raw-red-black-tree-set.scm b/collects/little-helper/indexer/planet/galore.plt/2/2/private/raw-red-black-tree-set.scm index 662f130451..c6262ec3eb 100644 --- a/collects/little-helper/indexer/planet/galore.plt/2/2/private/raw-red-black-tree-set.scm +++ b/collects/little-helper/indexer/planet/galore.plt/2/2/private/raw-red-black-tree-set.scm @@ -115,12 +115,12 @@ [($ B l _ r) (let ([height-left (check l)] [height-right (check r)]) (if (not (= height-left height-right)) - (error) + (error "fail") (+ height-left 1)))] [($ R l _ r) (let ([height-left (check l)] [height-right (check r)]) (if (not (= height-left height-right)) - (error) + (error "fail") height-left))])) ;;; SET OPERATIONS @@ -208,7 +208,7 @@ (match s1 [($ B _ _ _) s1] [($ R a y b) (B- a y b)] - [() (error)]))) + [() (error "fail")]))) (define (insert/combiner cmp x s combine) (define (ins s) @@ -232,7 +232,7 @@ (match s1 [($ B _ _ _) s1] [($ R a y b) (B- a y b)] - [() (error)]))) + [() (error "fail")]))) (define (insert* cmp xs s) (list:foldl (lambda (x acc) (insert cmp x acc)) s xs)) @@ -251,7 +251,7 @@ [($ R ($ B t1 x1 t2) x2 t3) (values (lbalance (R- t1 x1 t2) x2 t3) #f)] [($ B ($ B t1 x1 t2) x2 t3) (values (lbalance (R- t1 x1 t2) x2 t3) #t)] [($ B ($ R t1 x1 ($ B t2 x2 t3)) x3 t4) (values (B- t1 x1 (lbalance (R- t2 x2 t3) x3 t4)) #f)] - [_ (error)])) + [_ (error "fail")])) ; (* [unbalanced_right] repares invariant (2) when the black height of the ; right son exceeds (by 1) the black height of the left son *) @@ -261,7 +261,7 @@ [($ R t1 x1 ($ B t2 x2 t3)) (values (rbalance t1 x1 (R- t2 x2 t3)) #f)] [($ B t1 x1 ($ B t2 x2 t3)) (values (rbalance t1 x1 (R- t2 x2 t3)) #t)] [($ B t1 x1 ($ R ($ B t2 x2 t3) x3 t4)) (values (B- (rbalance t1 x1 (R- t2 x2 t3)) x3 t4) #f)] - [_ (error)])) + [_ (error "fail")])) ; (* [remove_min s = (s',m,b)] extracts the minimum [m] of [s], [s'] being the @@ -274,7 +274,7 @@ ; minimum is reached [($ B () x ()) (values empty x #t)] [($ B () x ($ R l y r)) (values (B- l y r) x #f)] - [($ B () _ ($ B _ _ _)) (error)] + [($ B () _ ($ B _ _ _)) (error "fail")] [($ R () x r) (values r x #f)] ; minimum is recursively extracted from [l] [($ B l x r) (let-values ([(l1 m d) (remove-min l)]) @@ -377,11 +377,11 @@ [(= k 0) (cond [(= n 0) (cons '() sl)] [else (match sl - [() (error)] + [() (error "fail")] [(x . sl) (cons (R- empty x empty) sl)])])] [else (let ([n1 (quotient (- n 1) 2)]) (match (build sl n1 (- k 1)) - [(_ . ()) (error)] + [(_ . ()) (error "fail")] [(l . (x . sl)) (match-let ([(r . sl) (build sl (sub1 (- n n1)) (- k 1))]) (cons (B- r x l) sl))]))])) (let ([n (length sl)]) diff --git a/collects/macro-debugger/util/notify.ss b/collects/macro-debugger/util/notify.ss index c5c6e8c825..316358a8f8 100644 --- a/collects/macro-debugger/util/notify.ss +++ b/collects/macro-debugger/util/notify.ss @@ -20,7 +20,7 @@ (define-for-syntax (join . args) (define (->string x) (cond [(string? x) x] - [(symbol? x) (symbol->string)] + [(symbol? x) (symbol->string x)] [(identifier? x) (symbol->string (syntax-e x))] [else (error '->string)])) (string->symbol (apply string-append (map ->string args)))) diff --git a/collects/mred/private/afm.ss b/collects/mred/private/afm.ss index 2028981a3d..53f3afed05 100644 --- a/collects/mred/private/afm.ss +++ b/collects/mred/private/afm.ss @@ -1,22 +1,21 @@ -(module afm mzscheme - (require mzlib/file - mzlib/list) +(module afm scheme/base + (require scheme/file + scheme/list) - (provide (protect afm-draw-text - afm-get-text-extent - afm-expand-name - afm-glyph-exists? - afm-record-font - afm-fonts-string) + (provide (protect-out afm-draw-text + afm-get-text-extent + afm-expand-name + afm-glyph-exists? + afm-record-font + afm-fonts-string) current-ps-afm-file-paths current-ps-cmap-file-paths) - (define orig-err (current-error-port)) (define (report-exn exn) - (fprintf orig-err "PostScript/AFM error: ~a~n" - (if (exn? exn) - (exn-message exn) - exn))) + (log-error (format "PostScript/AFM error: ~a~n" + (if (exn? exn) + (exn-message exn) + exn)))) (define bytes->number (case-lambda @@ -73,7 +72,7 @@ (define got-long-name-list? #f) (define (read-glyph-names gl.txt) - (let ([ht (make-hash-table 'equal)]) + (let ([ht (make-hash)]) (with-handlers ([exn:fail? report-exn]) (call-with-input-file* gl.txt @@ -84,9 +83,9 @@ (let ([m (regexp-match #rx#"^([a-zA-Z0-9_-]+);([0-9a-fA-F][0-9a-fA-F][0-9a-fA-F][0-9a-fA-F])$" l)]) (when m - (hash-table-put! ht - (cadr m) - (bytes->number (caddr m) 16)))) + (hash-set! ht + (cadr m) + (bytes->number (caddr m) 16)))) (loop))))))) ht)) @@ -102,7 +101,7 @@ ;; Read glyph names: (read-glyph-names file) ;; Make empty hash table: - (make-hash-table))))) + (make-hasheq))))) ;; Reads the Adobe char name -> Unicode table (define (read-names! gl.txt long?) @@ -112,22 +111,22 @@ ;; Maps Adobe char name to Unicode, loading the table as necesary (define (find-unicode font-glyphnames name) - (hash-table-get + (hash-ref font-glyphnames name (lambda () (unless adobe-name-to-code-point (read-names! "glyphshortlist.txt" #f)) - (hash-table-get adobe-name-to-code-point - name - (lambda () - (if got-long-name-list? - (let ([m (regexp-match #rx#"^uni([0-9a-fA-Z]+)" name)]) - (and m - (string->number (bytes->string/latin-1 (cadr m)) 16))) - (begin - (read-names! "glyphlist.txt" #t) - (find-unicode font-glyphnames name)))))))) + (hash-ref adobe-name-to-code-point + name + (lambda () + (if got-long-name-list? + (let ([m (regexp-match #rx#"^uni([0-9a-fA-Z]+)" name)]) + (and m + (string->number (bytes->string/latin-1 (cadr m)) 16))) + (begin + (read-names! "glyphlist.txt" #t) + (find-unicode font-glyphnames name)))))))) ;; ------------------------------------------------------------ @@ -140,15 +139,14 @@ ;; when reading any other XXX -> Adobe-CNS to generate an ;; XXX -> UTF-32 table. (define (read-cmap file to-unicode) - (let* ([ht (make-hash-table 'equal)] + (let* ([ht (make-hash)] [put! (if to-unicode (lambda (c cns) - (hash-table-put! ht - c - (hash-table-get to-unicode cns - (lambda () #f)))) + (hash-set! ht + c + (hash-ref to-unicode cns #f))) (lambda (c cns) - (hash-table-put! ht cns c)))]) + (hash-set! ht cns c)))]) (with-handlers ([exn:fail? report-exn]) (call-with-input-file* file @@ -199,18 +197,18 @@ (find-path (current-ps-cmap-file-paths) "UniCNS-UTF32-H") #f))) - (define cmap-table (make-hash-table 'equal)) + (define cmap-table (make-hash)) (define (get-cmap name) (unless cns->unicode-table (read-cns->unicode!)) - (hash-table-get + (hash-ref cmap-table name (lambda () (let ([t (read-cmap (find-path (current-ps-cmap-file-paths) (bytes->path name)) cns->unicode-table)]) - (hash-table-put! cmap-table name t) + (hash-set! cmap-table name t) t)))) ;; ---------------------------------------- @@ -260,7 +258,7 @@ [bbox-up #f] [ascender #f] [cap-height #f] - [achars (make-hash-table 'equal)] + [achars (make-hash)] [kern-pairs null] [char-set #f] [char-set-name #f] @@ -309,10 +307,10 @@ (bytes->number (cadr nm)) (cadr nm))) 0)]) - (hash-table-put! + (hash-set! achars (if (and char-set is-cid?) - (hash-table-get char-set name (lambda () 0)) + (hash-ref char-set name 0) (find-unicode font-glyphnames name)) (make-achar (let ([v (if (eq? n 'c) @@ -347,7 +345,7 @@ (let ([c1 (car kp)] [c2 (cadr kp)] [amt (caddr kp)]) - (let ([achar (hash-table-get achars c1 (lambda () (make-achar 0 0)))]) + (let ([achar (hash-ref achars c1 (lambda () (make-achar 0 0)))]) (achar-add-kern! achar c2 amt)))) kern-pairs) (let* ([descender (- (or descender bbox-down 0))] @@ -376,20 +374,20 @@ (extract-ligatures font-glyphnames rest))) null))) - (define fonts (make-hash-table 'equal)) + (define fonts (make-hash)) (define (get-font name) - (hash-table-get fonts name - (lambda () - (hash-table-put! fonts - name - (with-handlers ([void (lambda (exn) - (report-exn exn) - #f)]) - (parse-afm - (find-path (current-ps-afm-file-paths) - (format "~a.afm" name))))) - (get-font name)))) + (hash-ref fonts name + (lambda () + (hash-set! fonts + name + (with-handlers ([void (lambda (exn) + (report-exn exn) + #f)]) + (parse-afm + (find-path (current-ps-afm-file-paths) + (format "~a.afm" name))))) + (get-font name)))) ;; ---------------------------------------- @@ -465,7 +463,7 @@ (let loop ([cl (map-symbols sym-map? (string->list string))][width 0.0]) (cond [(empty? cl) width] - [else (let ([achar (hash-table-get + [else (let ([achar (hash-ref (font-achars font) (char->integer (car cl)) (lambda () @@ -502,14 +500,14 @@ ;; pen is positioned at text top-left: (define (afm-draw-text font-name size string out kern? sym-map? used-fonts) (let* ([l (map-symbols sym-map? (string->list string))] - [used-fonts (or used-fonts (make-hash-table 'equal))] + [used-fonts (or used-fonts (make-hash))] [font (or (get-font font-name) (make-font 0 0 0 0 #hash() #f #f))] [show-simples (lambda (simples special-font-name special-font) (unless (null? simples) (when special-font (let ([name (afm-expand-name special-font-name)]) - (hash-table-put! used-fonts name #t) + (hash-set! used-fonts name #t) (fprintf out "currentfont~n/~a findfont~n~a scalefont setfont~n" name size))) @@ -553,8 +551,7 @@ (cond [(null? l) (show-simples simples special-font-name special-font)] - [(hash-table-get (font-achars font) (char->integer (car l)) - (lambda () #f)) + [(hash-ref (font-achars font) (char->integer (car l)) #f) => (lambda (achar) (if (integer? (achar-enc achar)) ;; It's simple... @@ -646,15 +643,15 @@ (define (afm-record-font name used-fonts) - (let ([used-fonts (or used-fonts (make-hash-table 'equal))]) - (hash-table-put! used-fonts name #t) + (let ([used-fonts (or used-fonts (make-hash))]) + (hash-set! used-fonts name #t) used-fonts)) (define (afm-fonts-string used-fonts) - (if (hash-table? used-fonts) + (if (hash? used-fonts) (let ([s (open-output-string)] [pos 0]) - (hash-table-for-each + (hash-for-each used-fonts (lambda (k v) (let ([len (string-length k)]) @@ -681,9 +678,9 @@ (define (afm-glyph-exists?* font-name char-val) (let ([f (get-font font-name)]) (and f - (let ([achar (hash-table-get (font-achars f) - char-val - (lambda () #f))]) + (let ([achar (hash-ref (font-achars f) + char-val + #f)]) (and achar (list font-name f achar)))))) diff --git a/collects/mred/private/snipfile.ss b/collects/mred/private/snipfile.ss index 95399bb96e..11379e4187 100644 --- a/collects/mred/private/snipfile.ss +++ b/collects/mred/private/snipfile.ss @@ -39,8 +39,8 @@ (if (or (ok-lib-path? m) (and (list? m) (= (length m) 2) - (ok-lib-path? (car m) - (ok-lib-path? (cadr m))))) + (ok-lib-path? (car m)) + (ok-lib-path? (cadr m)))) (let ([m (if (ok-lib-path? m) m (car m))]) diff --git a/collects/mzlib/port.ss b/collects/mzlib/port.ss index 17441c20cb..16a04f0a34 100644 --- a/collects/mzlib/port.ss +++ b/collects/mzlib/port.ss @@ -1627,7 +1627,7 @@ (begin (when (> len2 (bytes-length out-bytes)) (raise-insane-decoding-length)) - (bytes-copy out-bytes 0 s2 start2 (+ start2 len2)) + (bytes-copy! out-bytes 0 s2 start2 (+ start2 len2)) (set! out-start 0) (set! out-end len2) used))] diff --git a/collects/net/url-unit.ss b/collects/net/url-unit.ss index a23a6749cb..986012c6ae 100644 --- a/collects/net/url-unit.ss +++ b/collects/net/url-unit.ss @@ -154,7 +154,7 @@ [(pair? strs) (apply build-path (string->path/win (car strs)) (map string->path-element/same (cdr strs)))] - [else (build-path)]) ; error + [else (error 'file://->path "no path elements: ~e" url)]) (let ([elems (map string->path-element/same strs)]) (if (url-path-absolute? url) (apply build-path (bytes->path #"/" 'unix) elems) diff --git a/collects/r6rs/private/find-version.ss b/collects/r6rs/private/find-version.ss index 3587a622d5..e26cdafcdb 100644 --- a/collects/r6rs/private/find-version.ss +++ b/collects/r6rs/private/find-version.ss @@ -70,7 +70,7 @@ (version-match? cand v)) (cdr vers))] [(eq? (car vers) 'not) - (not (version-match? (cadr vers)))] + (not (version-match? cand (cadr vers)))] [(sub-version-match? (car cand) (car vers)) (version-match? (cdr cand) (cdr vers))] [else #f])) diff --git a/collects/rnrs/base-6.ss b/collects/rnrs/base-6.ss index 4e26afd66f..a48d2b8af4 100644 --- a/collects/rnrs/base-6.ss +++ b/collects/rnrs/base-6.ss @@ -226,7 +226,7 @@ +nan.0 1.0)] [else - (raise-type-error "real number" y)])) + (raise-type-error 'div "real number" y)])) (define (mod x y) (- x (* (div x y) y))) diff --git a/collects/scheme/match/define-forms.ss b/collects/scheme/match/define-forms.ss index 9d2cde591e..caa92b6335 100644 --- a/collects/scheme/match/define-forms.ss +++ b/collects/scheme/match/define-forms.ss @@ -40,8 +40,8 @@ (for/list ([ps pss]) (unless (= (length (syntax->list ps)) len) (raise-syntax-error - 'match "unequal number of patterns in match clauses" - stx ps ps1))) + #f "unequal number of patterns in match clauses" + stx ps))) (with-syntax ([(vars ...) (generate-temporaries (car pss))]) (syntax/loc stx (lambda (vars ...) (match* (vars ...) [pats . rhs] ...)))))])) diff --git a/collects/scheme/mzscheme.ss b/collects/scheme/mzscheme.ss index 2567730d58..fb3102fd41 100644 --- a/collects/scheme/mzscheme.ss +++ b/collects/scheme/mzscheme.ss @@ -22,7 +22,8 @@ (#%provide require require-for-syntax require-for-template require-for-label provide provide-for-syntax provide-for-label - (all-from-except "private/more-scheme.ss" case old-case) + (all-from-except "private/more-scheme.ss" case old-case + log-fatal log-error log-warning log-info log-debug) (rename old-case case) (all-from "private/misc.ss") (all-from-except "private/stxcase-scheme.ss" _) @@ -55,7 +56,9 @@ hash-copy hash-count hash-map hash-for-each hash-iterate-first hash-iterate-next - hash-iterate-value hash-iterate-key) + hash-iterate-value hash-iterate-key + log-message log-level? make-logger logger? current-logger logger-name + make-log-receiver log-receiver?) (rename syntax->datum syntax-object->datum) (rename datum->syntax datum->syntax-object) (rename free-identifier=? module-identifier=?) diff --git a/collects/scheme/private/for.ss b/collects/scheme/private/for.ss index 1caffe0b31..9c1b646190 100644 --- a/collects/scheme/private/for.ss +++ b/collects/scheme/private/for.ss @@ -673,15 +673,15 @@ [loop-arg ...]) ...) (reverse (syntax->list #'binds))]) #'(let-values (outer-binding ... ...) outer-check ... - (let comp-loop ([fold-var fold-init] ... - loop-binding ... ...) + (let for-loop ([fold-var fold-init] ... + loop-binding ... ...) (if (and pos-guard ...) (let-values (inner-binding ... ...) (if (and pre-guard ...) (let-values ([(fold-var ...) (for/foldX/derived [orig-stx nested? #f ()] ([fold-var fold-var] ...) rest expr1 . body)]) (if (and post-guard ...) - (comp-loop fold-var ... loop-arg ... ...) + (for-loop fold-var ... loop-arg ... ...) (values* fold-var ...))) (values* fold-var ...))) (values* fold-var ...)))))] diff --git a/collects/scheme/private/more-scheme.ss b/collects/scheme/private/more-scheme.ss index 5f478b0566..f07dfc5ae8 100644 --- a/collects/scheme/private/more-scheme.ss +++ b/collects/scheme/private/more-scheme.ss @@ -330,9 +330,29 @@ (printf "cpu time: ~s real time: ~s gc time: ~s~n" cpu user gc) (apply values v)))]))) + (define-syntax (log-it stx) + (syntax-case stx () + [(_ id mode str-expr) + #'(let ([l (current-logger)]) + (when (log-level? l 'mode) + (log-message l 'mode str-expr (current-continuation-marks))))])) + (define-syntax (define-log stx) + (syntax-case stx () + [(_ id mode) + #'(define-syntax (id stx) + (syntax-case stx () + [(_ str-expr) + #'(log-it id mode str-expr)]))])) + (define-log log-fatal fatal) + (define-log log-error error) + (define-log log-warning warning) + (define-log log-info info) + (define-log log-debug debug) + (#%provide case old-case do parameterize parameterize* current-parameterization call-with-parameterization parameterize-break current-break-parameterization call-with-break-parameterization with-handlers with-handlers* call-with-exception-handler set!-values - let/cc fluid-let time)) + let/cc fluid-let time + log-fatal log-error log-warning log-info log-debug)) diff --git a/collects/scheme/private/old-procs.ss b/collects/scheme/private/old-procs.ss index e3bbb9f7a8..061fc5b879 100644 --- a/collects/scheme/private/old-procs.ss +++ b/collects/scheme/private/old-procs.ss @@ -54,21 +54,21 @@ (make-hash) (if (eq? a 'weak) (make-weak-hasheq) - (raise-mismatch-error "make-hash-table: bad argument: " a)))] + (raise-mismatch-error 'make-hash-table "bad argument: " a)))] [(a b) (if (or (and (eq? a 'equal) (eq? b 'weak)) (and (eq? a 'weak) (eq? b 'equal))) (make-weak-hash) - (raise-mismatch-error "make-hash-table: bad arguments: " (list a b)))])) + (raise-mismatch-error 'make-hash-table "bad arguments: " (list a b)))])) (define make-immutable-hash-table (case-lambda [(l) (make-immutable-hasheq l)] [(l a) (if (eq? a 'equal) (make-immutable-hash l) - (raise-mismatch-error "make-immutable-hash-table: bad argument: " a))])) - + (raise-mismatch-error 'make-immutable-hash-table "bad argument: " a))])) + (define hash-table? (case-lambda [(v) (hash? v)] @@ -78,7 +78,7 @@ (if (eq? a 'weak) (and (hash? v) (hash-weak? v)) - (raise-mismatch-error "hash-table?: bad argument: " a)))] + (raise-mismatch-error 'hash-table? "bad argument: " a)))] [(v a b) (if (or (and (eq? a 'equal) (eq? b 'weak)) (and (eq? a 'weak) @@ -86,4 +86,4 @@ (and (hash? v) (not (hash-eq? v)) (hash-weak? v)) - (raise-mismatch-error "hash-table?: bad arguments: " (list a b)))]))) + (raise-mismatch-error 'hash-table? "bad arguments: " (list a b)))]))) diff --git a/collects/scribblings/reference/evts.scrbl b/collects/scribblings/reference/evts.scrbl index 2eb1a1b112..60be3aefb8 100644 --- a/collects/scribblings/reference/evts.scrbl +++ b/collects/scribblings/reference/evts.scrbl @@ -38,129 +38,134 @@ types can generate events (see @scheme[prop:evt]). @itemize{ - @item{@scheme[semaphore] --- a semaphore is ready when + @item{@scheme[_semaphore] --- a semaphore is ready when @scheme[semaphore-wait] would not block. @ResultItself{semaphore}.} - @item{@scheme[semaphore-peek] --- a semaphore-peek event returned by - @scheme[semaphore-peek-evt] applied to @scheme[semaphore] is ready - exactly when @scheme[semaphore] is + @item{@scheme[_semaphore-peek] --- a semaphore-peek event returned by + @scheme[semaphore-peek-evt] applied to @scheme[_semaphore] is ready + exactly when @scheme[_semaphore] is ready. @ResultItself{semaphore-peek}.} - @item{@scheme[channel] --- a channel returned by + @item{@scheme[_channel] --- a channel returned by @scheme[make-channel] is ready when @scheme[channel-get] would not block. The channel's result as an event is the same as the @scheme[channel-get] result.} - @item{@scheme[channel-put] --- an event returned by - @scheme[channel-put-evt] applied to @scheme[channel] is ready when + @item{@scheme[_channel-put] --- an event returned by + @scheme[channel-put-evt] applied to @scheme[_channel] is ready when @scheme[channel-put] would not block on - @scheme[channel]. @ResultItself{channel-put}.} + @scheme[_channel]. @ResultItself{channel-put}.} - @item{@scheme[input-port] --- an input port is ready as an event when + @item{@scheme[_input-port] --- an input port is ready as an event when @scheme[read-byte] would not block. @ResultItself{input-port}.} - @item{@scheme[output-port] --- an output port is ready when + @item{@scheme[_output-port] --- an output port is ready when @scheme[write-bytes-avail] would not block or when the port contains buffered characters and @scheme[write-bytes-avail*] can flush part of the buffer (although @scheme[write-bytes-avail] might block). @ResultItself{output-port}.} - @item{@scheme[progress] --- an event produced by - @scheme[port-progress-evt] applied to @scheme[input-port] is ready after - any subsequent read from @scheme[input-port]. @ResultItself{progress}.} + @item{@scheme[_progress] --- an event produced by + @scheme[port-progress-evt] applied to @scheme[_input-port] is ready after + any subsequent read from @scheme[_input-port]. @ResultItself{progress}.} - @item{@scheme[tcp-listener] --- a TCP listener is ready when + @item{@scheme[_tcp-listener] --- a TCP listener is ready when @scheme[tcp-accept] would not block. @ResultItself{listener}.} - @item{@scheme[thd] --- a thread is ready when @scheme[thread-wait] + @item{@scheme[_thd] --- a thread is ready when @scheme[thread-wait] would not block. @ResultItself{thread}.} - @item{@scheme[thread-dead] --- an event returned by + @item{@scheme[_thread-dead] --- an event returned by @scheme[thread-dead-evt] applied to @scheme[thd] is ready when @scheme[thd] has terminated. @ResultItself{thread-dead}.} - @item{@scheme[thread-resume] --- an event returned by + @item{@scheme[_thread-resume] --- an event returned by @scheme[thread-resume-evt] applied to @scheme[thd] is ready when @scheme[thd] subsequently resumes execution (if it was not already running). The event's result is @scheme[thd].} - @item{@scheme[thread-suspend] --- an event returned by + @item{@scheme[_thread-suspend] --- an event returned by @scheme[thread-suspend-evt] applied to @scheme[thd] is ready when @scheme[thd] subsequently suspends execution (if it was not already suspended). The event's result is @scheme[thd].} - @item{@scheme[alarm] --- an event returned by @scheme[alarm-evt] is + @item{@scheme[_alarm] --- an event returned by @scheme[alarm-evt] is ready after a particular date and time. @ResultItself{alarm}.} - @item{@scheme[subprocess] --- a subprocess is ready when + @item{@scheme[_subprocess] --- a subprocess is ready when @scheme[subprocess-wait] would not block. @ResultItself{subprocess}.} - @item{@scheme[will-executor] --- a will executor is ready when + @item{@scheme[_will-executor] --- a will executor is ready when @scheme[will-execute] would not block. @ResultItself{will-executor}.} - @item{@scheme[udp] --- an event returned by @scheme[udp-send-evt] or + @item{@scheme[_udp] --- an event returned by @scheme[udp-send-evt] or @scheme[udp-receive!-evt] is ready when a send or receive on the original socket would block, respectively. @ResultItself{udp}.} - @item{@scheme[choice] --- an event returned by @scheme[choice-evt] is - ready when one or more of the @scheme[evt]s supplied to - @scheme[chocie-evt] are ready. If the choice event is chosen, one of - its ready @scheme[evt]s is chosen pseudo-randomly, and the result is - the chosen @scheme[evt]'s result.} + @item{@scheme[_log-receiver] --- a @tech{log receiver} as produced by + @scheme[make-log-receiver] is ready when a logged message is + available. The event's result is a vector, as described with + @scheme[make-log-receiver].} - @item{@scheme[wrap] --- an event returned by @scheme[wrap-evt] - applied to @scheme[evt] and @scheme[proc] is ready when @scheme[evt] is - ready. The event's result is obtained by a call to @scheme[proc] (with + @item{@scheme[_choice] --- an event returned by @scheme[choice-evt] is + ready when one or more of the @scheme[_evt]s supplied to + @scheme[chocie-evt] are ready. If the choice event is chosen, one of + its ready @scheme[_evt]s is chosen pseudo-randomly, and the result is + the chosen @scheme[_evt]'s result.} + + @item{@scheme[_wrap] --- an event returned by @scheme[wrap-evt] + applied to @scheme[_evt] and @scheme[_proc] is ready when @scheme[_evt] is + ready. The event's result is obtained by a call to @scheme[_proc] (with breaks disabled) on the result of @scheme[evt].} - @item{@scheme[handle] --- an event returned by @scheme[handle-evt] - applied to @scheme[evt] and @scheme[proc] is ready when @scheme[evt] is - ready. The event's result is obtained by a tail call to @scheme[proc] on - the result of @scheme[evt].} + @item{@scheme[_handle] --- an event returned by @scheme[handle-evt] + applied to @scheme[_evt] and @scheme[_proc] is ready when @scheme[_evt] is + ready. The event's result is obtained by a tail call to @scheme[_proc] on + the result of @scheme[_evt].} - @item{@elemtag["guard-evt"]{@scheme[guard]} --- an event returned by @scheme[guard-evt] applied - to @scheme[thunk] generates a new event every time that @scheme[guard] is + @item{@elemtag["guard-evt"]{@scheme[_guard]} --- an event returned by @scheme[guard-evt] applied + to @scheme[_thunk] generates a new event every time that @scheme[_guard] is used with @scheme[sync] (or whenever it is part of a choice event used with @scheme[sync], etc.); the generated event is the result of - calling @scheme[thunk] when the synchronization begins; if @scheme[thunk] - returns a non-event, then @scheme[thunk]'s result is replaced with an - event that is ready and whose result is @scheme[guard].} + calling @scheme[_thunk] when the synchronization begins; if @scheme[_thunk] + returns a non-event, then @scheme[_thunk]'s result is replaced with an + event that is ready and whose result is @scheme[_guard].} - @item{@elemtag["nack-guard-evt"]{@scheme[nack-guard]} --- an event - returned by @scheme[nack-guard-evt] applied to @scheme[proc] - generates a new event every time that @scheme[nack-guard] is used + @item{@elemtag["nack-guard-evt"]{@scheme[_nack-guard]} --- an event + returned by @scheme[nack-guard-evt] applied to @scheme[_proc] + generates a new event every time that @scheme[_nack-guard] is used with @scheme[sync] (or whenever it is part of a choice event used with @scheme[sync], etc.); the generated event is the result of - calling @scheme[proc] with a NACK (``negative acknowledgment'') event - when the synchronization begins; if @scheme[proc] returns a - non-event, then @scheme[proc]'s result is replaced with an event that - is ready and whose result is @scheme[nack-guard]. + calling @scheme[_proc] with a NACK (``negative acknowledgment'') event + when the synchronization begins; if @scheme[_proc] returns a + non-event, then @scheme[_proc]'s result is replaced with an event that + is ready and whose result is @scheme[_nack-guard]. - If the event from @scheme[proc] is not ultimately chosen as the - unblocked event, then the NACK event supplied to @scheme[proc] + If the event from @scheme[_proc] is not ultimately chosen as the + unblocked event, then the NACK event supplied to @scheme[_proc] becomes ready with a @|void-const| value. This NACK event becomes ready when the event is abandoned because some other event is chosen, because the synchronizing thread is dead, or because control escaped - from the call to @scheme[sync] (even if @scheme[nack-guard]'s @scheme[proc] - has not yet returned a value). If the event returned by @scheme[proc] is + from the call to @scheme[sync] (even if @scheme[_nack-guard]'s @scheme[_proc] + has not yet returned a value). If the event returned by @scheme[_proc] is chosen, then the NACK event never becomes ready.} - @item{@elemtag["poll-guard-evt"]{@scheme[poll-guard]} --- an event - returned by @scheme[poll-guard-evt] applied to @scheme[proc] + @item{@elemtag["poll-guard-evt"]{@scheme[_poll-guard]} --- an event + returned by @scheme[poll-guard-evt] applied to @scheme[_proc] generates a new event every time that @scheme[poll-guard] is used with @scheme[sync] (or whenever it is part of a choice event used with @scheme[sync], etc.); the generated event is the result of - calling @scheme[proc] with a boolean: @scheme[#t] if the event will + calling @scheme[_proc] with a boolean: @scheme[#t] if the event will be used for a poll, @scheme[#f] for a blocking synchronization. - If @scheme[#t] is supplied to @scheme[proc], if breaks are disabled, if + If @scheme[#t] is supplied to @scheme[_proc], if breaks are disabled, if the polling thread is not terminated, and if polling the resulting event produces a result, the event will certainly be chosen for its result.} - @item{@scheme[struct] --- a structure whose type has the + @item{@scheme[_struct] --- a structure whose type has the @scheme[prop:evt] property identifies/generates an event through the property.} @@ -169,7 +174,7 @@ types can generate events (see @scheme[prop:evt]). @item{@scheme[never-evt] --- a constant event that is never ready.} - @item{@elemtag["system-idle-evt"]{@scheme[idle]} --- an event + @item{@elemtag["system-idle-evt"]{@scheme[_idle]} --- an event produced by @scheme[system-idle-evt] is ready when, if this event were replaced by @scheme[never-evt], no thread in the system would be available to run. In other words, all threads must be suspended diff --git a/collects/scribblings/reference/logging.scrbl b/collects/scribblings/reference/logging.scrbl new file mode 100644 index 0000000000..8d57f4a796 --- /dev/null +++ b/collects/scribblings/reference/logging.scrbl @@ -0,0 +1,174 @@ +#lang scribble/doc +@(require "mz.ss" + (for-label scheme/cmdline)) + +@title[#:tag "logging"]{Logging} + +A @deftech{logger} accepts events that contain information to be +logged for interested parties. A @deftech{log receiver} represents an +interested party that receives logged events asynchronously. Each +event has a level of importance, and a @tech{log receiver} subscribes to +logging events at a certain level of importance and higher. The +levels, in decreasing order of importance, are @scheme['fatal], +@scheme['error], @scheme['warning], @scheme['info], and +@scheme['debug]. + +To help organize logged events, @tech{loggers} can be named and +hierarchical. Every event reported to a logger is also propagated to +its parent (if any), but the event message is prefixed with the name +(if any) of the logger to which is was originally reported. A logger +is not required to have a parent or name. + +On start-up, PLT Scheme creates an initial logger that is used to +record events from the core run-time system. For example, an +@scheme['info] event is reported for each garbage collection (see +@secref["gc-model"]). For this initial logger, two log receivers are +also created: one that writes events to the process's original error +output port, and one that writes events to the system log. The level +of written events in each case is system-specific, and the default can +be changed through command-line flags (@secref["mz-cmdline"]) or +through environment variables: + +@itemize{ + + @item{If the @indexed-envvar{PLTSTDERR} environment variable is + defined and is not overridden by a command-line flag, it + determines the level of the @tech{log receiver} that propagates + events to the original error port. The environment variable's value + should be @scheme["none"], @scheme["fatal"], @scheme["error"], + @scheme["warning"], @scheme["info"], or @scheme["debug"]. + + The default is @scheme["error"].} + + @item{If the @indexed-envvar{PLTSYSLOG} environment variable is + defined and is not overridden by a command-line flag, it + determines the level of the @tech{log receiver} that propagates + events to the system log. The possible values are the + same as for @envvar{PLTSYSLOG}. + + The default is @scheme["none"] for Unix or @scheme["error"] for + Windows and Mac OS X.} + +} + +The @scheme[current-logger] @tech{parameter} determines the +@deftech{current logger} that is used by forms such as +@scheme[log-warning]. On start-up, the initial value of this parameter +is the initial logger. The run-time system sometimes uses the current +logger to report events. For example, he bytecode compiler sometimes +reports @scheme['warning] events when it detects an expression that +would produce a run-time error if evaluated. + +@; ---------------------------------------- +@section{Creating Loggers} + +@defproc[(logger? [v any/c]) boolean?]{ + +Returns @scheme[#t] if @scheme[v] is a @tech{logger}, @scheme[#f] +otherwise.} + + +@defproc[(make-logger [name (or/c symbol? false/c) #f] + [parent (or/c logger? false/c) #f]) + logger?]{ + +Creates a new logger with an optional name and parent.} + + +@defproc[(logger-name [logger logger?]) (or/c symbol? false/c)]{ + +Reports @scheme[logger]'s name, if any.} + +@defparam[current-logger logger logger?]{ + +A @tech{parameter} that determines the @tech{current logger}.} + + +@; ---------------------------------------- +@section{Logging Events} + +@defproc[(log-message [logger logger?] + [level (one-of/c 'fatal 'error 'warning 'info 'debug)] + [message string?] + [data any/c]) + void?]{ + +Reports an event to @scheme[logger], which in turn distributes the +information to any @tech{log receivers} attached to @scheme[logger] or +its ancestors that are interested in events at @scheme[level] or +higher. + +If @scheme[logger] has a name, then @scheme[message] is prefixed with +the logger's name followed by @scheme[": "] before it is sent to +receivers.} + + +@defproc[(log-level? [logger logger?] + [level (one-of/c 'fatal 'error 'warning 'info 'debug)]) + boolean?]{ + +Reports whether any @tech{log receiver} attached to @scheme[logger] or +one of its ancestors is interested in @scheme[level] events (or +potentially lower). Use this function to avoid work generating an +event for @scheme[log-message] if no receiver is interested in the +information; this shortcut is built into @scheme[log-fatal], +@scheme[log-error], @scheme[log-warning], @scheme[log-info], and +@scheme[log-debug], however, so it should not be used with those +forms. + +The result of this function can change if a garbage collection +determines that a log receiver is no longer accessible (and therefore +that any event information it receives will never become accessible).} + +@deftogether[( +@defform[(log-fatal string-expr)] +@defform[(log-error string-expr)] +@defform[(log-warning string-expr)] +@defform[(log-info string-expr)] +@defform[(log-debug string-expr)] +)]{ + +Log an event with the @tech{current logger}, evaluating +@scheme[string-expr] only if the logger has receivers that are +interested in the event. In addition, the current continuation's +@tech{continuation marks} are sent to the logger with the message +string. + +For each @schemekeywordfont{log-}@scheme[_level], + +@schemeblock[ +(#, @schemekeywordfont{log-}_level string-expr) +] + +is equivalent to + +@schemeblock[ +(let ([l (current-logger)]) + (when (log-level? l '_level) + (log-message l '_level string-expr + (current-continuation-marks)))) +]} + +@; ---------------------------------------- +@section{Receiving Logged Events} + +@defproc[(log-receiver? [v any/c]) boolean?]{ + +Returns @scheme[#t] if @scheme[v] is a @tech{log receiver}, @scheme[#f] +otherwise.} + +@defproc[(make-log-receiver [logger logger?] + [level (one-of/c 'fatal 'error 'warning 'info 'debug)]) + log-receiver?]{ + +Creates a @tech{log receiver} to receive events of importance +@scheme[level] and higher as reported to @scheme[logger] and its +descendants. + +A @tech{log receiver} is a @tech{synchronizable event}. It becomes +ready as an @tech{synchronizable event} when a logging event is +received, so use @scheme[sync] to receive an logged event. The +@tech{log receiver}'s synchronization value is a vector containing +three values: the level of the event as a symbol, an immutable string +for the event message, and an arbitrary value that was supplied as the +last argument to @scheme[log-message] when the event was logged.} diff --git a/collects/scribblings/reference/module-reflect.scrbl b/collects/scribblings/reference/module-reflect.scrbl index cc8fd3a081..beb1e59952 100644 --- a/collects/scribblings/reference/module-reflect.scrbl +++ b/collects/scribblings/reference/module-reflect.scrbl @@ -301,24 +301,26 @@ import.} Dynamically instantiates the module specified by @scheme[mod] for @tech{phase} 0 in the current namespace's registry, if it is not yet -instantiated. If @scheme[mod] is not a symbol, the current +@tech{instantiate}d. If @scheme[mod] is not a symbol, the current @tech{module name resolver} may load a module declaration to resolve it (see @scheme[current-module-name-resolver]); the path is resolved relative to @scheme[current-load-relative-directory] and/or @scheme[current-directory]. -If @scheme[provided] is @scheme[#f], then the result is -@|void-const|. Otherwise, when @scheme[provided] is a symbol, the -value of the module's export with the given name is returned. If the -module exports @scheme[provide] as syntax, then a use of the binding -is expanded and evaluated (in a fresh namespace to which the module is -attached). If the module has no such exported variable or syntax, or -if the variable is protected (see @secref["modprotect"]), the -@exnraise[exn:fail:contract]. +If @scheme[provided] is @scheme[#f], then the result is @|void-const|, +and the module is not @tech{visit}ed (see +@secref["mod-parse"]). Otherwise, when @scheme[provided] is a symbol, +the value of the module's export with the given name is returned, and +still the module is not @tech{visit}ed. If the module exports +@scheme[provide] as syntax, then a use of the binding is expanded and +evaluated in a fresh namespace to which the module is attached, which +means that the module is @tech{visit}ed. If the module has no such +exported variable or syntax, or if the variable is protected (see +@secref["modprotect"]), the @exnraise[exn:fail:contract]. If @scheme[provided] is @|void-const|, then the module is -@tech{visit}ed (see @secref["mod-parse"]), but not -@tech{instantiate}d. The result is @|void-const|.} +@tech{visit}ed but not @tech{instantiate}d (see +@secref["mod-parse"]). The result is @|void-const|.} @defproc[(dynamic-require-for-syntax [mod module-path?] diff --git a/collects/scribblings/reference/namespaces.scrbl b/collects/scribblings/reference/namespaces.scrbl index 7f93336319..1cea41d408 100644 --- a/collects/scribblings/reference/namespaces.scrbl +++ b/collects/scribblings/reference/namespaces.scrbl @@ -256,10 +256,13 @@ registry}. The inspector of the module invocation in @scheme[dest-namespace] is the same as inspector of the invocation in @scheme[src-namespace]. -If @scheme[modname] does not refer to an instantiated module in +If @scheme[modname] does not refer to an @tech{instantiate}d module in @scheme[src-namespace], or if the name of any module to be attached already has a different declaration or instance in -@scheme[dest-namespace], then the @exnraise[exn:fail:contract]. +@scheme[dest-namespace], then the @exnraise[exn:fail:contract]. If +the module to attach has not been @tech{visit}ed (see +@secref["mod-parse"]), then it is @tech{visit}ed in the original +namespace before being attached. If @scheme[src-namespace] and @scheme[dest-namespace] do not have the same @tech{base phase}, then the @exnraise[exn:fail:contract].} diff --git a/collects/scribblings/reference/os.scrbl b/collects/scribblings/reference/os.scrbl index f236092b68..49fe1eda38 100644 --- a/collects/scribblings/reference/os.scrbl +++ b/collects/scribblings/reference/os.scrbl @@ -9,6 +9,7 @@ @include-section["filesystem.scrbl"] @include-section["networking.scrbl"] @include-section["subprocess.scrbl"] +@include-section["logging.scrbl"] @include-section["time.scrbl"] @include-section["runtime.scrbl"] @include-section["cmdline.scrbl"] diff --git a/collects/scribblings/reference/startup.scrbl b/collects/scribblings/reference/startup.scrbl index bd43741e88..fdc5561c4c 100644 --- a/collects/scribblings/reference/startup.scrbl +++ b/collects/scribblings/reference/startup.scrbl @@ -40,11 +40,11 @@ The core PLT Scheme run-time system is available in two main variants: @section[#:tag "init-actions"]{Initialization} On startup, the top-level environment contains no bindings---not even -for function application. Primitive modules with names that start with -@schemeidfont{#%} are defined, but they are not meant for direct use, -and the set of such modules can change. For example, the -@indexed-scheme['#%kernel] module is eventually used to bootstrap the -implemetation of @schememodname[scheme/base], and +@scheme[#%app] for function application. Primitive modules with names +that start with @schemeidfont{#%} are defined, but they are not meant +for direct use, and the set of such modules can change. For example, +the @indexed-scheme['#%kernel] module is eventually used to bootstrap +the implemetation of @schememodname[scheme/base], and @scheme['#%mred-kernel] is used for @schememodname[scheme/gui/base]. The first action of MzScheme or MrEd is to initialize @@ -250,6 +250,18 @@ flags: ports. This flag currently has no effect, because binary mode is always used.} + @item{@FlagFirst{W} @nonterm{level} or @DFlagFirst{warn} + @nonterm{level} : Sets the logging level for writing events to + the original error port. The possible @nonterm{level} values + are the same as for the @envvar{PLTSTDERR} environment + variable. See @secref["logging"] for more information.} + + @item{@FlagFirst{L} @nonterm{level} or @DFlagFirst{syslog} + @nonterm{level} : Sets the logging level for writing events to + the system log. The possible @nonterm{level} values + are the same as for the @envvar{PLTSYSLOG} environment + variable. See @secref["logging"] for more information.} + }} @item{Meta options: diff --git a/collects/srfi/19/time.ss b/collects/srfi/19/time.ss index 122ece94d8..033b7b6481 100644 --- a/collects/srfi/19/time.ss +++ b/collects/srfi/19/time.ss @@ -1233,7 +1233,8 @@ ((char=? ch #\8) 8) ((char=? ch #\9) 9) (else (tm:time-error 'bad-date-template-string - (list "Non-integer character" ch))))) + 'digit-char + ch)))) ;; read an integer upto n characters long on port; upto -> #f if any length (define (tm:integer-reader upto port) diff --git a/collects/tests/mzscheme/logger.ss b/collects/tests/mzscheme/logger.ss new file mode 100644 index 0000000000..da5a8d78c9 --- /dev/null +++ b/collects/tests/mzscheme/logger.ss @@ -0,0 +1,72 @@ + +(load-relative "loadtest.ss") + +(Section 'logger) + +; -------------------- + +(test #t logger? (current-logger)) +(test #f logger? 17) +(test #f logger? (make-log-receiver (current-logger) 'error)) +(test #t log-receiver? (make-log-receiver (current-logger) 'error)) +(test #f log-receiver? (current-logger)) + +(arity-test make-logger 0 2) + +; -------------------- + +(let ([l (make-logger 'test)] + [test-level (lambda (on? l level . lrs) + (test on? log-level? l level) + (for-each (lambda (lr) + (test #f sync/timeout 0 lr)) + lrs) + (log-message l level "message" 'data) + (for-each (lambda (lr) + (test (and on? + (vector level (format "~a: message" (logger-name l)) 'data)) + sync/timeout 0 lr)) + lrs))]) + (test #t logger? l) + (test 'test logger-name l) + (test-level #f l 'fatal) + (test-level #f l 'error) + (test-level #f l 'warning) + (test-level #f l 'info) + (test-level #f l 'debug) + (let ([lr (make-log-receiver l 'warning)]) + (test-level #t l 'fatal lr) + (test-level #t l 'error lr) + (test-level #t l 'warning lr) + (test-level #f l 'info lr) + (test-level #f l 'debug lr) + (let ([sub-l (make-logger 'test.sub l)]) + (test 'test logger-name l) + (test 'test.sub logger-name sub-l) + (test-level #t l 'fatal lr) + (test-level #t l 'error lr) + (test-level #t l 'warning lr) + (test-level #f l 'info lr) + (test-level #f l 'debug lr) + (test-level #t sub-l 'fatal lr) + (test-level #t sub-l 'error lr) + (test-level #t sub-l 'warning lr) + (test-level #f sub-l 'info lr) + (test-level #f sub-l 'debug lr) + (let ([lr2 (make-log-receiver sub-l 'info)]) + (test-level #t l 'fatal lr) + (test-level #t l 'error lr) + (test-level #t l 'warning lr) + (test-level #f l 'info lr) + (test-level #f l 'debug lr) + (test-level #t sub-l 'fatal lr lr2) + (test-level #t sub-l 'error lr lr2) + (test-level #t sub-l 'warning lr lr2) + (test-level #t sub-l 'info lr2) + (test-level #f sub-l 'debug lr lr2) + ;; Make sure they're not GCed before here: + (list lr lr2))))) + +; -------------------- + +(report-errs) diff --git a/collects/tests/mzscheme/mz.ss b/collects/tests/mzscheme/mz.ss index a6bfe07a1a..dfc0d5921f 100644 --- a/collects/tests/mzscheme/mz.ss +++ b/collects/tests/mzscheme/mz.ss @@ -16,6 +16,7 @@ (load-relative "unit.ss") (load-relative "unitsig.ss") (load-relative "thread.ss") +(load-relative "logger.ss") (load-relative "sync.ss") (load-relative "deep.ss") (load-relative "contmark.ss") diff --git a/collects/texpict/face.ss b/collects/texpict/face.ss index 9681082291..328c2d3cbb 100644 --- a/collects/texpict/face.ss +++ b/collects/texpict/face.ss @@ -249,7 +249,7 @@ (define (narrow-grimace flip?) (grimace - (* 1.2 w) (* h 0.9) (- (* 0.1 pi)) 15 + (* 1.2 w) (* h 0.9) (- (* 0.1 pi)) flip?)) (define (large-smile flip?) diff --git a/doc/release-notes/mzscheme/HISTORY.txt b/doc/release-notes/mzscheme/HISTORY.txt index 7713bc36be..01999c4757 100644 --- a/doc/release-notes/mzscheme/HISTORY.txt +++ b/doc/release-notes/mzscheme/HISTORY.txt @@ -1,3 +1,8 @@ +Version 4.1 +Changed namespaces to have a base phase; for example, calling + eval at compile-time uses a phase-1 namespace +Added logging facilities: make-logger, etc. + Version 4.0, June 2008 >> See MzScheme_4.txt diff --git a/src/mzscheme/cmdline.inc b/src/mzscheme/cmdline.inc index eafec6f24f..422cf2c6f5 100644 --- a/src/mzscheme/cmdline.inc +++ b/src/mzscheme/cmdline.inc @@ -381,6 +381,43 @@ static int finish_cmd_line_run(FinishArgs *fa, Repl_Proc repl) return exit_val; } +static int get_log_level(char *prog, char *real_switch, const char *envvar, const char *what, char *str) +{ + if (!strcmp(str, "none")) + return 0; + else if (!strcmp(str, "fatal")) + return SCHEME_LOG_FATAL; + else if (!strcmp(str, "error")) + return SCHEME_LOG_ERROR; + else if (!strcmp(str, "warning")) + return SCHEME_LOG_WARNING; + else if (!strcmp(str, "info")) + return SCHEME_LOG_INFO; + else if (!strcmp(str, "debug")) + return SCHEME_LOG_DEBUG; + + PRINTF("%s: %s level %s%s%s must be one of the following:\n" + " none fatal error warning info or debug\n" + " given: %s\n", + prog, what, + real_switch ? "after " : "in ", + real_switch ? real_switch : envvar, + real_switch ? " switch" : " envrionment variable", + str); + return -1; +} + +static int get_arg_log_level(char *prog, char *real_switch, const char *what, int argc, char **argv) +{ + if (argc < 2) { + PRINTF("%s: missing %s level after %s switch\n", + prog, what, real_switch); + return -1; + } + + return get_log_level(prog, real_switch, NULL, what, argv[1]); +} + #ifdef USE_OSKIT_CONSOLE /* Hack to disable normal input mode: */ int osk_not_console = 0; @@ -425,6 +462,7 @@ static int run_from_cmd_line(int argc, char *_argv[], int was_config_flag = 0, saw_nc_flag = 0; int no_compiled = 0; int init_ns = 0, no_init_ns = 0; + int syslog_level = -1, stderr_level = -1; FinishArgs *fa; FinishArgsAtoms *fa_a; @@ -629,6 +667,10 @@ static int run_from_cmd_line(int argc, char *_argv[], argv[0] = "-i"; else if (!strcmp("--binary", argv[0])) argv[0] = "-b"; + else if (!strcmp("--warn", argv[0])) + argv[0] = "-W"; + else if (!strcmp("--syslog", argv[0])) + argv[0] = "-L"; else if (!strcmp("--collects", argv[0])) argv[0] = "-X"; else if (!strcmp("--search", argv[0])) @@ -857,6 +899,22 @@ static int run_from_cmd_line(int argc, char *_argv[], osk_not_console = 1; break; #endif + case 'W': + stderr_level = get_arg_log_level(prog, real_switch, "stderr", argc, argv); + if (stderr_level < 0) + goto show_need_help; + --argc; + argv++; + was_config_flag = 1; + break; + case 'L': + syslog_level = get_arg_log_level(prog, real_switch, "syslog", argc, argv); + if (syslog_level < 0) + goto show_need_help; + --argc; + argv++; + was_config_flag = 1; + break; default: specific_switch[0] = *str; specific_switch[1] = 0; @@ -922,6 +980,25 @@ static int run_from_cmd_line(int argc, char *_argv[], } #endif /* DONT_PARSE_COMMAND_LINE */ +#ifdef GETENV_FUNCTION + if (syslog_level < 0) { + char *s; + s = getenv("PLTSYSLOG"); + if (s) { + syslog_level = get_log_level(prog, NULL, "PLTSYSLOG", "syslog", s); + } + } + if (stderr_level < 0) { + char *s; + s = getenv("PLTSTDERR"); + if (s) { + stderr_level = get_log_level(prog, NULL, "PLTSTDERR", "stderr", s); + } + } +#endif + + scheme_set_logging(syslog_level, stderr_level); + global_env = mk_basic_env(); sch_argv = scheme_make_vector(argc, NULL); @@ -1071,6 +1148,8 @@ static int run_from_cmd_line(int argc, char *_argv[], # endif " -d, --no-delay: Disable on-demand loading of syntax and code\n" " -b, --binary : Read stdin and write stdout/stderr in binary mode\n" + " -W , --warn : Set stderr logging to \n" + " -L , --syslog : Set syslog logging to \n" " Meta options:\n" " -- : No argument following this switch is used as a switch\n" " -h, --help : Show this information and exits, ignoring other options\n" diff --git a/src/mzscheme/gc2/compact.c b/src/mzscheme/gc2/compact.c index f0328bc02f..7f0ba951c4 100644 --- a/src/mzscheme/gc2/compact.c +++ b/src/mzscheme/gc2/compact.c @@ -147,6 +147,7 @@ static int current_mark_type; /********************* Client hooks *********************/ void (*GC_collect_start_callback)(void); void (*GC_collect_end_callback)(void); +void (*GC_collect_inform_callback)(int major_gc, long pre_used, long post_used); void (*GC_out_of_memory)(void); unsigned long (*GC_get_thread_stack_base)(void); diff --git a/src/mzscheme/gc2/gc2.h b/src/mzscheme/gc2/gc2.h index b225bc4b61..de13b72863 100644 --- a/src/mzscheme/gc2/gc2.h +++ b/src/mzscheme/gc2/gc2.h @@ -88,6 +88,7 @@ GC2_EXTERN void GC_register_thread(void *, void *); GC2_EXTERN void (*GC_collect_start_callback)(void); GC2_EXTERN void (*GC_collect_end_callback)(void); +GC2_EXTERN void (*GC_collect_inform_callback)(int major_gc, long pre_used, long post_used); /* Called by GC before/after performing a collection. Used by MzScheme to zero out some data and record collection times. The end diff --git a/src/mzscheme/gc2/newgc.c b/src/mzscheme/gc2/newgc.c index 1c214708b2..271a8a72e0 100644 --- a/src/mzscheme/gc2/newgc.c +++ b/src/mzscheme/gc2/newgc.c @@ -126,6 +126,7 @@ /* the externals */ void (*GC_collect_start_callback)(void); void (*GC_collect_end_callback)(void); +void (*GC_collect_inform_callback)(int major_gc, long pre_used, long post_used); void (*GC_out_of_memory)(void); unsigned long (*GC_get_thread_stack_base)(void); void (*GC_mark_xtagged)(void *obj); @@ -3026,7 +3027,7 @@ static void garbage_collect(int force_full) static unsigned int since_last_full = 0; static unsigned int running_finalizers = 0; static unsigned long last_full_mem_use = (20 * 1024 * 1024); - unsigned long old_mem_use = memory_in_use; + unsigned long old_mem_use = memory_in_use, old_gen0 = gen0_current_size; int next_gc_full; TIME_DECLS(); @@ -3177,8 +3178,10 @@ static void garbage_collect(int force_full) last_full_mem_use = memory_in_use; /* inform the system (if it wants us to) that we're done with collection */ - if(GC_collect_start_callback) + if (GC_collect_start_callback) GC_collect_end_callback(); + if (GC_collect_inform_callback) + GC_collect_inform_callback(gc_full, old_mem_use + old_gen0, memory_in_use); TIME_STEP("ended"); diff --git a/src/mzscheme/include/mzscheme.exp b/src/mzscheme/include/mzscheme.exp index 83143a1f62..4098fc1d40 100644 --- a/src/mzscheme/include/mzscheme.exp +++ b/src/mzscheme/include/mzscheme.exp @@ -75,6 +75,9 @@ scheme_signal_error scheme_raise_exn scheme_warning scheme_raise +scheme_log_level_p +scheme_log +scheme_log_message scheme_wrong_count scheme_wrong_count_m scheme_case_lambda_wrong_count diff --git a/src/mzscheme/include/mzscheme3m.exp b/src/mzscheme/include/mzscheme3m.exp index d1a36df235..685d1e3f4b 100644 --- a/src/mzscheme/include/mzscheme3m.exp +++ b/src/mzscheme/include/mzscheme3m.exp @@ -75,6 +75,9 @@ scheme_signal_error scheme_raise_exn scheme_warning scheme_raise +scheme_log_level_p +scheme_log +scheme_log_message scheme_wrong_count scheme_wrong_count_m scheme_case_lambda_wrong_count diff --git a/src/mzscheme/include/mzwin.def b/src/mzscheme/include/mzwin.def index 36296225bc..2db8f8349c 100644 --- a/src/mzscheme/include/mzwin.def +++ b/src/mzscheme/include/mzwin.def @@ -77,6 +77,9 @@ EXPORTS scheme_raise_exn scheme_warning scheme_raise + scheme_log_level_p + scheme_log + scheme_log_message scheme_wrong_count scheme_wrong_count_m scheme_case_lambda_wrong_count diff --git a/src/mzscheme/include/mzwin3m.def b/src/mzscheme/include/mzwin3m.def index e54eb7f36a..cf1c0bab7b 100644 --- a/src/mzscheme/include/mzwin3m.def +++ b/src/mzscheme/include/mzwin3m.def @@ -77,6 +77,9 @@ EXPORTS scheme_raise_exn scheme_warning scheme_raise + scheme_log_level_p + scheme_log + scheme_log_message scheme_wrong_count scheme_wrong_count_m scheme_case_lambda_wrong_count diff --git a/src/mzscheme/include/scheme.h b/src/mzscheme/include/scheme.h index 8cfb3be923..f166883a63 100644 --- a/src/mzscheme/include/scheme.h +++ b/src/mzscheme/include/scheme.h @@ -1010,7 +1010,7 @@ typedef struct Scheme_Thread { struct Scheme_Marshal_Tables *current_mt; - char skip_error; + Scheme_Object *constant_folding; /* compiler hack */ Scheme_Object *(*overflow_k)(void); Scheme_Object *overflow_reply; @@ -1210,6 +1210,8 @@ enum { MZCONFIG_EXPAND_OBSERVE, + MZCONFIG_LOGGER, + __MZCONFIG_BUILTIN_COUNT__ }; @@ -1330,6 +1332,14 @@ struct Scheme_Output_Port # include "../src/schexn.h" #endif +#define SCHEME_LOG_FATAL 1 +#define SCHEME_LOG_ERROR 2 +#define SCHEME_LOG_WARNING 3 +#define SCHEME_LOG_INFO 4 +#define SCHEME_LOG_DEBUG 5 + +typedef struct Scheme_Logger Scheme_Logger; + /*========================================================================*/ /* security */ /*========================================================================*/ @@ -1634,9 +1644,11 @@ MZ_EXTERN void scheme_set_binary_mode_stdio(int); MZ_EXTERN void scheme_set_startup_use_jit(int); MZ_EXTERN void scheme_set_startup_load_on_demand(int); MZ_EXTERN void scheme_set_ignore_user_paths(int); +MZ_EXTERN void scheme_set_logging(int syslog_level, int stderr_level); MZ_EXTERN int scheme_get_allow_set_undefined(); + MZ_EXTERN Scheme_Thread *scheme_current_thread; MZ_EXTERN Scheme_Thread *scheme_first_thread; diff --git a/src/mzscheme/sconfig.h b/src/mzscheme/sconfig.h index f9caa44cf8..2e1ad9d92a 100644 --- a/src/mzscheme/sconfig.h +++ b/src/mzscheme/sconfig.h @@ -509,6 +509,9 @@ # define GETENV_FUNCTION # define DIR_FUNCTION +# define USE_WINDOWS_EVENT_LOG +# define INIT_SYSLOG_LEVEL SCHEME_LOG_ERROR + # define DO_STACK_CHECK # define WINDOWS_FIND_STACK_BOUNDS @@ -651,6 +654,8 @@ # include "uconfig.h" +# define INIT_SYSLOG_LEVEL SCHEME_LOG_ERROR + # undef HAS_STANDARD_IOB # define HAS_BSD_IOB @@ -979,6 +984,13 @@ /* MKDIR_NO_MODE_FLAG specifies that mkdir() takes only one argument, instead of a directory name and mode flags. */ + /* USE_C_SYSLOG uses the C syslog library for logging. */ + + /* USE_WINDOWS_EVENT_LOG uses the Windows event log API for logging. */ + + /* INIT_SYSLOG_LEVEL sets the initial level for filtering messages + sent to syslog. It default to 0 (i.e., no events). */ + /***********************/ /* Ports */ /***********************/ diff --git a/src/mzscheme/src/cstartup.inc b/src/mzscheme/src/cstartup.inc index a6fd025629..786cf1d049 100644 --- a/src/mzscheme/src/cstartup.inc +++ b/src/mzscheme/src/cstartup.inc @@ -1,24 +1,24 @@ { - static MZCOMPILED_STRING_FAR unsigned char expr[] = {35,126,7,52,46,48,46,49,46,51,50,0,0,0,1,0,0,6,0,9,0, -16,0,20,0,25,0,38,0,41,0,46,0,53,0,60,0,64,0,69,0,78, + static MZCOMPILED_STRING_FAR unsigned char expr[] = {35,126,7,52,46,48,46,50,46,52,50,0,0,0,1,0,0,6,0,9,0, +13,0,18,0,25,0,32,0,37,0,42,0,55,0,59,0,66,0,69,0,78, 0,84,0,98,0,112,0,115,0,119,0,121,0,132,0,134,0,148,0,155,0, 177,0,179,0,193,0,253,0,23,1,32,1,41,1,51,1,68,1,107,1,146, 1,215,1,4,2,92,2,137,2,142,2,162,2,53,3,73,3,124,3,190,3, 75,4,233,4,20,5,31,5,110,5,0,0,118,7,0,0,65,98,101,103,105, -110,29,11,11,66,100,101,102,105,110,101,63,97,110,100,64,108,101,116,42,72, -112,97,114,97,109,101,116,101,114,105,122,101,62,111,114,64,99,111,110,100,66, -108,101,116,114,101,99,66,117,110,108,101,115,115,63,108,101,116,64,119,104,101, -110,68,104,101,114,101,45,115,116,120,65,113,117,111,116,101,29,94,2,14,68, +110,29,11,11,63,108,101,116,64,99,111,110,100,66,117,110,108,101,115,115,66, +100,101,102,105,110,101,64,119,104,101,110,64,108,101,116,42,72,112,97,114,97, +109,101,116,101,114,105,122,101,63,97,110,100,66,108,101,116,114,101,99,62,111, +114,68,104,101,114,101,45,115,116,120,65,113,117,111,116,101,29,94,2,14,68, 35,37,107,101,114,110,101,108,11,29,94,2,14,68,35,37,112,97,114,97,109, 122,11,62,105,102,63,115,116,120,61,115,70,108,101,116,45,118,97,108,117,101, 115,61,120,73,108,101,116,114,101,99,45,118,97,108,117,101,115,66,108,97,109, 98,100,97,1,20,112,97,114,97,109,101,116,101,114,105,122,97,116,105,111,110, 45,107,101,121,61,118,73,100,101,102,105,110,101,45,118,97,108,117,101,115,98, -10,35,11,8,182,216,94,159,2,16,35,35,159,2,15,35,35,16,20,2,3, -2,2,2,7,2,2,2,4,2,2,2,5,2,2,2,6,2,2,2,9,2, -2,2,8,2,2,2,10,2,2,2,11,2,2,2,12,2,2,97,36,11,8, -182,216,93,159,2,15,35,36,16,2,2,13,161,2,2,36,2,13,2,2,2, -13,97,10,11,11,8,182,216,16,0,97,10,37,11,8,182,216,16,0,13,16, +10,35,11,8,133,217,94,159,2,16,35,35,159,2,15,35,35,16,20,2,3, +2,2,2,5,2,2,2,6,2,2,2,7,2,2,2,8,2,2,2,9,2, +2,2,10,2,2,2,4,2,2,2,11,2,2,2,12,2,2,97,36,11,8, +133,217,93,159,2,15,35,36,16,2,2,13,161,2,2,36,2,13,2,2,2, +13,97,10,11,11,8,133,217,16,0,97,10,37,11,8,133,217,16,0,13,16, 4,35,29,11,11,2,2,11,18,98,64,104,101,114,101,8,31,8,30,8,29, 8,28,8,27,27,248,22,189,3,23,196,1,249,22,182,3,80,158,38,35,251, 22,73,2,17,248,22,88,23,200,2,12,249,22,63,2,1,248,22,90,23,202, @@ -26,16 +26,16 @@ 17,248,22,88,23,200,2,249,22,63,2,1,248,22,90,23,202,1,12,27,248, 22,65,248,22,189,3,23,197,1,28,248,22,71,23,194,2,20,15,159,36,35, 36,28,248,22,71,248,22,65,23,195,2,248,22,64,193,249,22,182,3,80,158, -38,35,251,22,73,2,17,248,22,64,23,200,2,249,22,63,2,4,248,22,65, +38,35,251,22,73,2,17,248,22,64,23,200,2,249,22,63,2,10,248,22,65, 23,202,1,11,18,100,10,8,31,8,30,8,29,8,28,8,27,16,4,11,11, -2,18,3,1,7,101,110,118,55,57,55,54,16,4,11,11,2,19,3,1,7, -101,110,118,55,57,55,55,27,248,22,65,248,22,189,3,23,197,1,28,248,22, +2,18,3,1,7,101,110,118,55,57,57,49,16,4,11,11,2,19,3,1,7, +101,110,118,55,57,57,50,27,248,22,65,248,22,189,3,23,197,1,28,248,22, 71,23,194,2,20,15,159,36,35,36,28,248,22,71,248,22,65,23,195,2,248, 22,64,193,249,22,182,3,80,158,38,35,250,22,73,2,20,248,22,73,249,22, 73,248,22,73,2,21,248,22,64,23,202,2,251,22,73,2,17,2,21,2,21, -249,22,63,2,7,248,22,65,23,205,1,18,100,11,8,31,8,30,8,29,8, -28,8,27,16,4,11,11,2,18,3,1,7,101,110,118,55,57,55,57,16,4, -11,11,2,19,3,1,7,101,110,118,55,57,56,48,248,22,189,3,193,27,248, +249,22,63,2,12,248,22,65,23,205,1,18,100,11,8,31,8,30,8,29,8, +28,8,27,16,4,11,11,2,18,3,1,7,101,110,118,55,57,57,52,16,4, +11,11,2,19,3,1,7,101,110,118,55,57,57,53,248,22,189,3,193,27,248, 22,189,3,194,249,22,63,248,22,73,248,22,64,196,248,22,65,195,27,248,22, 65,248,22,189,3,23,197,1,249,22,182,3,80,158,38,35,28,248,22,51,248, 22,183,3,248,22,64,23,198,2,27,249,22,2,32,0,89,162,8,44,36,42, @@ -49,7 +49,7 @@ 22,2,32,0,89,162,8,44,36,46,9,222,33,42,248,22,189,3,248,22,64, 201,248,22,65,198,27,248,22,65,248,22,189,3,196,27,248,22,189,3,248,22, 64,195,249,22,182,3,80,158,39,35,28,248,22,71,195,250,22,74,2,20,9, -248,22,65,199,250,22,73,2,11,248,22,73,248,22,64,199,250,22,74,2,5, +248,22,65,199,250,22,73,2,3,248,22,73,248,22,64,199,250,22,74,2,8, 248,22,65,201,248,22,65,202,27,248,22,65,248,22,189,3,23,197,1,27,249, 22,1,22,77,249,22,2,22,189,3,248,22,189,3,248,22,64,199,249,22,182, 3,80,158,39,35,251,22,73,1,22,119,105,116,104,45,99,111,110,116,105,110, @@ -61,12 +61,12 @@ 15,159,36,35,36,249,22,182,3,80,158,38,35,27,248,22,189,3,248,22,64, 23,198,2,28,249,22,150,8,62,61,62,248,22,183,3,248,22,88,23,197,2, 250,22,73,2,20,248,22,73,249,22,73,21,93,2,25,248,22,64,199,250,22, -74,2,8,249,22,73,2,25,249,22,73,248,22,97,203,2,25,248,22,65,202, +74,2,4,249,22,73,2,25,249,22,73,248,22,97,203,2,25,248,22,65,202, 251,22,73,2,17,28,249,22,150,8,248,22,183,3,248,22,64,23,201,2,64, 101,108,115,101,10,248,22,64,23,198,2,250,22,74,2,20,9,248,22,65,23, -201,1,249,22,63,2,8,248,22,65,23,203,1,99,8,31,8,30,8,29,8, -28,8,27,16,4,11,11,2,18,3,1,7,101,110,118,56,48,48,50,16,4, -11,11,2,19,3,1,7,101,110,118,56,48,48,51,18,158,94,10,64,118,111, +201,1,249,22,63,2,4,248,22,65,23,203,1,99,8,31,8,30,8,29,8, +28,8,27,16,4,11,11,2,18,3,1,7,101,110,118,56,48,49,55,16,4, +11,11,2,19,3,1,7,101,110,118,56,48,49,56,18,158,94,10,64,118,111, 105,100,8,47,27,248,22,65,248,22,189,3,196,249,22,182,3,80,158,38,35, 28,248,22,51,248,22,183,3,248,22,64,197,250,22,73,2,26,248,22,73,248, 22,64,199,248,22,88,198,27,248,22,183,3,248,22,64,197,250,22,73,2,26, @@ -78,28 +78,28 @@ 11,11,11,11,11,16,10,2,3,2,4,2,5,2,6,2,7,2,8,2,9, 2,10,2,11,2,12,35,45,36,11,11,16,0,16,0,16,0,35,35,11,11, 11,16,0,16,0,16,0,35,35,16,11,16,5,93,2,13,20,15,159,35,35, -35,35,20,103,159,35,16,0,16,1,33,32,10,16,5,93,2,10,89,162,8, +35,35,20,103,159,35,16,0,16,1,33,32,10,16,5,93,2,5,89,162,8, 44,36,52,9,223,0,33,33,35,20,103,159,35,16,1,20,25,159,36,2,2, -2,13,16,0,11,16,5,93,2,12,89,162,8,44,36,52,9,223,0,33,34, +2,13,16,0,11,16,5,93,2,7,89,162,8,44,36,52,9,223,0,33,34, 35,20,103,159,35,16,1,20,25,159,36,2,2,2,13,16,0,11,16,5,93, -2,4,89,162,8,44,36,52,9,223,0,33,35,35,20,103,159,35,16,1,20, -25,159,36,2,2,2,13,16,1,33,36,11,16,5,93,2,7,89,162,8,44, +2,10,89,162,8,44,36,52,9,223,0,33,35,35,20,103,159,35,16,1,20, +25,159,36,2,2,2,13,16,1,33,36,11,16,5,93,2,12,89,162,8,44, 36,55,9,223,0,33,37,35,20,103,159,35,16,1,20,25,159,36,2,2,2, -13,16,1,33,38,11,16,5,93,2,11,89,162,8,44,36,57,9,223,0,33, +13,16,1,33,38,11,16,5,93,2,3,89,162,8,44,36,57,9,223,0,33, 41,35,20,103,159,35,16,1,20,25,159,36,2,2,2,13,16,0,11,16,5, -93,2,9,89,162,8,44,36,52,9,223,0,33,43,35,20,103,159,35,16,1, -20,25,159,36,2,2,2,13,16,0,11,16,5,93,2,5,89,162,8,44,36, +93,2,11,89,162,8,44,36,52,9,223,0,33,43,35,20,103,159,35,16,1, +20,25,159,36,2,2,2,13,16,0,11,16,5,93,2,8,89,162,8,44,36, 53,9,223,0,33,44,35,20,103,159,35,16,1,20,25,159,36,2,2,2,13, -16,0,11,16,5,93,2,6,89,162,8,44,36,54,9,223,0,33,45,35,20, -103,159,35,16,1,20,25,159,36,2,2,2,13,16,0,11,16,5,93,2,8, +16,0,11,16,5,93,2,9,89,162,8,44,36,54,9,223,0,33,45,35,20, +103,159,35,16,1,20,25,159,36,2,2,2,13,16,0,11,16,5,93,2,4, 89,162,8,44,36,57,9,223,0,33,46,35,20,103,159,35,16,1,20,25,159, -36,2,2,2,13,16,1,33,48,11,16,5,93,2,3,89,162,8,44,36,53, +36,2,2,2,13,16,1,33,48,11,16,5,93,2,6,89,162,8,44,36,53, 9,223,0,33,49,35,20,103,159,35,16,1,20,25,159,36,2,2,2,13,16, 0,11,16,0,94,2,15,2,16,93,2,15,9,9,35,0}; EVAL_ONE_SIZED_STR((char *)expr, 2031); } { - static MZCOMPILED_STRING_FAR unsigned char expr[] = {35,126,7,52,46,48,46,49,46,51,59,0,0,0,1,0,0,3,0,16,0, + static MZCOMPILED_STRING_FAR unsigned char expr[] = {35,126,7,52,46,48,46,50,46,52,59,0,0,0,1,0,0,3,0,16,0, 21,0,38,0,53,0,71,0,87,0,97,0,115,0,135,0,151,0,169,0,200, 0,229,0,251,0,9,1,15,1,29,1,34,1,44,1,52,1,80,1,112,1, 157,1,202,1,226,1,9,2,11,2,68,2,158,3,199,3,33,5,137,5,241, @@ -131,173 +131,173 @@ 32,98,121,116,101,32,115,116,114,105,110,103,6,36,36,99,97,110,110,111,116, 32,97,100,100,32,97,32,115,117,102,102,105,120,32,116,111,32,97,32,114,111, 111,116,32,112,97,116,104,58,32,5,0,27,20,14,159,80,158,36,50,250,80, -158,39,51,249,22,27,11,80,158,41,50,22,158,12,10,248,22,134,5,23,196, +158,39,51,249,22,27,11,80,158,41,50,22,166,12,10,248,22,134,5,23,196, 2,28,248,22,176,5,23,194,2,12,87,94,248,22,153,8,23,194,1,248,80, 159,37,53,36,195,28,248,22,71,23,195,2,9,27,248,22,64,23,196,2,27, -28,248,22,139,13,23,195,2,23,194,1,28,248,22,138,13,23,195,2,249,22, -140,13,23,196,1,250,80,158,42,48,248,22,154,13,2,20,11,10,250,80,158, -40,48,248,22,154,13,2,20,23,197,1,10,28,23,193,2,249,22,63,248,22, -142,13,249,22,140,13,23,198,1,247,22,155,13,27,248,22,65,23,200,1,28, -248,22,71,23,194,2,9,27,248,22,64,23,195,2,27,28,248,22,139,13,23, -195,2,23,194,1,28,248,22,138,13,23,195,2,249,22,140,13,23,196,1,250, -80,158,47,48,248,22,154,13,2,20,11,10,250,80,158,45,48,248,22,154,13, -2,20,23,197,1,10,28,23,193,2,249,22,63,248,22,142,13,249,22,140,13, -23,198,1,247,22,155,13,248,80,159,45,52,36,248,22,65,23,199,1,87,94, +28,248,22,147,13,23,195,2,23,194,1,28,248,22,146,13,23,195,2,249,22, +148,13,23,196,1,250,80,158,42,48,248,22,162,13,2,20,11,10,250,80,158, +40,48,248,22,162,13,2,20,23,197,1,10,28,23,193,2,249,22,63,248,22, +150,13,249,22,148,13,23,198,1,247,22,163,13,27,248,22,65,23,200,1,28, +248,22,71,23,194,2,9,27,248,22,64,23,195,2,27,28,248,22,147,13,23, +195,2,23,194,1,28,248,22,146,13,23,195,2,249,22,148,13,23,196,1,250, +80,158,47,48,248,22,162,13,2,20,11,10,250,80,158,45,48,248,22,162,13, +2,20,23,197,1,10,28,23,193,2,249,22,63,248,22,150,13,249,22,148,13, +23,198,1,247,22,163,13,248,80,159,45,52,36,248,22,65,23,199,1,87,94, 23,193,1,248,80,159,43,52,36,248,22,65,23,197,1,87,94,23,193,1,27, 248,22,65,23,198,1,28,248,22,71,23,194,2,9,27,248,22,64,23,195,2, -27,28,248,22,139,13,23,195,2,23,194,1,28,248,22,138,13,23,195,2,249, -22,140,13,23,196,1,250,80,158,45,48,248,22,154,13,2,20,11,10,250,80, -158,43,48,248,22,154,13,2,20,23,197,1,10,28,23,193,2,249,22,63,248, -22,142,13,249,22,140,13,23,198,1,247,22,155,13,248,80,159,43,52,36,248, -22,65,23,199,1,248,80,159,41,52,36,248,22,65,196,27,248,22,179,12,23, +27,28,248,22,147,13,23,195,2,23,194,1,28,248,22,146,13,23,195,2,249, +22,148,13,23,196,1,250,80,158,45,48,248,22,162,13,2,20,11,10,250,80, +158,43,48,248,22,162,13,2,20,23,197,1,10,28,23,193,2,249,22,63,248, +22,150,13,249,22,148,13,23,198,1,247,22,163,13,248,80,159,43,52,36,248, +22,65,23,199,1,248,80,159,41,52,36,248,22,65,196,27,248,22,187,12,23, 195,2,28,23,193,2,192,87,94,23,193,1,28,248,22,145,6,23,195,2,27, -248,22,137,13,195,28,192,192,248,22,138,13,195,11,87,94,28,28,248,22,180, -12,23,195,2,10,27,248,22,179,12,23,196,2,28,23,193,2,192,87,94,23, -193,1,28,248,22,145,6,23,196,2,27,248,22,137,13,23,197,2,28,23,193, -2,192,87,94,23,193,1,248,22,138,13,23,197,2,11,12,250,22,180,8,76, +248,22,145,13,195,28,192,192,248,22,146,13,195,11,87,94,28,28,248,22,188, +12,23,195,2,10,27,248,22,187,12,23,196,2,28,23,193,2,192,87,94,23, +193,1,28,248,22,145,6,23,196,2,27,248,22,145,13,23,197,2,28,23,193, +2,192,87,94,23,193,1,248,22,146,13,23,197,2,11,12,250,22,180,8,76, 110,111,114,109,97,108,45,112,97,116,104,45,99,97,115,101,6,42,42,112,97, 116,104,32,40,102,111,114,32,97,110,121,32,115,121,115,116,101,109,41,32,111, 114,32,118,97,108,105,100,45,112,97,116,104,32,115,116,114,105,110,103,23,197, -2,28,28,248,22,180,12,23,195,2,249,22,150,8,248,22,181,12,23,197,2, +2,28,28,248,22,188,12,23,195,2,249,22,150,8,248,22,189,12,23,197,2, 2,21,249,22,150,8,247,22,164,7,2,21,27,28,248,22,145,6,23,196,2, -23,195,2,248,22,154,7,248,22,184,12,23,197,2,28,249,22,167,13,0,21, +23,195,2,248,22,154,7,248,22,128,13,23,197,2,28,249,22,175,13,0,21, 35,114,120,34,94,91,92,92,93,91,92,92,93,91,63,93,91,92,92,93,34, -23,195,2,28,248,22,145,6,195,248,22,187,12,195,194,27,248,22,184,6,23, -195,1,249,22,188,12,248,22,157,7,250,22,173,13,0,6,35,114,120,34,47, -34,28,249,22,167,13,0,22,35,114,120,34,91,47,92,92,93,91,46,32,93, -43,91,47,92,92,93,42,36,34,23,201,2,23,199,1,250,22,173,13,0,19, +23,195,2,28,248,22,145,6,195,248,22,131,13,195,194,27,248,22,184,6,23, +195,1,249,22,132,13,248,22,157,7,250,22,181,13,0,6,35,114,120,34,47, +34,28,249,22,175,13,0,22,35,114,120,34,91,47,92,92,93,91,46,32,93, +43,91,47,92,92,93,42,36,34,23,201,2,23,199,1,250,22,181,13,0,19, 35,114,120,34,91,32,46,93,43,40,91,47,92,92,93,42,41,36,34,23,202, -1,6,2,2,92,49,80,158,43,36,2,21,28,248,22,145,6,194,248,22,187, -12,194,193,87,94,28,27,248,22,179,12,23,196,2,28,23,193,2,192,87,94, -23,193,1,28,248,22,145,6,23,196,2,27,248,22,137,13,23,197,2,28,23, -193,2,192,87,94,23,193,1,248,22,138,13,23,197,2,11,12,250,22,180,8, -23,196,2,2,22,23,197,2,28,248,22,137,13,23,195,2,12,248,22,134,11, -249,22,143,10,248,22,174,6,250,22,129,7,2,23,23,200,1,23,201,1,247, -22,23,87,94,28,27,248,22,179,12,23,196,2,28,23,193,2,192,87,94,23, -193,1,28,248,22,145,6,23,196,2,27,248,22,137,13,23,197,2,28,23,193, -2,192,87,94,23,193,1,248,22,138,13,23,197,2,11,12,250,22,180,8,23, -196,2,2,22,23,197,2,28,248,22,137,13,23,195,2,12,248,22,134,11,249, -22,143,10,248,22,174,6,250,22,129,7,2,23,23,200,1,23,201,1,247,22, -23,87,94,87,94,28,27,248,22,179,12,23,196,2,28,23,193,2,192,87,94, -23,193,1,28,248,22,145,6,23,196,2,27,248,22,137,13,23,197,2,28,23, -193,2,192,87,94,23,193,1,248,22,138,13,23,197,2,11,12,250,22,180,8, -195,2,22,23,197,2,28,248,22,137,13,23,195,2,12,248,22,134,11,249,22, -143,10,248,22,174,6,250,22,129,7,2,23,199,23,201,1,247,22,23,249,22, -3,89,162,8,44,36,49,9,223,2,33,34,196,248,22,134,11,249,22,173,10, +1,6,2,2,92,49,80,158,43,36,2,21,28,248,22,145,6,194,248,22,131, +13,194,193,87,94,28,27,248,22,187,12,23,196,2,28,23,193,2,192,87,94, +23,193,1,28,248,22,145,6,23,196,2,27,248,22,145,13,23,197,2,28,23, +193,2,192,87,94,23,193,1,248,22,146,13,23,197,2,11,12,250,22,180,8, +23,196,2,2,22,23,197,2,28,248,22,145,13,23,195,2,12,248,22,142,11, +249,22,151,10,248,22,174,6,250,22,129,7,2,23,23,200,1,23,201,1,247, +22,23,87,94,28,27,248,22,187,12,23,196,2,28,23,193,2,192,87,94,23, +193,1,28,248,22,145,6,23,196,2,27,248,22,145,13,23,197,2,28,23,193, +2,192,87,94,23,193,1,248,22,146,13,23,197,2,11,12,250,22,180,8,23, +196,2,2,22,23,197,2,28,248,22,145,13,23,195,2,12,248,22,142,11,249, +22,151,10,248,22,174,6,250,22,129,7,2,23,23,200,1,23,201,1,247,22, +23,87,94,87,94,28,27,248,22,187,12,23,196,2,28,23,193,2,192,87,94, +23,193,1,28,248,22,145,6,23,196,2,27,248,22,145,13,23,197,2,28,23, +193,2,192,87,94,23,193,1,248,22,146,13,23,197,2,11,12,250,22,180,8, +195,2,22,23,197,2,28,248,22,145,13,23,195,2,12,248,22,142,11,249,22, +151,10,248,22,174,6,250,22,129,7,2,23,199,23,201,1,247,22,23,249,22, +3,89,162,8,44,36,49,9,223,2,33,34,196,248,22,142,11,249,22,181,10, 23,196,1,247,22,23,87,94,250,80,159,38,39,36,2,7,196,197,251,80,159, 39,41,36,2,7,32,0,89,162,8,44,36,44,9,222,33,36,197,198,32,38, 89,162,43,41,58,65,99,108,111,111,112,222,33,39,28,248,22,71,23,199,2, 87,94,23,198,1,248,23,196,1,251,22,129,7,2,24,23,199,1,28,248,22, -71,23,203,2,87,94,23,202,1,23,201,1,250,22,1,22,133,13,23,204,1, -23,205,1,23,198,1,27,249,22,133,13,248,22,64,23,202,2,23,199,2,28, -248,22,128,13,23,194,2,27,250,22,1,22,133,13,23,197,1,23,202,2,28, -248,22,128,13,23,194,2,192,87,94,23,193,1,27,248,22,65,23,202,1,28, +71,23,203,2,87,94,23,202,1,23,201,1,250,22,1,22,141,13,23,204,1, +23,205,1,23,198,1,27,249,22,141,13,248,22,64,23,202,2,23,199,2,28, +248,22,136,13,23,194,2,27,250,22,1,22,141,13,23,197,1,23,202,2,28, +248,22,136,13,23,194,2,192,87,94,23,193,1,27,248,22,65,23,202,1,28, 248,22,71,23,194,2,87,94,23,193,1,248,23,199,1,251,22,129,7,2,24, 23,202,1,28,248,22,71,23,206,2,87,94,23,205,1,23,204,1,250,22,1, -22,133,13,23,207,1,23,208,1,23,201,1,27,249,22,133,13,248,22,64,23, -197,2,23,202,2,28,248,22,128,13,23,194,2,27,250,22,1,22,133,13,23, -197,1,204,28,248,22,128,13,193,192,253,2,38,203,204,205,206,23,15,248,22, +22,141,13,23,207,1,23,208,1,23,201,1,27,249,22,141,13,248,22,64,23, +197,2,23,202,2,28,248,22,136,13,23,194,2,27,250,22,1,22,141,13,23, +197,1,204,28,248,22,136,13,193,192,253,2,38,203,204,205,206,23,15,248,22, 65,201,253,2,38,202,203,204,205,206,248,22,65,200,87,94,23,193,1,27,248, 22,65,23,201,1,28,248,22,71,23,194,2,87,94,23,193,1,248,23,198,1, 251,22,129,7,2,24,23,201,1,28,248,22,71,23,205,2,87,94,23,204,1, -23,203,1,250,22,1,22,133,13,23,206,1,23,207,1,23,200,1,27,249,22, -133,13,248,22,64,23,197,2,23,201,2,28,248,22,128,13,23,194,2,27,250, -22,1,22,133,13,23,197,1,203,28,248,22,128,13,193,192,253,2,38,202,203, +23,203,1,250,22,1,22,141,13,23,206,1,23,207,1,23,200,1,27,249,22, +141,13,248,22,64,23,197,2,23,201,2,28,248,22,136,13,23,194,2,27,250, +22,1,22,141,13,23,197,1,203,28,248,22,136,13,193,192,253,2,38,202,203, 204,205,206,248,22,65,201,253,2,38,201,202,203,204,205,248,22,65,200,27,247, -22,156,13,253,2,38,198,199,200,201,202,198,87,95,28,28,248,22,180,12,23, -194,2,10,27,248,22,179,12,23,195,2,28,23,193,2,192,87,94,23,193,1, -28,248,22,145,6,23,195,2,27,248,22,137,13,23,196,2,28,23,193,2,192, -87,94,23,193,1,248,22,138,13,23,196,2,11,12,252,22,180,8,23,200,2, +22,164,13,253,2,38,198,199,200,201,202,198,87,95,28,28,248,22,188,12,23, +194,2,10,27,248,22,187,12,23,195,2,28,23,193,2,192,87,94,23,193,1, +28,248,22,145,6,23,195,2,27,248,22,145,13,23,196,2,28,23,193,2,192, +87,94,23,193,1,248,22,146,13,23,196,2,11,12,252,22,180,8,23,200,2, 2,25,35,23,198,2,23,199,2,28,28,248,22,145,6,23,195,2,10,248,22, 133,7,23,195,2,87,94,23,194,1,12,252,22,180,8,23,200,2,2,26,36, -23,198,2,23,199,1,91,159,38,11,90,161,38,35,11,248,22,136,13,23,197, +23,198,2,23,199,1,91,159,38,11,90,161,38,35,11,248,22,144,13,23,197, 2,87,94,23,195,1,87,94,28,192,12,250,22,181,8,23,201,1,2,27,23, 199,1,249,22,7,194,195,91,159,37,11,90,161,37,35,11,87,95,28,28,248, -22,180,12,23,196,2,10,27,248,22,179,12,23,197,2,28,23,193,2,192,87, -94,23,193,1,28,248,22,145,6,23,197,2,27,248,22,137,13,23,198,2,28, -23,193,2,192,87,94,23,193,1,248,22,138,13,23,198,2,11,12,252,22,180, +22,188,12,23,196,2,10,27,248,22,187,12,23,197,2,28,23,193,2,192,87, +94,23,193,1,28,248,22,145,6,23,197,2,27,248,22,145,13,23,198,2,28, +23,193,2,192,87,94,23,193,1,248,22,146,13,23,198,2,11,12,252,22,180, 8,2,10,2,25,35,23,200,2,23,201,2,28,28,248,22,145,6,23,197,2, 10,248,22,133,7,23,197,2,12,252,22,180,8,2,10,2,26,36,23,200,2, -23,201,2,91,159,38,11,90,161,38,35,11,248,22,136,13,23,199,2,87,94, +23,201,2,91,159,38,11,90,161,38,35,11,248,22,144,13,23,199,2,87,94, 23,195,1,87,94,28,23,193,2,12,250,22,181,8,2,10,2,27,23,201,2, -249,22,7,23,195,1,23,196,1,27,249,22,189,12,250,22,172,13,0,18,35, -114,120,35,34,40,91,46,93,91,94,46,93,42,124,41,36,34,248,22,185,12, +249,22,7,23,195,1,23,196,1,27,249,22,133,13,250,22,180,13,0,18,35, +114,120,35,34,40,91,46,93,91,94,46,93,42,124,41,36,34,248,22,129,13, 23,201,1,28,248,22,145,6,23,203,2,249,22,157,7,23,204,1,8,63,23, -202,1,28,248,22,180,12,23,199,2,248,22,181,12,23,199,1,87,94,23,198, -1,247,22,182,12,28,248,22,179,12,194,249,22,133,13,195,194,192,91,159,37, -11,90,161,37,35,11,87,95,28,28,248,22,180,12,23,196,2,10,27,248,22, -179,12,23,197,2,28,23,193,2,192,87,94,23,193,1,28,248,22,145,6,23, -197,2,27,248,22,137,13,23,198,2,28,23,193,2,192,87,94,23,193,1,248, -22,138,13,23,198,2,11,12,252,22,180,8,2,11,2,25,35,23,200,2,23, +202,1,28,248,22,188,12,23,199,2,248,22,189,12,23,199,1,87,94,23,198, +1,247,22,190,12,28,248,22,187,12,194,249,22,141,13,195,194,192,91,159,37, +11,90,161,37,35,11,87,95,28,28,248,22,188,12,23,196,2,10,27,248,22, +187,12,23,197,2,28,23,193,2,192,87,94,23,193,1,28,248,22,145,6,23, +197,2,27,248,22,145,13,23,198,2,28,23,193,2,192,87,94,23,193,1,248, +22,146,13,23,198,2,11,12,252,22,180,8,2,11,2,25,35,23,200,2,23, 201,2,28,28,248,22,145,6,23,197,2,10,248,22,133,7,23,197,2,12,252, 22,180,8,2,11,2,26,36,23,200,2,23,201,2,91,159,38,11,90,161,38, -35,11,248,22,136,13,23,199,2,87,94,23,195,1,87,94,28,23,193,2,12, +35,11,248,22,144,13,23,199,2,87,94,23,195,1,87,94,28,23,193,2,12, 250,22,181,8,2,11,2,27,23,201,2,249,22,7,23,195,1,23,196,1,27, -249,22,189,12,249,22,143,7,250,22,173,13,0,9,35,114,120,35,34,91,46, -93,34,248,22,185,12,23,203,1,6,1,1,95,28,248,22,145,6,23,202,2, -249,22,157,7,23,203,1,8,63,23,201,1,28,248,22,180,12,23,199,2,248, -22,181,12,23,199,1,87,94,23,198,1,247,22,182,12,28,248,22,179,12,194, -249,22,133,13,195,194,192,249,247,22,132,6,194,11,248,80,158,36,46,9,27, -247,22,158,13,249,80,158,38,47,28,23,195,2,27,248,22,162,7,6,11,11, +249,22,133,13,249,22,143,7,250,22,181,13,0,9,35,114,120,35,34,91,46, +93,34,248,22,129,13,23,203,1,6,1,1,95,28,248,22,145,6,23,202,2, +249,22,157,7,23,203,1,8,63,23,201,1,28,248,22,188,12,23,199,2,248, +22,189,12,23,199,1,87,94,23,198,1,247,22,190,12,28,248,22,187,12,194, +249,22,141,13,195,194,192,249,247,22,132,6,194,11,248,80,158,36,46,9,27, +247,22,166,13,249,80,158,38,47,28,23,195,2,27,248,22,162,7,6,11,11, 80,76,84,67,79,76,76,69,67,84,83,28,192,192,6,0,0,6,0,0,27, -28,23,196,1,250,22,133,13,248,22,154,13,69,97,100,100,111,110,45,100,105, +28,23,196,1,250,22,141,13,248,22,162,13,69,97,100,100,111,110,45,100,105, 114,247,22,160,7,6,8,8,99,111,108,108,101,99,116,115,11,27,248,80,159, -41,52,36,249,22,77,23,202,1,248,22,73,248,22,154,13,72,99,111,108,108, +41,52,36,249,22,77,23,202,1,248,22,73,248,22,162,13,72,99,111,108,108, 101,99,116,115,45,100,105,114,28,23,194,2,249,22,63,23,196,1,23,195,1, -192,32,47,89,162,8,44,38,54,2,19,222,33,48,27,249,22,165,13,23,197, +192,32,47,89,162,8,44,38,54,2,19,222,33,48,27,249,22,173,13,23,197, 2,23,198,2,28,23,193,2,87,94,23,196,1,27,248,22,88,23,195,2,27, -27,248,22,97,23,197,1,27,249,22,165,13,23,201,2,23,196,2,28,23,193, +27,248,22,97,23,197,1,27,249,22,173,13,23,201,2,23,196,2,28,23,193, 2,87,94,23,194,1,27,248,22,88,23,195,2,27,250,2,47,23,203,2,23, 204,1,248,22,97,23,199,1,28,249,22,139,7,23,196,2,2,28,249,22,77, -23,202,2,194,249,22,63,248,22,188,12,23,197,1,23,195,1,87,95,23,199, +23,202,2,194,249,22,63,248,22,132,13,23,197,1,23,195,1,87,95,23,199, 1,23,193,1,28,249,22,139,7,23,196,2,2,28,249,22,77,23,200,2,9, -249,22,63,248,22,188,12,23,197,1,9,28,249,22,139,7,23,196,2,2,28, -249,22,77,197,194,87,94,23,196,1,249,22,63,248,22,188,12,23,197,1,194, +249,22,63,248,22,132,13,23,197,1,9,28,249,22,139,7,23,196,2,2,28, +249,22,77,197,194,87,94,23,196,1,249,22,63,248,22,132,13,23,197,1,194, 87,94,23,193,1,28,249,22,139,7,23,198,2,2,28,249,22,77,195,9,87, -94,23,194,1,249,22,63,248,22,188,12,23,199,1,9,87,95,28,28,248,22, +94,23,194,1,249,22,63,248,22,132,13,23,199,1,9,87,95,28,28,248,22, 133,7,194,10,248,22,145,6,194,12,250,22,180,8,2,14,6,21,21,98,121, 116,101,32,115,116,114,105,110,103,32,111,114,32,115,116,114,105,110,103,196,28, -28,248,22,72,195,249,22,4,22,179,12,196,11,12,250,22,180,8,2,14,6, +28,248,22,72,195,249,22,4,22,187,12,196,11,12,250,22,180,8,2,14,6, 13,13,108,105,115,116,32,111,102,32,112,97,116,104,115,197,250,2,47,197,195, 28,248,22,145,6,197,248,22,156,7,197,196,32,50,89,162,8,44,39,57,2, 19,222,33,53,32,51,89,162,8,44,38,54,70,102,111,117,110,100,45,101,120, -101,99,222,33,52,28,23,193,2,91,159,38,11,90,161,38,35,11,248,22,136, -13,23,199,2,87,95,23,195,1,23,194,1,27,28,23,198,2,27,248,22,141, -13,23,201,2,28,249,22,152,8,23,195,2,23,202,2,11,28,248,22,137,13, -23,194,2,250,2,51,23,201,2,23,202,2,249,22,133,13,23,200,2,23,198, +101,99,222,33,52,28,23,193,2,91,159,38,11,90,161,38,35,11,248,22,144, +13,23,199,2,87,95,23,195,1,23,194,1,27,28,23,198,2,27,248,22,149, +13,23,201,2,28,249,22,152,8,23,195,2,23,202,2,11,28,248,22,145,13, +23,194,2,250,2,51,23,201,2,23,202,2,249,22,141,13,23,200,2,23,198, 1,250,2,51,23,201,2,23,202,2,23,196,1,11,28,23,193,2,192,87,94, -23,193,1,27,28,248,22,179,12,23,196,2,27,249,22,133,13,23,198,2,23, -201,2,28,28,248,22,128,13,193,10,248,22,191,12,193,192,11,11,28,23,193, -2,192,87,94,23,193,1,28,23,199,2,11,27,248,22,141,13,23,202,2,28, -249,22,152,8,23,195,2,23,203,1,11,28,248,22,137,13,23,194,2,250,2, -51,23,202,1,23,203,1,249,22,133,13,23,201,1,23,198,1,250,2,51,201, -202,195,194,28,248,22,71,23,197,2,11,27,248,22,140,13,248,22,64,23,199, -2,27,249,22,133,13,23,196,1,23,197,2,28,248,22,191,12,23,194,2,250, +23,193,1,27,28,248,22,187,12,23,196,2,27,249,22,141,13,23,198,2,23, +201,2,28,28,248,22,136,13,193,10,248,22,135,13,193,192,11,11,28,23,193, +2,192,87,94,23,193,1,28,23,199,2,11,27,248,22,149,13,23,202,2,28, +249,22,152,8,23,195,2,23,203,1,11,28,248,22,145,13,23,194,2,250,2, +51,23,202,1,23,203,1,249,22,141,13,23,201,1,23,198,1,250,2,51,201, +202,195,194,28,248,22,71,23,197,2,11,27,248,22,148,13,248,22,64,23,199, +2,27,249,22,141,13,23,196,1,23,197,2,28,248,22,135,13,23,194,2,250, 2,51,198,199,195,87,94,23,193,1,27,248,22,65,23,200,1,28,248,22,71, -23,194,2,11,27,248,22,140,13,248,22,64,23,196,2,27,249,22,133,13,23, -196,1,23,200,2,28,248,22,191,12,23,194,2,250,2,51,201,202,195,87,94, +23,194,2,11,27,248,22,148,13,248,22,64,23,196,2,27,249,22,141,13,23, +196,1,23,200,2,28,248,22,135,13,23,194,2,250,2,51,201,202,195,87,94, 23,193,1,27,248,22,65,23,197,1,28,248,22,71,23,194,2,11,27,248,22, -140,13,248,22,64,195,27,249,22,133,13,23,196,1,202,28,248,22,191,12,193, +148,13,248,22,64,195,27,249,22,141,13,23,196,1,202,28,248,22,135,13,193, 250,2,51,204,205,195,251,2,50,204,205,206,248,22,65,199,87,95,28,27,248, -22,179,12,23,196,2,28,23,193,2,192,87,94,23,193,1,28,248,22,145,6, -23,196,2,27,248,22,137,13,23,197,2,28,23,193,2,192,87,94,23,193,1, -248,22,138,13,23,197,2,11,12,250,22,180,8,2,15,6,25,25,112,97,116, +22,187,12,23,196,2,28,23,193,2,192,87,94,23,193,1,28,248,22,145,6, +23,196,2,27,248,22,145,13,23,197,2,28,23,193,2,192,87,94,23,193,1, +248,22,146,13,23,197,2,11,12,250,22,180,8,2,15,6,25,25,112,97,116, 104,32,111,114,32,115,116,114,105,110,103,32,40,115,97,110,115,32,110,117,108, -41,23,197,2,28,28,23,195,2,28,27,248,22,179,12,23,197,2,28,23,193, -2,192,87,94,23,193,1,28,248,22,145,6,23,197,2,27,248,22,137,13,23, -198,2,28,23,193,2,192,87,94,23,193,1,248,22,138,13,23,198,2,11,248, -22,137,13,23,196,2,11,10,12,250,22,180,8,2,15,6,29,29,35,102,32, +41,23,197,2,28,28,23,195,2,28,27,248,22,187,12,23,197,2,28,23,193, +2,192,87,94,23,193,1,28,248,22,145,6,23,197,2,27,248,22,145,13,23, +198,2,28,23,193,2,192,87,94,23,193,1,248,22,146,13,23,198,2,11,248, +22,145,13,23,196,2,11,10,12,250,22,180,8,2,15,6,29,29,35,102,32, 111,114,32,114,101,108,97,116,105,118,101,32,112,97,116,104,32,111,114,32,115, -116,114,105,110,103,23,198,2,28,28,248,22,137,13,23,195,2,91,159,38,11, -90,161,38,35,11,248,22,136,13,23,198,2,249,22,150,8,194,68,114,101,108, +116,114,105,110,103,23,198,2,28,28,248,22,145,13,23,195,2,91,159,38,11, +90,161,38,35,11,248,22,144,13,23,198,2,249,22,150,8,194,68,114,101,108, 97,116,105,118,101,11,27,248,22,162,7,6,4,4,80,65,84,72,251,2,50, 23,199,1,23,200,1,23,201,1,28,23,197,2,27,249,80,158,43,47,23,200, -1,9,28,249,22,150,8,247,22,164,7,2,21,249,22,63,248,22,188,12,5, -1,46,23,195,1,192,9,27,248,22,140,13,23,196,1,28,248,22,191,12,193, +1,9,28,249,22,150,8,247,22,164,7,2,21,249,22,63,248,22,132,13,5, +1,46,23,195,1,192,9,27,248,22,148,13,23,196,1,28,248,22,135,13,193, 250,2,51,198,199,195,11,250,80,158,38,48,196,197,11,250,80,158,38,48,196, 11,11,87,94,249,22,137,6,247,22,178,4,195,248,22,152,5,249,22,162,3, 35,249,22,146,3,197,198,27,28,23,197,2,87,95,23,196,1,23,195,1,23, -197,1,87,94,23,197,1,27,248,22,154,13,2,20,27,249,80,158,40,48,23, +197,1,87,94,23,197,1,27,248,22,162,13,2,20,27,249,80,158,40,48,23, 196,1,11,27,27,248,22,165,3,23,200,1,28,192,192,35,27,27,248,22,165, 3,23,202,1,28,192,192,35,249,22,131,5,23,197,1,83,158,39,20,97,95, 89,162,8,44,35,47,9,224,3,2,33,57,23,195,1,23,196,1,27,248,22, @@ -331,7 +331,7 @@ 80,159,35,44,36,83,158,35,16,2,32,0,89,162,43,36,43,2,12,222,33, 44,80,159,35,45,36,83,158,35,16,2,83,158,38,20,96,95,2,13,89,162, 43,35,42,9,223,0,33,45,89,162,43,36,52,9,223,0,33,46,80,159,35, -46,36,83,158,35,16,2,27,248,22,161,13,248,22,156,7,27,28,249,22,150, +46,36,83,158,35,16,2,27,248,22,169,13,248,22,156,7,27,28,249,22,150, 8,247,22,164,7,2,21,6,1,1,59,6,1,1,58,250,22,129,7,6,14, 14,40,91,94,126,97,93,42,41,126,97,40,46,42,41,23,196,2,23,196,1, 89,162,8,44,37,47,2,14,223,0,33,49,80,159,35,47,36,83,158,35,16, @@ -343,12 +343,12 @@ EVAL_ONE_SIZED_STR((char *)expr, 5056); } { - static MZCOMPILED_STRING_FAR unsigned char expr[] = {35,126,7,52,46,48,46,49,46,51,8,0,0,0,1,0,0,6,0,19,0, + static MZCOMPILED_STRING_FAR unsigned char expr[] = {35,126,7,52,46,48,46,50,46,52,8,0,0,0,1,0,0,6,0,19,0, 34,0,48,0,62,0,76,0,111,0,0,0,241,0,0,0,65,113,117,111,116, 101,29,94,2,1,67,35,37,117,116,105,108,115,11,29,94,2,1,69,35,37, 110,101,116,119,111,114,107,11,29,94,2,1,68,35,37,112,97,114,97,109,122, 11,29,94,2,1,68,35,37,101,120,112,111,98,115,11,29,94,2,1,68,35, -37,107,101,114,110,101,108,11,98,10,35,11,8,184,218,97,159,2,2,35,35, +37,107,101,114,110,101,108,11,98,10,35,11,8,135,219,97,159,2,2,35,35, 159,2,3,35,35,159,2,4,35,35,159,2,5,35,35,159,2,6,35,35,16, 0,159,35,20,103,159,35,16,1,65,98,101,103,105,110,16,0,83,158,41,20, 100,137,69,35,37,98,117,105,108,116,105,110,29,11,11,10,10,18,96,11,42, @@ -360,7 +360,7 @@ EVAL_ONE_SIZED_STR((char *)expr, 278); } { - static MZCOMPILED_STRING_FAR unsigned char expr[] = {35,126,7,52,46,48,46,49,46,51,52,0,0,0,1,0,0,3,0,14,0, + static MZCOMPILED_STRING_FAR unsigned char expr[] = {35,126,7,52,46,48,46,50,46,52,52,0,0,0,1,0,0,3,0,14,0, 41,0,47,0,60,0,74,0,96,0,122,0,134,0,152,0,172,0,184,0,200, 0,223,0,3,1,8,1,13,1,18,1,23,1,54,1,58,1,66,1,74,1, 82,1,185,1,230,1,250,1,29,2,64,2,98,2,108,2,155,2,165,2,172, @@ -383,30 +383,30 @@ 101,45,110,97,109,101,45,114,101,115,111,108,118,101,114,63,108,105,98,67,105, 103,110,111,114,101,100,249,22,14,195,80,158,37,45,249,80,159,37,48,36,195, 10,27,28,23,195,2,28,249,22,150,8,23,197,2,80,158,38,46,87,94,23, -195,1,80,158,36,47,27,248,22,161,4,23,197,2,28,248,22,179,12,23,194, -2,91,159,38,11,90,161,38,35,11,248,22,136,13,23,197,1,87,95,83,160, +195,1,80,158,36,47,27,248,22,161,4,23,197,2,28,248,22,187,12,23,194, +2,91,159,38,11,90,161,38,35,11,248,22,144,13,23,197,1,87,95,83,160, 37,11,80,158,40,46,198,83,160,37,11,80,158,40,47,192,192,11,11,28,23, -193,2,192,87,94,23,193,1,27,247,22,133,6,28,192,192,247,22,155,13,20, +193,2,192,87,94,23,193,1,27,247,22,133,6,28,192,192,247,22,163,13,20, 14,159,80,158,35,39,250,80,158,38,40,249,22,27,11,80,158,40,39,22,133, -6,28,248,22,179,12,23,198,2,23,197,1,87,94,23,197,1,247,22,155,13, -247,194,250,22,133,13,23,197,1,23,199,1,249,80,158,42,38,23,198,1,2, -18,252,22,133,13,23,199,1,23,201,1,6,6,6,110,97,116,105,118,101,247, +6,28,248,22,187,12,23,198,2,23,197,1,87,94,23,197,1,247,22,163,13, +247,194,250,22,141,13,23,197,1,23,199,1,249,80,158,42,38,23,198,1,2, +18,252,22,141,13,23,199,1,23,201,1,6,6,6,110,97,116,105,118,101,247, 22,165,7,249,80,158,44,38,23,200,1,80,158,44,35,87,94,23,194,1,27, -23,194,1,27,250,22,150,13,196,11,32,0,89,162,8,44,35,40,9,222,11, -28,192,249,22,63,195,194,11,27,248,23,195,1,23,196,1,27,250,22,150,13, +23,194,1,27,250,22,158,13,196,11,32,0,89,162,8,44,35,40,9,222,11, +28,192,249,22,63,195,194,11,27,248,23,195,1,23,196,1,27,250,22,158,13, 196,11,32,0,89,162,8,44,35,40,9,222,11,28,192,249,22,63,195,194,11, -249,247,22,160,13,248,22,64,195,195,27,250,22,133,13,23,198,1,23,200,1, -249,80,158,43,38,23,199,1,2,18,27,250,22,150,13,196,11,32,0,89,162, +249,247,22,168,13,248,22,64,195,195,27,250,22,141,13,23,198,1,23,200,1, +249,80,158,43,38,23,199,1,2,18,27,250,22,158,13,196,11,32,0,89,162, 8,44,35,40,9,222,11,28,192,249,22,63,195,194,11,249,247,22,131,6,248, 22,64,195,195,249,247,22,131,6,194,195,87,94,28,248,80,158,36,37,23,195, 2,12,250,22,180,8,77,108,111,97,100,47,117,115,101,45,99,111,109,112,105, 108,101,100,6,25,25,112,97,116,104,32,111,114,32,118,97,108,105,100,45,112, 97,116,104,32,115,116,114,105,110,103,23,197,2,91,159,41,11,90,161,36,35, -11,28,248,22,139,13,23,201,2,23,200,1,27,247,22,133,6,28,23,193,2, -249,22,140,13,23,203,1,23,195,1,200,90,161,38,36,11,248,22,136,13,23, +11,28,248,22,147,13,23,201,2,23,200,1,27,247,22,133,6,28,23,193,2, +249,22,148,13,23,203,1,23,195,1,200,90,161,38,36,11,248,22,144,13,23, 194,2,87,94,23,196,1,90,161,36,39,11,28,249,22,150,8,23,196,2,68, 114,101,108,97,116,105,118,101,87,94,23,194,1,2,17,23,194,1,90,161,36, -40,11,247,22,157,13,27,89,162,43,36,49,62,122,111,225,7,5,3,33,27, +40,11,247,22,165,13,27,89,162,43,36,49,62,122,111,225,7,5,3,33,27, 27,89,162,43,36,51,9,225,8,6,4,33,28,27,249,22,5,89,162,8,44, 36,47,9,223,5,33,29,23,203,2,27,28,23,195,2,27,249,22,5,83,158, 39,20,97,94,89,162,8,44,36,47,9,223,5,33,30,23,198,1,23,205,2, @@ -419,11 +419,11 @@ 199,193,11,11,11,11,28,192,249,80,159,48,54,36,203,89,162,43,35,45,9, 224,15,2,33,33,249,80,159,48,54,36,203,89,162,43,35,44,9,224,15,7, 33,34,32,36,89,162,8,44,36,54,2,19,222,33,38,0,17,35,114,120,34, -94,40,46,42,63,41,47,40,46,42,41,36,34,27,249,22,165,13,2,37,23, +94,40,46,42,63,41,47,40,46,42,41,36,34,27,249,22,173,13,2,37,23, 196,2,28,23,193,2,87,94,23,194,1,249,22,63,248,22,88,23,196,2,27, -248,22,97,23,197,1,27,249,22,165,13,2,37,23,196,2,28,23,193,2,87, +248,22,97,23,197,1,27,249,22,173,13,2,37,23,196,2,28,23,193,2,87, 94,23,194,1,249,22,63,248,22,88,23,196,2,27,248,22,97,23,197,1,27, -249,22,165,13,2,37,23,196,2,28,23,193,2,87,94,23,194,1,249,22,63, +249,22,173,13,2,37,23,196,2,28,23,193,2,87,94,23,194,1,249,22,63, 248,22,88,23,196,2,248,2,36,248,22,97,23,197,1,248,22,73,194,248,22, 73,194,248,22,73,194,32,39,89,162,43,36,54,2,19,222,33,40,28,248,22, 71,248,22,65,23,195,2,249,22,7,9,248,22,64,195,91,159,37,11,90,161, @@ -437,80 +437,80 @@ 2,39,193,87,95,28,248,22,159,4,195,12,250,22,180,8,2,20,6,20,20, 114,101,115,111,108,118,101,100,45,109,111,100,117,108,101,45,112,97,116,104,197, 28,24,193,2,248,24,194,1,195,87,94,23,193,1,12,27,27,250,22,133,2, -80,158,41,42,248,22,185,13,247,22,162,11,11,28,23,193,2,192,87,94,23, -193,1,27,247,22,121,87,94,250,22,131,2,80,158,42,42,248,22,185,13,247, -22,162,11,195,192,250,22,131,2,195,198,66,97,116,116,97,99,104,251,211,197, +80,158,41,42,248,22,129,14,247,22,170,11,11,28,23,193,2,192,87,94,23, +193,1,27,247,22,121,87,94,250,22,131,2,80,158,42,42,248,22,129,14,247, +22,170,11,195,192,250,22,131,2,195,198,66,97,116,116,97,99,104,251,211,197, 198,199,10,28,192,250,22,179,8,11,196,195,248,22,177,8,194,28,249,22,151, 6,194,6,1,1,46,2,17,28,249,22,151,6,194,6,2,2,46,46,62,117, 112,192,28,249,22,152,8,248,22,65,23,200,2,23,197,1,28,249,22,150,8, 248,22,64,23,200,2,23,196,1,251,22,177,8,2,20,6,26,26,99,121,99, 108,101,32,105,110,32,108,111,97,100,105,110,103,32,97,116,32,126,101,58,32, 126,101,23,200,1,249,22,2,22,65,248,22,78,249,22,63,23,206,1,23,202, -1,12,12,247,192,20,14,159,80,158,39,44,249,22,63,247,22,162,11,23,197, +1,12,12,247,192,20,14,159,80,158,39,44,249,22,63,247,22,170,11,23,197, 1,20,14,159,80,158,39,39,250,80,158,42,40,249,22,27,11,80,158,44,39, -22,142,4,23,196,1,249,247,22,132,6,23,198,1,248,22,52,248,22,183,12, -23,198,1,87,94,28,28,248,22,179,12,23,197,2,10,248,22,164,4,23,197, +22,142,4,23,196,1,249,247,22,132,6,23,198,1,248,22,52,248,22,191,12, +23,198,1,87,94,28,28,248,22,187,12,23,197,2,10,248,22,164,4,23,197, 2,12,28,23,198,2,250,22,179,8,11,6,15,15,98,97,100,32,109,111,100, 117,108,101,32,112,97,116,104,23,201,2,250,22,180,8,2,20,6,19,19,109, 111,100,117,108,101,45,112,97,116,104,32,111,114,32,112,97,116,104,23,199,2, 28,28,248,22,61,23,197,2,249,22,150,8,248,22,64,23,199,2,2,4,11, 248,22,160,4,248,22,88,197,28,28,248,22,61,23,197,2,249,22,150,8,248, 22,64,23,199,2,66,112,108,97,110,101,116,11,87,94,28,207,12,20,14,159, -80,158,37,39,250,80,158,40,40,249,22,27,11,80,158,42,39,22,162,11,23, +80,158,37,39,250,80,158,40,40,249,22,27,11,80,158,42,39,22,170,11,23, 197,1,90,161,36,35,10,249,22,143,4,21,94,2,21,6,18,18,112,108,97, 110,101,116,47,114,101,115,111,108,118,101,114,46,115,115,1,27,112,108,97,110, 101,116,45,109,111,100,117,108,101,45,110,97,109,101,45,114,101,115,111,108,118, 101,114,12,251,211,199,200,201,202,87,94,23,193,1,27,89,162,8,44,36,45, 79,115,104,111,119,45,99,111,108,108,101,99,116,105,111,110,45,101,114,114,223, 6,33,44,27,28,248,22,51,23,199,2,27,250,22,133,2,80,158,43,43,249, -22,63,23,204,2,247,22,156,13,11,28,23,193,2,192,87,94,23,193,1,91, +22,63,23,204,2,247,22,164,13,11,28,23,193,2,192,87,94,23,193,1,91, 159,37,11,90,161,37,35,11,249,80,159,44,48,36,248,22,54,23,204,2,11, 27,251,80,158,47,50,2,20,23,202,1,28,248,22,71,23,199,2,23,199,2, 248,22,64,23,199,2,28,248,22,71,23,199,2,9,248,22,65,23,199,2,249, -22,133,13,23,195,1,28,248,22,71,23,197,1,87,94,23,197,1,6,7,7, +22,141,13,23,195,1,28,248,22,71,23,197,1,87,94,23,197,1,6,7,7, 109,97,105,110,46,115,115,249,22,168,6,23,199,1,6,3,3,46,115,115,28, 248,22,145,6,23,199,2,87,94,23,194,1,27,248,80,159,41,55,36,23,201, 2,27,250,22,133,2,80,158,44,43,249,22,63,23,205,2,23,199,2,11,28, 23,193,2,192,87,94,23,193,1,91,159,37,11,90,161,37,35,11,249,80,159, -45,48,36,23,204,2,11,250,22,1,22,133,13,23,199,1,249,22,77,249,22, +45,48,36,23,204,2,11,250,22,1,22,141,13,23,199,1,249,22,77,249,22, 2,32,0,89,162,8,44,36,43,9,222,33,45,23,200,1,248,22,73,23,200, -1,28,248,22,179,12,23,199,2,87,94,23,194,1,28,248,22,138,13,23,199, +1,28,248,22,187,12,23,199,2,87,94,23,194,1,28,248,22,146,13,23,199, 2,23,198,2,248,22,73,6,26,26,32,40,97,32,112,97,116,104,32,109,117, 115,116,32,98,101,32,97,98,115,111,108,117,116,101,41,28,249,22,150,8,248, 22,64,23,201,2,2,21,27,250,22,133,2,80,158,43,43,249,22,63,23,204, -2,247,22,156,13,11,28,23,193,2,192,87,94,23,193,1,91,159,38,11,90, +2,247,22,164,13,11,28,23,193,2,192,87,94,23,193,1,91,159,38,11,90, 161,37,35,11,249,80,159,45,48,36,248,22,88,23,205,2,11,90,161,36,37, -11,28,248,22,71,248,22,90,23,204,2,28,248,22,71,23,194,2,249,22,167, +11,28,248,22,71,248,22,90,23,204,2,28,248,22,71,23,194,2,249,22,175, 13,0,8,35,114,120,34,91,46,93,34,23,196,2,11,10,27,27,28,23,197, 2,249,22,77,28,248,22,71,248,22,90,23,208,2,21,93,6,5,5,109,122, 108,105,98,249,22,1,22,77,249,22,2,80,159,51,56,36,248,22,90,23,211, 2,23,197,2,28,248,22,71,23,196,2,248,22,73,23,197,2,23,195,2,251, 80,158,49,50,2,20,23,204,1,248,22,64,23,198,2,248,22,65,23,198,1, -249,22,133,13,23,195,1,28,23,198,1,87,94,23,196,1,23,197,1,28,248, +249,22,141,13,23,195,1,28,23,198,1,87,94,23,196,1,23,197,1,28,248, 22,71,23,197,1,87,94,23,197,1,6,7,7,109,97,105,110,46,115,115,28, -249,22,167,13,0,8,35,114,120,34,91,46,93,34,23,199,2,23,197,1,249, +249,22,175,13,0,8,35,114,120,34,91,46,93,34,23,199,2,23,197,1,249, 22,168,6,23,199,1,6,3,3,46,115,115,28,249,22,150,8,248,22,64,23, -201,2,64,102,105,108,101,249,22,140,13,248,22,144,13,248,22,88,23,202,2, -248,80,159,42,55,36,23,202,2,12,87,94,28,28,248,22,179,12,23,194,2, +201,2,64,102,105,108,101,249,22,148,13,248,22,152,13,248,22,88,23,202,2, +248,80,159,42,55,36,23,202,2,12,87,94,28,28,248,22,187,12,23,194,2, 10,248,22,167,7,23,194,2,87,94,23,200,1,12,28,23,200,2,250,22,179, 8,67,114,101,113,117,105,114,101,249,22,129,7,6,17,17,98,97,100,32,109, 111,100,117,108,101,32,112,97,116,104,126,97,28,23,198,2,248,22,64,23,199, 2,6,0,0,23,203,1,87,94,23,200,1,250,22,180,8,2,20,249,22,129, 7,6,13,13,109,111,100,117,108,101,32,112,97,116,104,126,97,28,23,198,2, 248,22,64,23,199,2,6,0,0,23,201,2,27,28,248,22,167,7,23,195,2, -249,22,172,7,23,196,2,35,249,22,142,13,248,22,143,13,23,197,2,11,27, +249,22,172,7,23,196,2,35,249,22,150,13,248,22,151,13,23,197,2,11,27, 28,248,22,167,7,23,196,2,249,22,172,7,23,197,2,36,248,80,158,42,51, 23,195,2,91,159,38,11,90,161,38,35,11,28,248,22,167,7,23,199,2,250, -22,7,2,22,249,22,172,7,23,203,2,37,2,22,248,22,136,13,23,198,2, +22,7,2,22,249,22,172,7,23,203,2,37,2,22,248,22,144,13,23,198,2, 87,95,23,195,1,23,193,1,27,28,248,22,167,7,23,200,2,249,22,172,7, 23,201,2,38,249,80,158,47,52,23,197,2,5,0,27,28,248,22,167,7,23, 201,2,249,22,172,7,23,202,2,39,248,22,160,4,23,200,2,27,27,250,22, -133,2,80,158,51,42,248,22,185,13,247,22,162,11,11,28,23,193,2,192,87, -94,23,193,1,27,247,22,121,87,94,250,22,131,2,80,158,52,42,248,22,185, -13,247,22,162,11,195,192,87,95,28,23,209,1,27,250,22,133,2,23,197,2, +133,2,80,158,51,42,248,22,129,14,247,22,170,11,11,28,23,193,2,192,87, +94,23,193,1,27,247,22,121,87,94,250,22,131,2,80,158,52,42,248,22,129, +14,247,22,170,11,195,192,87,95,28,23,209,1,27,250,22,133,2,23,197,2, 197,11,28,23,193,1,12,87,95,27,27,28,248,22,17,80,158,51,45,80,158, 50,45,247,22,19,250,22,25,248,22,23,23,197,2,80,158,53,44,23,196,1, -27,247,22,162,11,249,22,3,83,158,39,20,97,94,89,162,8,44,36,54,9, +27,247,22,170,11,249,22,3,83,158,39,20,97,94,89,162,8,44,36,54,9, 226,12,11,2,3,33,46,23,195,1,23,196,1,248,28,248,22,17,80,158,50, 45,32,0,89,162,43,36,41,9,222,33,47,80,159,49,57,36,89,162,43,35, 50,9,227,14,9,8,4,3,33,48,250,22,131,2,23,197,1,197,10,12,28, @@ -518,12 +518,12 @@ 248,22,61,23,208,2,249,22,150,8,248,22,64,23,210,2,2,21,11,250,22, 131,2,80,158,50,43,28,248,22,145,6,23,210,2,249,22,63,23,211,1,248, 80,159,53,55,36,23,213,1,87,94,23,210,1,249,22,63,23,211,1,247,22, -156,13,252,22,169,7,23,208,1,23,207,1,23,205,1,23,203,1,201,12,193, +164,13,252,22,169,7,23,208,1,23,207,1,23,205,1,23,203,1,201,12,193, 91,159,37,10,90,161,36,35,10,11,90,161,36,36,10,83,158,38,20,96,96, 2,20,89,162,8,44,36,50,9,224,2,0,33,42,89,162,43,38,48,9,223, 1,33,43,89,162,43,39,8,30,9,225,2,3,0,33,49,208,87,95,248,22, -141,4,248,80,158,37,49,247,22,162,11,248,22,132,6,80,158,36,36,248,22, -153,12,80,159,36,41,36,159,35,20,103,159,35,16,1,65,98,101,103,105,110, +141,4,248,80,158,37,49,247,22,170,11,248,22,132,6,80,158,36,36,248,22, +161,12,80,159,36,41,36,159,35,20,103,159,35,16,1,65,98,101,103,105,110, 16,0,83,158,41,20,100,137,66,35,37,98,111,111,116,2,1,11,10,10,36, 80,158,35,35,20,103,159,39,16,19,30,2,1,2,2,193,30,2,1,2,3, 193,30,2,5,72,112,97,116,104,45,115,116,114,105,110,103,63,10,30,2,5, diff --git a/src/mzscheme/src/env.c b/src/mzscheme/src/env.c index c48319c042..a4a57d461a 100644 --- a/src/mzscheme/src/env.c +++ b/src/mzscheme/src/env.c @@ -3237,6 +3237,7 @@ Optimize_Info *scheme_optimize_info_add_frame(Optimize_Info *info, int orig, int naya->letrec_not_twice = info->letrec_not_twice; naya->enforce_const = info->enforce_const; naya->top_level_consts = info->top_level_consts; + naya->context = info->context; return naya; } diff --git a/src/mzscheme/src/error.c b/src/mzscheme/src/error.c index e420d7f8c6..36d2b1a5ce 100644 --- a/src/mzscheme/src/error.c +++ b/src/mzscheme/src/error.c @@ -28,6 +28,10 @@ #ifdef DOS_FILE_SYSTEM # include #endif +#ifdef USE_C_SYSLOG +# include +# include +#endif #define mzVA_ARG(x, y) HIDE_FROM_XFORM(va_arg(x, y)) #define TMP_CMARK_VALUE scheme_parameterization_key @@ -40,6 +44,8 @@ void (*scheme_console_output)(char *str, long len); Scheme_Exit_Proc scheme_exit; void scheme_set_exit(Scheme_Exit_Proc p) { scheme_exit = p; } +Scheme_Logger *scheme_main_logger; + #ifdef MEMORY_COUNTING_ON long scheme_misc_count; #endif @@ -64,10 +70,23 @@ static Scheme_Object *emergency_error_display_proc(int, Scheme_Object *[]); static Scheme_Object *def_error_value_string_proc(int, Scheme_Object *[]); static Scheme_Object *def_exit_handler_proc(int, Scheme_Object *[]); +static Scheme_Object *log_message(int argc, Scheme_Object *argv[]); +static Scheme_Object *log_level_p(int argc, Scheme_Object *argv[]); +static Scheme_Object *make_logger(int argc, Scheme_Object *argv[]); +static Scheme_Object *logger_p(int argc, Scheme_Object *argv[]); +static Scheme_Object *current_logger(int argc, Scheme_Object *argv[]); +static Scheme_Object *logger_name(int argc, Scheme_Object *argv[]); +static Scheme_Object *make_log_reader(int argc, Scheme_Object *argv[]); +static Scheme_Object *log_reader_p(int argc, Scheme_Object *argv[]); +static int log_reader_get(Scheme_Object *ch, Scheme_Schedule_Info *sinfo); + static Scheme_Object *do_raise(Scheme_Object *arg, int need_debug, int barrier); static Scheme_Object *nested_exn_handler(void *old_exn, int argc, Scheme_Object *argv[]); +static Scheme_Logger *make_a_logger(Scheme_Logger *parent, Scheme_Object *name); +static void update_want_level(Scheme_Logger *logger); + static Scheme_Object *def_err_val_proc; static Scheme_Object *def_error_esc_proc; static Scheme_Object *default_display_handler, *emergency_display_handler; @@ -82,6 +101,19 @@ static char *init_buf(long *len, long *blen); static char *prepared_buf; static long prepared_buf_len; +static Scheme_Object *fatal_symbol, *error_symbol, *warning_symbol, *info_symbol, *debug_symbol; +#ifndef INIT_SYSLOG_LEVEL +# define INIT_SYSLOG_LEVEL 0 +#endif +static int init_syslog_level = INIT_SYSLOG_LEVEL, init_stderr_level = SCHEME_LOG_ERROR; +void scheme_set_logging(int syslog_level, int stderr_level) +{ + if (syslog_level > -1) + init_syslog_level = syslog_level; + if (stderr_level > -1) + init_stderr_level = stderr_level; +} + typedef struct { int args; Scheme_Object *type; @@ -563,6 +595,49 @@ void scheme_init_error(Scheme_Env *env) 0, 1), env); + scheme_add_global_constant("log-message", + scheme_make_prim_w_arity(log_message, + "log-message", + 4, 4), + env); + scheme_add_global_constant("log-level?", + scheme_make_noncm_prim(log_level_p, + "log-level?", + 2, 2), + env); + scheme_add_global_constant("make-logger", + scheme_make_noncm_prim(make_logger, + "make-logger", + 1, 2), + env); + scheme_add_global_constant("logger?", + scheme_make_folding_prim(logger_p, + "logger?", + 1, 1, 1), + env); + scheme_add_global_constant("logger-name", + scheme_make_folding_prim(logger_name, + "logger-name", + 1, 1, 1), + env); + scheme_add_global_constant("make-log-receiver", + scheme_make_noncm_prim(make_log_reader, + "make-log-receiver", + 2, 2), + env); + scheme_add_global_constant("log-receiver?", + scheme_make_folding_prim(log_reader_p, + "log-receiver?", + 1, 1, 1), + env); + scheme_add_global_constant("current-logger", + scheme_register_parameter(current_logger, + "current-logger", + MZCONFIG_LOGGER), + env); + + scheme_add_evt(scheme_log_reader_type, (Scheme_Ready_Fun)log_reader_get, NULL, NULL, 1); + REGISTER_SO(scheme_def_exit_proc); scheme_def_exit_proc = scheme_make_prim_w_arity(def_exit_handler_proc, "default-exit-handler", @@ -577,6 +652,25 @@ void scheme_init_error(Scheme_Env *env) prepared_buf = ""; prepared_buf = init_buf(NULL, &prepared_buf_len); + REGISTER_SO(fatal_symbol); + REGISTER_SO(error_symbol); + REGISTER_SO(warning_symbol); + REGISTER_SO(info_symbol); + REGISTER_SO(debug_symbol); + fatal_symbol = scheme_intern_symbol("fatal"); + error_symbol = scheme_intern_symbol("error"); + warning_symbol = scheme_intern_symbol("warning"); + info_symbol = scheme_intern_symbol("info"); + debug_symbol = scheme_intern_symbol("debug"); + + { + REGISTER_SO(scheme_main_logger); + scheme_main_logger = make_a_logger(NULL, NULL); + scheme_main_logger->syslog_level = init_syslog_level; + scheme_main_logger->stderr_level = init_stderr_level; + scheme_set_root_param(MZCONFIG_LOGGER, (Scheme_Object *)scheme_main_logger); + } + REGISTER_SO(arity_property); { Scheme_Object *guard; @@ -631,8 +725,15 @@ scheme_inescapeable_error(const char *a, const char *b) static void call_error(char *buffer, int len, Scheme_Object *exn) { - if (scheme_current_thread->skip_error) { - scheme_longjmp (scheme_error_buf, 1); + if (scheme_current_thread->constant_folding) { + if (SCHEME_TRUEP(scheme_current_thread->constant_folding)) + scheme_log(NULL, + SCHEME_LOG_WARNING, + 0, + "optimizer constant-fold attempt failed%s: %s", + scheme_optimize_context_to_string(scheme_current_thread->constant_folding), + buffer); + scheme_longjmp(scheme_error_buf, 1); } else { mz_jmp_buf savebuf; Scheme_Object *p[2], *display_handler, *escape_handler, *v; @@ -803,6 +904,47 @@ void scheme_warning(char *msg, ...) scheme_get_param(scheme_current_config(), MZCONFIG_ERROR_PORT)); } +void scheme_log(Scheme_Logger *logger, int level, int flags, + char *msg, ...) +{ + GC_CAN_IGNORE va_list args; + char *buffer; + long len; + + if (logger) { + if (logger->local_timestamp == *logger->timestamp) + if (logger->want_level < level) + return; + } + + /* Precise GC: Don't allocate before getting hidden args off stack */ + buffer = prepared_buf; + + HIDE_FROM_XFORM(va_start(args, msg)); + len = sch_vsprintf(buffer, prepared_buf_len, msg, args); + HIDE_FROM_XFORM(va_end(args)); + + prepared_buf = init_buf(NULL, &prepared_buf_len); + + buffer[len] = 0; + + scheme_log_message(logger, level, buffer, len, NULL); +} + +int scheme_log_level_p(Scheme_Logger *logger, int level) +{ + if (!logger) { + Scheme_Config *config; + config = scheme_current_config(); + logger = (Scheme_Logger *)scheme_get_param(config, MZCONFIG_LOGGER); + } + + if (logger->local_timestamp < *logger->timestamp) + update_want_level(logger); + + return (logger->want_level >= level); +} + static char *error_write_to_string_w_max(Scheme_Object *v, int len, int *lenout) { Scheme_Object *o, *args[2]; @@ -2203,6 +2345,36 @@ static Scheme_Object *error_print_srcloc(int argc, Scheme_Object *argv[]) -1, NULL, NULL, 1); } +void scheme_write_proc_context(Scheme_Object *port, int print_width, + Scheme_Object *name, + Scheme_Object *src, Scheme_Object *line, + Scheme_Object *col, Scheme_Object *pos, + int generated) +{ + if (src) { + scheme_display_w_max(src, port, print_width); + if (line && SCHEME_TRUEP(line)) { + /* Line + column */ + scheme_write_byte_string(":", 1, port); + scheme_display_w_max(line, port, print_width); + scheme_write_byte_string(":", 1, port); + scheme_display_w_max(col, port, print_width); + } else { + /* Position */ + scheme_write_byte_string("::", 2, port); + scheme_display_w_max(pos, port, print_width); + } + + if (SCHEME_TRUEP(name)) { + scheme_write_byte_string(": ", 2, port); + } + } + + if (SCHEME_TRUEP(name)) { + scheme_display_w_max(name, port, print_width); + } +} + static Scheme_Object * def_error_display_proc(int argc, Scheme_Object *argv[]) { @@ -2260,29 +2432,20 @@ def_error_display_proc(int argc, Scheme_Object *argv[]) loc = SCHEME_CDR(name); name = SCHEME_CAR(name); - if (SCHEME_TRUEP(loc)) { - Scheme_Structure *sloc = (Scheme_Structure *)loc; - scheme_display_w_max(sloc->slots[0], port, print_width); - if (SCHEME_TRUEP(sloc->slots[1])) { - /* Line + column */ - scheme_write_byte_string(":", 1, port); - scheme_display_w_max(sloc->slots[1], port, print_width); - scheme_write_byte_string(":", 1, port); - scheme_display_w_max(sloc->slots[2], port, print_width); - } else { - /* Position */ - scheme_write_byte_string("::", 2, port); - scheme_display_w_max(sloc->slots[3], port, print_width); - } + if (SCHEME_TRUEP(loc)) { + Scheme_Structure *sloc = (Scheme_Structure *)loc; + scheme_write_proc_context(port, print_width, + name, + sloc->slots[0], sloc->slots[1], + sloc->slots[2], sloc->slots[3], + 0); + } else { + scheme_write_proc_context(port, print_width, + name, + NULL, NULL, NULL, NULL, + 0); + } - if (SCHEME_TRUEP(name)) { - scheme_write_byte_string(": ", 2, port); - } - } - - if (SCHEME_TRUEP(name)) { - scheme_display_w_max(name, port, print_width); - } scheme_write_byte_string("\n", 1, port); l = SCHEME_CDR(l); --max_cnt; @@ -2480,6 +2643,456 @@ void scheme_immediate_exit(int status) /***********************************************************************/ +void update_want_level(Scheme_Logger *logger) +{ + Scheme_Log_Reader *lr; + Scheme_Object *stack = NULL, *queue, *b, *prev; + Scheme_Logger *parent = logger; + int want_level; + + while (parent) { + stack = scheme_make_raw_pair((Scheme_Object *)parent, stack); + + if (parent->local_timestamp < *parent->timestamp) + parent = parent->parent; + else + parent = NULL; + } + + want_level = 0; + while (stack) { + parent = (Scheme_Logger *)SCHEME_CAR(stack); + + if (parent->local_timestamp < *parent->timestamp) { + queue = parent->readers; + prev = NULL; + while (queue) { + b = SCHEME_CAR(queue); + lr = (Scheme_Log_Reader *)SCHEME_BOX_VAL(b); + if (lr) { + if (lr->want_level > want_level) + want_level = lr->want_level; + } else { + if (prev) + SCHEME_CDR(prev) = SCHEME_CDR(queue); + else + parent->readers = SCHEME_CDR(queue); + } + queue = SCHEME_CDR(queue); + } + + if (parent->syslog_level > want_level) + want_level = parent->syslog_level; + if (parent->stderr_level > want_level) + want_level = parent->stderr_level; + + parent->want_level = want_level; + parent->local_timestamp = *parent->timestamp; + } else { + want_level = parent->want_level; + } + + stack = SCHEME_CDR(stack); + } +} + +#ifdef USE_WINDOWS_EVENT_LOG +static int event_procs_ready; +typedef HANDLE (WINAPI *mzRegisterEventSourceProc)(LPCTSTR lpUNCServerName, LPCTSTR lpSourceName); +typedef BOOL (WINAPI *mzReportEventProc)(HANDLE hEventLog, WORD wType, WORD wCategory, DWORD dwEventID, + PSID lpUserSid, WORD wNumStrings, DWORD dwDataSize, LPCTSTR* lpStrings, + LPVOID lpRawData); +static mzRegisterEventSourceProc mzRegisterEventSource; +static mzReportEventProc mzReportEvent; +#endif + +void scheme_log_message(Scheme_Logger *logger, int level, char *buffer, long len, Scheme_Object *data) +{ + Scheme_Logger *orig_logger; + Scheme_Object *queue, *q, *msg = NULL, *b; + Scheme_Log_Reader *lr; + + if (!logger) { + Scheme_Config *config; + config = scheme_current_config(); + logger = (Scheme_Logger *)scheme_get_param(config, MZCONFIG_LOGGER); + } + + if (logger->local_timestamp < *logger->timestamp) + update_want_level(logger); + + orig_logger = logger; + + while (logger) { + if (logger->want_level < level) + return; + + if (logger->syslog_level >= level) { +#ifdef USE_C_SYSLOG + int pri; + switch (level) { + case SCHEME_LOG_FATAL: + pri = LOG_CRIT; + break; + case SCHEME_LOG_ERROR: + pri = LOG_ERR; + break; + case SCHEME_LOG_WARNING: + pri = LOG_WARNING; + break; + case SCHEME_LOG_INFO: + pri = LOG_INFO; + break; + case SCHEME_LOG_DEBUG: + default: + pri = LOG_DEBUG; + break; + } + if (orig_logger->name) + syslog(pri, "%s: %s", SCHEME_SYM_VAL(orig_logger->name), buffer); + else + syslog(pri, "%s", buffer); +#endif +#ifdef USE_WINDOWS_EVENT_LOG + if (!event_procs_ready) { + HMODULE hm; + hm = LoadLibrary("advapi32.dll"); + if (hm) { + mzRegisterEventSource = (mzRegisterEventSourceProc)GetProcAddress(hm, "RegisterEventSourceA"); + mzReportEvent = (mzReportEventProc)GetProcAddress(hm, "ReportEventA"); + } + event_procs_ready = 1; + } + if (mzRegisterEventSource) { + static HANDLE hEventLog; + WORD ty; + unsigned long sev; + LPCTSTR a[1]; + + if (!hEventLog) { + Scheme_Object *cmd; + cmd = scheme_get_run_cmd(); + hEventLog = mzRegisterEventSource(NULL, SCHEME_PATH_VAL(cmd)); + } + + switch (level) { + case SCHEME_LOG_FATAL: + ty = EVENTLOG_ERROR_TYPE; + sev = 3; + break; + case SCHEME_LOG_ERROR: + ty = EVENTLOG_ERROR_TYPE; + sev = 3; + break; + case SCHEME_LOG_WARNING: + ty = EVENTLOG_WARNING_TYPE; + sev = 2; + break; + case SCHEME_LOG_INFO: + ty = EVENTLOG_INFORMATION_TYPE; + sev = 1; + break; + case SCHEME_LOG_DEBUG: + default: + ty = EVENTLOG_AUDIT_SUCCESS; + sev = 0; + break; + } + if (orig_logger->name) { + char *naya; + long slen; + slen = SCHEME_SYM_LEN(orig_logger->name); + naya = (char *)scheme_malloc_atomic(slen + 2 + len + 1); + memcpy(naya, SCHEME_SYM_VAL(orig_logger->name), slen); + memcpy(naya + slen, ": ", 2); + memcpy(naya + slen + 2, buffer, len); + naya[slen + 2 + len] = 0; + buffer = naya; + len += slen + 2; + } + a[0] = buffer; + mzReportEvent(hEventLog, ty, 1 /* category */, + (sev << 30) | 2 /* message */, + NULL, + 1, 0, + a, NULL); + } +#endif + } + if (logger->stderr_level >= level) { + if (orig_logger->name) { + long slen; + slen = SCHEME_SYM_LEN(orig_logger->name); + fwrite(SCHEME_SYM_VAL(orig_logger->name), slen, 1, stderr); + fwrite(": ", 2, 1, stderr); + } + fwrite(buffer, len, 1, stderr); + fwrite("\n", 1, 1, stderr); + } + + queue = logger->readers; + while (queue) { + b = SCHEME_CAR(queue); + lr = (Scheme_Log_Reader *)SCHEME_BOX_VAL(b); + if (lr) { + if (lr->want_level >= level) { + if (!msg) { + Scheme_Object *v; + msg = scheme_make_vector(3, NULL); + switch (level) { + case SCHEME_LOG_FATAL: + v = fatal_symbol; + break; + case SCHEME_LOG_ERROR: + v = error_symbol; + break; + case SCHEME_LOG_WARNING: + v = warning_symbol; + break; + case SCHEME_LOG_INFO: + v = info_symbol; + break; + case SCHEME_LOG_DEBUG: + default: + v = debug_symbol; + break; + } + SCHEME_VEC_ELS(msg)[0] = v; + + if (orig_logger->name) { + /* Add logger name prefix: */ + long slen; + char *cp; + slen = SCHEME_SYM_LEN(orig_logger->name); + cp = scheme_malloc_atomic(slen + len + 2); + memcpy(cp, SCHEME_SYM_VAL(orig_logger->name), slen); + memcpy(cp + slen, ": ", 2); + memcpy(cp + slen + 2, buffer, len + 1); + len += slen + 2; + buffer = cp; + } + + v = scheme_make_sized_utf8_string(buffer, len); + SCHEME_SET_CHAR_STRING_IMMUTABLE(v); + SCHEME_VEC_ELS(msg)[1] = v; + SCHEME_VEC_ELS(msg)[2] = (data ? data : scheme_false); + } + if (!lr->tail + && scheme_try_channel_put(lr->ch, msg)) { + /* delivered immediately */ + } else { + /* enqueue */ + q = scheme_make_raw_pair(msg, NULL); + if (lr->tail) + SCHEME_CDR(lr->tail) = q; + else + lr->head = q; + lr->tail = q; + } + } + } + queue = SCHEME_CDR(queue); + } + + logger = logger->parent; + } +} + +static int extract_level(const char *who, int which, int argc, Scheme_Object **argv) +{ + Scheme_Object *v; + int level; + + v = argv[which]; + if (SAME_OBJ(v, fatal_symbol)) + level = SCHEME_LOG_FATAL; + else if (SAME_OBJ(v, error_symbol)) + level = SCHEME_LOG_ERROR; + else if (SAME_OBJ(v, warning_symbol)) + level = SCHEME_LOG_WARNING; + else if (SAME_OBJ(v, info_symbol)) + level = SCHEME_LOG_INFO; + else if (SAME_OBJ(v, debug_symbol)) + level = SCHEME_LOG_DEBUG; + else { + scheme_wrong_type(who, "'fatal, 'error, 'warning, 'info, or 'debug", which, argc, argv); + return 0; + } + + return level; +} + +static Scheme_Object * +log_message(int argc, Scheme_Object *argv[]) +{ + Scheme_Logger *logger; + Scheme_Object *bytes; + int level; + + if (!SAME_TYPE(SCHEME_TYPE(argv[0]), scheme_logger_type)) + scheme_wrong_type("log-message", "logger", 0, argc, argv); + logger = (Scheme_Logger *)argv[0]; + + level = extract_level("log-message", 1, argc, argv); + + bytes = argv[2]; + if (!SCHEME_CHAR_STRINGP(bytes)) + scheme_wrong_type("log-message", "string", 2, argc, argv); + bytes = scheme_char_string_to_byte_string(bytes); + + scheme_log_message(logger, level, SCHEME_BYTE_STR_VAL(bytes), SCHEME_BYTE_STRLEN_VAL(bytes), argv[3]); + + return scheme_void; +} + +static Scheme_Object * +log_level_p(int argc, Scheme_Object *argv[]) +{ + Scheme_Logger *logger; + int level; + + if (!SAME_TYPE(SCHEME_TYPE(argv[0]), scheme_logger_type)) + scheme_wrong_type("log-level?", "logger", 0, argc, argv); + logger = (Scheme_Logger *)argv[0]; + + level = extract_level("log-level?", 1, argc, argv); + + if (logger->local_timestamp < *logger->timestamp) + update_want_level(logger); + + return ((logger->want_level >= level) ? scheme_true : scheme_false); +} + +static Scheme_Object * +make_logger(int argc, Scheme_Object *argv[]) +{ + Scheme_Logger *parent; + + if (argc) { + if (!SCHEME_FALSEP(argv[0]) && !SCHEME_SYMBOLP(argv[0])) + scheme_wrong_type("make-logger", "symbol or #f", 0, argc, argv); + + if (argc > 1) { + if (SCHEME_FALSEP(argv[1])) + parent = NULL; + else { + if (!SAME_TYPE(SCHEME_TYPE(argv[1]), scheme_logger_type)) + scheme_wrong_type("make-logger", "logger or #f", 1, argc, argv); + parent = (Scheme_Logger *)argv[1]; + } + } else + parent = NULL; + } else + parent = NULL; + + return (Scheme_Object *)make_a_logger(parent, + (argc + ? (SCHEME_FALSEP(argv[1]) ? NULL : argv[1]) + : NULL)); +} + +static Scheme_Logger *make_a_logger(Scheme_Logger *parent, Scheme_Object *name) +{ + Scheme_Logger *logger; + + logger = MALLOC_ONE_TAGGED(Scheme_Logger); + logger->so.type = scheme_logger_type; + logger->parent = parent; + if (parent) { + logger->timestamp = parent->timestamp; + } else { + long *timestamp; + timestamp = MALLOC_ONE_ATOMIC(long); + *timestamp = 1; + logger->timestamp = timestamp; + } + logger->name = name; + + return logger; +} + +static Scheme_Object * +logger_p(int argc, Scheme_Object *argv[]) +{ + return (SAME_TYPE(SCHEME_TYPE(argv[0]), scheme_logger_type) + ? scheme_true + : scheme_false); +} + +static Scheme_Object * +current_logger(int argc, Scheme_Object *argv[]) +{ + return scheme_param_config("current-logger", + scheme_make_integer(MZCONFIG_LOGGER), + argc, argv, + -1, logger_p, "logger", 0); +} + +static Scheme_Object * +logger_name(int argc, Scheme_Object *argv[]) +{ + if (!SAME_TYPE(SCHEME_TYPE(argv[0]), scheme_logger_type)) + scheme_wrong_type("logger-name", "logger", 0, argc, argv); + + return ((Scheme_Logger *)argv[0])->name; +} + +static Scheme_Object * +make_log_reader(int argc, Scheme_Object *argv[]) +{ + Scheme_Logger *logger; + Scheme_Log_Reader *lr; + Scheme_Object *ch, *q; + int level; + + if (!SAME_TYPE(SCHEME_TYPE(argv[0]), scheme_logger_type)) + scheme_wrong_type("make-log-receiver", "logger", 0, argc, argv); + logger = (Scheme_Logger *)argv[0]; + + level = extract_level("make-log-receiver", 1, argc, argv); + + lr = MALLOC_ONE_TAGGED(Scheme_Log_Reader); + lr->so.type = scheme_log_reader_type; + lr->want_level = level; + + ch = scheme_make_channel(); + lr->ch = ch; + + q = scheme_make_raw_pair(scheme_make_weak_box((Scheme_Object *)lr), logger->readers); + logger->readers = q; + *logger->timestamp += 1; + + return (Scheme_Object *)lr; +} + +static Scheme_Object * +log_reader_p(int argc, Scheme_Object *argv[]) +{ + return (SAME_TYPE(SCHEME_TYPE(argv[0]), scheme_log_reader_type) + ? scheme_true + : scheme_false); +} + +static int log_reader_get(Scheme_Object *_lr, Scheme_Schedule_Info *sinfo) +{ + Scheme_Log_Reader *lr = (Scheme_Log_Reader *)_lr; + + if (lr->head) { + Scheme_Object *v; + v = SCHEME_CAR(lr->head); + lr->head = SCHEME_CDR(lr->head); + if (!lr->head) + lr->tail = NULL; + scheme_set_sync_target(sinfo, v, NULL, NULL, 0, 0); + return 1; + } else { + scheme_set_sync_target(sinfo, lr->ch, NULL, NULL, 0, 0); + return 0; + } +} + +/***********************************************************************/ + void scheme_raise_exn(int id, ...) { @@ -2700,7 +3313,20 @@ do_raise(Scheme_Object *arg, int need_debug, int eb) { Scheme_Thread *p = scheme_current_thread; - if (p->skip_error) { + if (p->constant_folding) { + if (SCHEME_TRUEP(p->constant_folding)) { + const char *msg; + if (need_debug) { + msg = scheme_display_to_string(((Scheme_Structure *)arg)->slots[0], NULL); + } else + msg = scheme_write_to_string(arg, NULL); + scheme_log(NULL, + SCHEME_LOG_WARNING, + 0, + "warning%s: optimizer constant-fold attempt failed: %s", + scheme_optimize_context_to_string(p->constant_folding), + msg); + } scheme_longjmp (scheme_error_buf, 1); } diff --git a/src/mzscheme/src/eval.c b/src/mzscheme/src/eval.c index 7aeb2e5bff..c6ac8e9eb0 100644 --- a/src/mzscheme/src/eval.c +++ b/src/mzscheme/src/eval.c @@ -818,12 +818,29 @@ static int is_proc_spec_proc(Scheme_Object *p) return 0; } -int scheme_omittable_expr(Scheme_Object *o, int vals, int fuel, int resolved) +static void note_match(int actual, int expected, Optimize_Info *warn_info) +{ + if (!warn_info || (expected == -1)) + return; + + if (actual != expected) { + scheme_log(NULL, + SCHEME_LOG_WARNING, + 0, + "warning%s: optimizer detects %d values produced when %d expected", + scheme_optimize_context_to_string(warn_info->context), + actual, expected); + } +} + +int scheme_omittable_expr(Scheme_Object *o, int vals, int fuel, int resolved, + Optimize_Info *warn_info) /* Checks whether the bytecode `o' returns `vals' values with no side-effects and without pushing and using continuation marks. -1 for vals means that any return count is ok. Also used with fully resolved expression by `module' to check - for "functional" bodies. */ + for "functional" bodies. + If warn_info is supplied, complain when a mismatch is detected. */ { Scheme_Type vtype; @@ -842,10 +859,13 @@ int scheme_omittable_expr(Scheme_Object *o, int vals, int fuel, int resolved) || (vtype == scheme_compiled_unclosed_procedure_type) || (vtype == scheme_case_lambda_sequence_type) || (vtype == scheme_quote_syntax_type) - || (vtype == scheme_compiled_quote_syntax_type)) + || (vtype == scheme_compiled_quote_syntax_type)) { + note_match(1, vals, warn_info); return ((vals == 1) || (vals < 0)); + } if (vtype == scheme_toplevel_type) { + note_match(1, vals, warn_info); if (resolved && ((vals == 1) || (vals < 0))) { if (SCHEME_TOPLEVEL_FLAGS(o) & (SCHEME_TOPLEVEL_CONST | SCHEME_TOPLEVEL_READY)) @@ -856,19 +876,22 @@ int scheme_omittable_expr(Scheme_Object *o, int vals, int fuel, int resolved) } if ((vtype == scheme_syntax_type) - && (SCHEME_PINT_VAL(o) == CASE_LAMBDA_EXPD)) + && (SCHEME_PINT_VAL(o) == CASE_LAMBDA_EXPD)) { + note_match(1, vals, warn_info); return 1; + } if ((vtype == scheme_compiled_quote_syntax_type)) { + note_match(1, vals, warn_info); return ((vals == 1) || (vals < 0)); } if ((vtype == scheme_branch_type)) { Scheme_Branch_Rec *b; b = (Scheme_Branch_Rec *)o; - return (scheme_omittable_expr(b->test, 1, fuel - 1, resolved) - && scheme_omittable_expr(b->tbranch, vals, fuel - 1, resolved) - && scheme_omittable_expr(b->fbranch, vals, fuel - 1, resolved)); + return (scheme_omittable_expr(b->test, 1, fuel - 1, resolved, warn_info) + && scheme_omittable_expr(b->tbranch, vals, fuel - 1, resolved, warn_info) + && scheme_omittable_expr(b->fbranch, vals, fuel - 1, resolved, warn_info)); } #if 0 @@ -876,15 +899,15 @@ int scheme_omittable_expr(Scheme_Object *o, int vals, int fuel, int resolved) a let_value_type! */ if ((vtype == scheme_let_value_type)) { Scheme_Let_Value *lv = (Scheme_Let_Value *)o; - return (scheme_omittable_expr(lv->value, lv->count, fuel - 1, resolved) - && scheme_omittable_expr(lv->body, vals, fuel - 1, resolved)); + return (scheme_omittable_expr(lv->value, lv->count, fuel - 1, resolved, warn_info) + && scheme_omittable_expr(lv->body, vals, fuel - 1, resolved, warn_info)); } #endif if ((vtype == scheme_let_one_type)) { Scheme_Let_One *lo = (Scheme_Let_One *)o; - return (scheme_omittable_expr(lo->value, 1, fuel - 1, resolved) - && scheme_omittable_expr(lo->body, vals, fuel - 1, resolved)); + return (scheme_omittable_expr(lo->value, 1, fuel - 1, resolved, warn_info) + && scheme_omittable_expr(lo->body, vals, fuel - 1, resolved, warn_info)); } if ((vtype == scheme_let_void_type)) { @@ -894,7 +917,7 @@ int scheme_omittable_expr(Scheme_Object *o, int vals, int fuel, int resolved) Scheme_Let_Value *lv2 = (Scheme_Let_Value *)lv->body; if ((lv2->count == 1) && (lv2->position == 0) - && scheme_omittable_expr(lv2->value, 1, fuel - 1, resolved)) + && scheme_omittable_expr(lv2->value, 1, fuel - 1, resolved, warn_info)) o = lv2->body; else o = lv->body; @@ -909,7 +932,7 @@ int scheme_omittable_expr(Scheme_Object *o, int vals, int fuel, int resolved) if ((lh->count == 1) && (lh->num_clauses == 1)) { if (SAME_TYPE(SCHEME_TYPE(lh->body), scheme_compiled_let_value_type)) { Scheme_Compiled_Let_Value *lv = (Scheme_Compiled_Let_Value *)lh->body; - if (scheme_omittable_expr(lv->value, 1, fuel - 1, resolved)) { + if (scheme_omittable_expr(lv->value, 1, fuel - 1, resolved, warn_info)) { o = lv->body; goto try_again; } @@ -926,48 +949,52 @@ int scheme_omittable_expr(Scheme_Object *o, int vals, int fuel, int resolved) /* Look for multiple values, or for `make-struct-type'. (The latter is especially useful to Honu.) */ Scheme_App_Rec *app = (Scheme_App_Rec *)o; - if (((vals == 5) || (vals < 0)) - && (app->num_args >= 4) && (app->num_args <= 10) + if ((app->num_args >= 4) && (app->num_args <= 10) && SAME_OBJ(scheme_make_struct_type_proc, app->args[0])) { + note_match(5, vals, warn_info); + if ((vals == 5) || (vals < 0)) { /* Look for (make-struct-type sym #f non-neg-int non-neg-int [omitable null]) */ - if (SCHEME_SYMBOLP(app->args[1]) - && SCHEME_FALSEP(app->args[2]) - && SCHEME_INTP(app->args[3]) - && (SCHEME_INT_VAL(app->args[3]) >= 0) - && SCHEME_INTP(app->args[4]) - && (SCHEME_INT_VAL(app->args[4]) >= 0) - && ((app->num_args < 5) - || scheme_omittable_expr(app->args[5], 1, fuel - 1, resolved)) - && ((app->num_args < 6) - || SCHEME_NULLP(app->args[6])) - && ((app->num_args < 7) - || SCHEME_FALSEP(app->args[7]) - || is_current_inspector_call(app->args[7])) - && ((app->num_args < 8) - || SCHEME_FALSEP(app->args[8]) - || is_proc_spec_proc(app->args[8])) - && ((app->num_args < 9) - || SCHEME_NULLP(app->args[9]))) { - return 1; + if (SCHEME_SYMBOLP(app->args[1]) + && SCHEME_FALSEP(app->args[2]) + && SCHEME_INTP(app->args[3]) + && (SCHEME_INT_VAL(app->args[3]) >= 0) + && SCHEME_INTP(app->args[4]) + && (SCHEME_INT_VAL(app->args[4]) >= 0) + && ((app->num_args < 5) + || scheme_omittable_expr(app->args[5], 1, fuel - 1, resolved, warn_info)) + && ((app->num_args < 6) + || SCHEME_NULLP(app->args[6])) + && ((app->num_args < 7) + || SCHEME_FALSEP(app->args[7]) + || is_current_inspector_call(app->args[7])) + && ((app->num_args < 8) + || SCHEME_FALSEP(app->args[8]) + || is_proc_spec_proc(app->args[8])) + && ((app->num_args < 9) + || SCHEME_NULLP(app->args[9]))) { + return 1; + } } } /* (values ...) */ - if ((app->num_args == vals) || (vals < 0)) { - if (SAME_OBJ(scheme_values_func, app->args[0])) { + if (SAME_OBJ(scheme_values_func, app->args[0])) { + note_match(app->num_args, vals, warn_info); + if ((app->num_args == vals) || (vals < 0)) { int i; for (i = app->num_args; i--; ) { - if (!scheme_omittable_expr(app->args[i + 1], 1, fuel - 1, resolved)) + if (!scheme_omittable_expr(app->args[i + 1], 1, fuel - 1, resolved, warn_info)) return 0; } return 1; } } /* (void ...) */ - if ((vals == 1) || (vals < 0)) { - if (SAME_OBJ(scheme_void_proc, app->args[0])) { + if (SAME_OBJ(scheme_void_proc, app->args[0])) { + note_match(1, vals, warn_info); + if ((vals == 1) || (vals < 0)) { int i; for (i = app->num_args; i--; ) { - if (!scheme_omittable_expr(app->args[i + 1], 1, fuel - 1, resolved)) + if (!scheme_omittable_expr(app->args[i + 1], 1, fuel - 1, resolved, warn_info)) return 0; } return 1; @@ -978,11 +1005,12 @@ int scheme_omittable_expr(Scheme_Object *o, int vals, int fuel, int resolved) if ((vtype == scheme_application2_type)) { /* (values ) or (void ) */ - if ((vals == 1) || (vals < 0)) { - Scheme_App2_Rec *app = (Scheme_App2_Rec *)o; - if (SAME_OBJ(scheme_values_func, app->rator) - || SAME_OBJ(scheme_void_proc, app->rator)) { - if (scheme_omittable_expr(app->rand, 1, fuel - 1, resolved)) + Scheme_App2_Rec *app = (Scheme_App2_Rec *)o; + if (SAME_OBJ(scheme_values_func, app->rator) + || SAME_OBJ(scheme_void_proc, app->rator)) { + note_match(1, vals, warn_info); + if ((vals == 1) || (vals < 0)) { + if (scheme_omittable_expr(app->rand, 1, fuel - 1, resolved, warn_info)) return 1; } } @@ -990,20 +1018,21 @@ int scheme_omittable_expr(Scheme_Object *o, int vals, int fuel, int resolved) if ((vtype == scheme_application3_type)) { /* (values ) */ - if ((vals == 2) || (vals < 0)) { - Scheme_App3_Rec *app = (Scheme_App3_Rec *)o; - if (SAME_OBJ(scheme_values_func, app->rator)) { - if (scheme_omittable_expr(app->rand1, 1, fuel - 1, resolved) - && scheme_omittable_expr(app->rand2, 1, fuel - 1, resolved)) + Scheme_App3_Rec *app = (Scheme_App3_Rec *)o; + if (SAME_OBJ(scheme_values_func, app->rator)) { + note_match(2, vals, warn_info); + if ((vals == 2) || (vals < 0)) { + if (scheme_omittable_expr(app->rand1, 1, fuel - 1, resolved, warn_info) + && scheme_omittable_expr(app->rand2, 1, fuel - 1, resolved, warn_info)) return 1; } } /* (void ) */ - if ((vals == 1) || (vals < 0)) { - Scheme_App3_Rec *app = (Scheme_App3_Rec *)o; - if (SAME_OBJ(scheme_void_proc, app->rator)) { - if (scheme_omittable_expr(app->rand1, 1, fuel - 1, resolved) - && scheme_omittable_expr(app->rand2, 1, fuel - 1, resolved)) + if (SAME_OBJ(scheme_void_proc, app->rator)) { + note_match(1, vals, warn_info); + if ((vals == 1) || (vals < 0)) { + if (scheme_omittable_expr(app->rand1, 1, fuel - 1, resolved, warn_info) + && scheme_omittable_expr(app->rand2, 1, fuel - 1, resolved, warn_info)) return 1; } } @@ -1049,14 +1078,14 @@ int scheme_get_eval_type(Scheme_Object *obj) return SCHEME_EVAL_GENERAL; } -static Scheme_Object *try_apply(Scheme_Object *f, Scheme_Object *args) +static Scheme_Object *try_apply(Scheme_Object *f, Scheme_Object *args, Scheme_Object *context) /* Apply `f' to `args' and ignore failues --- used for constant folding attempts */ { Scheme_Object * volatile result; mz_jmp_buf *savebuf, newbuf; - scheme_current_thread->skip_error = 5; + scheme_current_thread->constant_folding = context; savebuf = scheme_current_thread->error_buf; scheme_current_thread->error_buf = &newbuf; @@ -1066,7 +1095,7 @@ static Scheme_Object *try_apply(Scheme_Object *f, Scheme_Object *args) result = _scheme_apply_to_list(f, args); scheme_current_thread->error_buf = savebuf; - scheme_current_thread->skip_error = 0; + scheme_current_thread->constant_folding = NULL; return result; } @@ -1114,7 +1143,7 @@ static Scheme_Object *make_application(Scheme_Object *v) == SCHEME_PRIM_OPT_FOLDING)) || (SAME_TYPE(SCHEME_TYPE(f), scheme_closure_type) && (foldable_body(f)))) { - f = try_apply(f, SCHEME_CDR(v)); + f = try_apply(f, SCHEME_CDR(v), scheme_false); if (f) return f; @@ -1605,7 +1634,7 @@ Scheme_Object *scheme_make_sequence_compilation(Scheme_Object *seq, int opt) total++; } else if (opt && (((opt > 0) && !last) || ((opt < 0) && !first)) - && scheme_omittable_expr(v, -1, -1, 0)) { + && scheme_omittable_expr(v, -1, -1, 0, NULL)) { /* A value that is not the result. We'll drop it. */ total++; } else { @@ -1629,7 +1658,7 @@ Scheme_Object *scheme_make_sequence_compilation(Scheme_Object *seq, int opt) return scheme_compiled_void(); if (count == 1) { - if ((opt < 0) && !scheme_omittable_expr(SCHEME_CAR(seq), 1, -1, 0)) { + if ((opt < 0) && !scheme_omittable_expr(SCHEME_CAR(seq), 1, -1, 0, NULL)) { /* We can't optimize (begin0 expr cont) to expr because exp is not in tail position in the original (so we'd mess up continuation marks). */ @@ -1661,7 +1690,7 @@ Scheme_Object *scheme_make_sequence_compilation(Scheme_Object *seq, int opt) } else if (opt && (((opt > 0) && (k < total)) || ((opt < 0) && k)) - && scheme_omittable_expr(v, -1, -1, 0)) { + && scheme_omittable_expr(v, -1, -1, 0, NULL)) { /* Value not the result. Do nothing. */ } else o->array[i++] = v; @@ -1686,7 +1715,7 @@ static Scheme_Object *look_for_letv_change(Scheme_Sequence *s) v = s->array[i]; if (SAME_TYPE(SCHEME_TYPE(v), scheme_let_value_type)) { Scheme_Let_Value *lv = (Scheme_Let_Value *)v; - if (scheme_omittable_expr(lv->body, 1, -1, 0)) { + if (scheme_omittable_expr(lv->body, 1, -1, 0, NULL)) { int esize = s->count - (i + 1); int nsize = i + 1; Scheme_Object *nv, *ev; @@ -2188,7 +2217,7 @@ static Scheme_Object *try_optimize_fold(Scheme_Object *f, Scheme_Object *o, Opti break; } - return try_apply(f, args); + return try_apply(f, args, info->context); } return NULL; @@ -2262,6 +2291,7 @@ Scheme_Object *optimize_for_inline(Optimize_Info *info, Scheme_Object *le, int a /* If not app, app2, or app3, just return a known procedure, if any */ { int offset = 0, single_use = 0; + Scheme_Object *bad_app = NULL; if (SAME_TYPE(SCHEME_TYPE(le), scheme_local_type)) { /* Check for inlining: */ @@ -2308,6 +2338,12 @@ Scheme_Object *optimize_for_inline(Optimize_Info *info, Scheme_Object *le, int a sz, info->inline_fuel * (argc + 2), info->inline_fuel)); } + } else { + if (!(SCHEME_CLOSURE_DATA_FLAGS(data) & CLOS_HAS_REST) + || (argc + 1 < data->num_params)) { + /* Issue warning below */ + bad_app = (Scheme_Object *)data; + } } } @@ -2317,10 +2353,112 @@ Scheme_Object *optimize_for_inline(Optimize_Info *info, Scheme_Object *le, int a if (opt >= SCHEME_PRIM_OPT_NONCM) *_flags = (CLOS_PRESERVES_MARKS | CLOS_SINGLE_RESULT); } + + if (le && SCHEME_PROCP(le)) { + Scheme_Object *a[1]; + a[0] = le; + if (!scheme_check_proc_arity(NULL, argc, 0, 1, a)) { + bad_app = le; + } + } + + if (bad_app) { + int len; + const char *pname, *context; + pname = scheme_get_proc_name(bad_app, &len, 0); + context = scheme_optimize_context_to_string(info->context); + scheme_log(NULL, + SCHEME_LOG_WARNING, + 0, + "warning%s: optimizer detects procedure incorrectly applied to %d arguments%s%s", + context, + argc, + pname ? ": " : "", + pname ? pname : ""); + } return NULL; } +char *scheme_optimize_context_to_string(Scheme_Object *context) +{ + if (context) { + Scheme_Object *mod, *func; + const char *ctx, *prefix, *mctx, *mprefix; + char *all; + int clen, plen, mclen, mplen, len; + + if (SCHEME_PAIRP(context)) { + func = SCHEME_CAR(context); + mod = SCHEME_CDR(context); + } else if (SAME_TYPE(SCHEME_TYPE(context), scheme_module_type)) { + func = scheme_false; + mod = context; + } else { + func = context; + mod = scheme_false; + } + + if (SAME_TYPE(SCHEME_TYPE(func), scheme_compiled_unclosed_procedure_type)) { + Scheme_Object *name; + + name = ((Scheme_Closure_Data *)func)->name; + if (name) { + if (SCHEME_VECTORP(name)) { + Scheme_Object *port; + int print_width = 1024; + long plen; + + port = scheme_make_byte_string_output_port(); + + scheme_write_proc_context(port, print_width, + SCHEME_VEC_ELS(name)[0], + SCHEME_VEC_ELS(name)[1], SCHEME_VEC_ELS(name)[2], + SCHEME_VEC_ELS(name)[3], SCHEME_VEC_ELS(name)[4], + SCHEME_TRUEP(SCHEME_VEC_ELS(name)[6])); + + ctx = scheme_get_sized_byte_string_output(port, &plen); + prefix = " in: "; + } else { + ctx = scheme_get_proc_name(func, &len, 0); + prefix = " in: "; + } + } else { + ctx = ""; + prefix = ""; + } + } else { + ctx = ""; + prefix = ""; + } + + if (SAME_TYPE(SCHEME_TYPE(mod), scheme_module_type)) { + mctx = scheme_display_to_string(((Scheme_Module *)mod)->modname, NULL); + mprefix = " in module: "; + } else { + mctx = ""; + mprefix = ""; + } + + clen = strlen(ctx); + plen = strlen(prefix); + mclen = strlen(mctx); + mplen = strlen(mprefix); + + if (!clen && !mclen) + return ""; + + all = scheme_malloc_atomic(clen + plen + mclen + mplen + 1); + memcpy(all, prefix, plen); + memcpy(all + plen, ctx, clen); + memcpy(all + plen + clen, mprefix, mplen); + memcpy(all + plen + clen + mplen, mctx, mclen); + all[clen + plen + mclen + mplen] = 0; + return all; + } else + return ""; +} + static void reset_rator(Scheme_Object *app, Scheme_Object *a) { switch (SCHEME_TYPE(app)) { @@ -2460,7 +2598,7 @@ static Scheme_Object *optimize_application2(Scheme_Object *o, Optimize_Info *inf } if (SAME_OBJ(scheme_values_func, app->rator) - && scheme_omittable_expr(app->rand, 1, -1, 0)) { + && scheme_omittable_expr(app->rand, 1, -1, 0, info)) { info->preserves_marks = 1; info->single_result = 1; return app->rand; @@ -2647,7 +2785,7 @@ static Scheme_Object *optimize_sequence(Scheme_Object *o, Optimize_Info *info) /* Inlining and constant propagation can expose omittable expressions. */ if ((i + 1 != s->count) - && scheme_omittable_expr(le, -1, -1, 0)) { + && scheme_omittable_expr(le, -1, -1, 0, NULL)) { drop++; s->array[i] = NULL; } else { @@ -3890,7 +4028,7 @@ static Scheme_Object *sfs_let_one(Scheme_Object *o, SFS_Info *info) it might not because (1) it was introduced late by inlining, or (2) the rhs expression doesn't always produce a single value. */ - if (scheme_omittable_expr(rhs, 1, -1, 1)) { + if (scheme_omittable_expr(rhs, 1, -1, 1, NULL)) { rhs = scheme_false; } else { Scheme_Object *clr; diff --git a/src/mzscheme/src/file.c b/src/mzscheme/src/file.c index de9ad441c9..b3a5846000 100644 --- a/src/mzscheme/src/file.c +++ b/src/mzscheme/src/file.c @@ -5624,6 +5624,15 @@ enum { id_addon_dir }; +Scheme_Object *scheme_get_run_cmd(void) +{ + if (!run_cmd) { + REGISTER_SO(run_cmd); + run_cmd = scheme_make_path("mzscheme"); + } + return run_cmd; +} + static Scheme_Object * find_system_path(int argc, Scheme_Object **argv) { @@ -5654,11 +5663,7 @@ find_system_path(int argc, Scheme_Object **argv) } return exec_cmd; } else if (argv[0] == run_file_symbol) { - if (!run_cmd) { - REGISTER_SO(run_cmd); - run_cmd = scheme_make_path("mzscheme"); - } - return run_cmd; + return scheme_get_run_cmd(); } else if (argv[0] == collects_dir_symbol) { if (!collects_path) { REGISTER_SO(collects_path); diff --git a/src/mzscheme/src/fun.c b/src/mzscheme/src/fun.c index 573fff78b4..25213a17f9 100644 --- a/src/mzscheme/src/fun.c +++ b/src/mzscheme/src/fun.c @@ -944,7 +944,7 @@ Scheme_Object * scheme_optimize_closure_compilation(Scheme_Object *_data, Optimize_Info *info) { Scheme_Closure_Data *data; - Scheme_Object *code; + Scheme_Object *code, *ctx; Closure_Info *cl; mzshort dcs, *dcm; int i; @@ -956,6 +956,14 @@ scheme_optimize_closure_compilation(Scheme_Object *_data, Optimize_Info *info) info = scheme_optimize_info_add_frame(info, data->num_params, data->num_params, SCHEME_LAMBDA_FRAME); + if (info->context && SCHEME_PAIRP(info->context)) + ctx = scheme_make_pair((Scheme_Object *)data, + SCHEME_CDR(info->context)); + else if (info->context) + ctx = scheme_make_pair((Scheme_Object *)data, info->context); + else + ctx = (Scheme_Object *)data; + info->context = ctx; cl = (Closure_Info *)data->closure_map; for (i = 0; i < data->num_params; i++) { @@ -3197,7 +3205,9 @@ const char *scheme_get_proc_name(Scheme_Object *p, int *len, int for_error) } else { Scheme_Object *name; - if (type == scheme_closure_type) { + if (type == scheme_compiled_unclosed_procedure_type) { + name = ((Scheme_Closure_Data *)p)->name; + } else if (type == scheme_closure_type) { name = SCHEME_COMPILED_CLOS_CODE(p)->name; } else { /* Native closure: */ diff --git a/src/mzscheme/src/module.c b/src/mzscheme/src/module.c index ac04da65b9..0c294cd5c9 100644 --- a/src/mzscheme/src/module.c +++ b/src/mzscheme/src/module.c @@ -4652,12 +4652,15 @@ static Scheme_Object * module_optimize(Scheme_Object *data, Optimize_Info *info) { Scheme_Module *m = (Scheme_Module *)data; - Scheme_Object *e, *vars; + Scheme_Object *e, *vars, *old_context; int start_simltaneous = 0, i_m, cnt; Scheme_Object *cl_first = NULL, *cl_last = NULL; Scheme_Hash_Table *consts = NULL, *ready_table = NULL, *re_consts = NULL; int cont; + old_context = info->context; + info->context = (Scheme_Object *)m; + cnt = SCHEME_VEC_SIZE(m->body); for (i_m = 0; i_m < cnt; i_m++) { /* Optimize this expression: */ @@ -4678,7 +4681,7 @@ module_optimize(Scheme_Object *data, Optimize_Info *info) e = SCHEME_CDR(e); n = scheme_list_length(vars); - cont = scheme_omittable_expr(e, n, -1, 0); + cont = scheme_omittable_expr(e, n, -1, 0, info); if ((n == 1) && scheme_compiled_propagate_ok(e, info)) { Scheme_Toplevel *tl; @@ -4749,7 +4752,7 @@ module_optimize(Scheme_Object *data, Optimize_Info *info) } } } else { - cont = scheme_omittable_expr(e, -1, -1, 0); + cont = scheme_omittable_expr(e, -1, -1, 0, NULL); } if (i_m + 1 == cnt) cont = 0; @@ -4824,7 +4827,7 @@ module_optimize(Scheme_Object *data, Optimize_Info *info) for (i_m = 0; i_m < cnt; i_m++) { /* Optimize this expression: */ e = SCHEME_VEC_ELS(m->body)[i_m]; - if (scheme_omittable_expr(e, -1, -1, 0)) { + if (scheme_omittable_expr(e, -1, -1, 0, NULL)) { can_omit++; } } @@ -4835,7 +4838,7 @@ module_optimize(Scheme_Object *data, Optimize_Info *info) for (i_m = 0; i_m < cnt; i_m++) { /* Optimize this expression: */ e = SCHEME_VEC_ELS(m->body)[i_m]; - if (!scheme_omittable_expr(e, -1, -1, 0)) { + if (!scheme_omittable_expr(e, -1, -1, 0, NULL)) { SCHEME_VEC_ELS(vec)[j++] = e; } } @@ -4843,6 +4846,8 @@ module_optimize(Scheme_Object *data, Optimize_Info *info) } } + info->context = old_context; + /* Exp-time body was optimized during compilation */ return scheme_make_syntax_compiled(MODULE_EXPD, data); @@ -4862,7 +4867,7 @@ static int is_functional(Scheme_Object *e, int len, int fuel) t = SCHEME_TYPE(e); - if (scheme_omittable_expr(e, len, fuel, 1)) + if (scheme_omittable_expr(e, len, fuel, 1, NULL)) return 1; if (t == scheme_sequence_type) { @@ -5974,6 +5979,7 @@ static Scheme_Object *do_module_begin(Scheme_Object *form, Scheme_Comp_Env *env, m = scheme_compile_expr_lift_to_let(code, eenv, &mrec, 0); oi = scheme_optimize_info_create(); + oi->context = (Scheme_Object *)env->genv->module; m = scheme_optimize_expr(m, oi); /* Simplify only in compile mode; it is too slow in expand mode. */ @@ -6215,7 +6221,7 @@ static Scheme_Object *do_module_begin(Scheme_Object *form, Scheme_Comp_Env *env, Scheme_Object *prev = NULL, *next; for (p = first; !SCHEME_NULLP(p); p = next) { next = SCHEME_CDR(p); - if (scheme_omittable_expr(SCHEME_CAR(p), -1, -1, 0)) { + if (scheme_omittable_expr(SCHEME_CAR(p), -1, -1, 0, NULL)) { if (prev) SCHEME_CDR(prev) = next; else diff --git a/src/mzscheme/src/mzmark.c b/src/mzscheme/src/mzmark.c index 7956a048af..2a5827ea10 100644 --- a/src/mzscheme/src/mzmark.c +++ b/src/mzscheme/src/mzmark.c @@ -1636,6 +1636,8 @@ static int thread_val_MARK(void *p) { gcMARK(pr->current_local_bindings); gcMARK(pr->current_mt); + + gcMARK(pr->constant_folding); gcMARK(pr->overflow_reply); @@ -1737,6 +1739,8 @@ static int thread_val_FIXUP(void *p) { gcFIXUP(pr->current_local_bindings); gcFIXUP(pr->current_mt); + + gcFIXUP(pr->constant_folding); gcFIXUP(pr->overflow_reply); @@ -2637,6 +2641,62 @@ static int mark_pipe_FIXUP(void *p) { #define mark_pipe_IS_CONST_SIZE 1 +static int mark_logger_SIZE(void *p) { + return + gcBYTES_TO_WORDS(sizeof(Scheme_Logger)); +} + +static int mark_logger_MARK(void *p) { + Scheme_Logger *l = (Scheme_Logger *)p; + gcMARK(l->name); + gcMARK(l->parent); + gcMARK(l->readers); + gcMARK(l->timestamp); + return + gcBYTES_TO_WORDS(sizeof(Scheme_Logger)); +} + +static int mark_logger_FIXUP(void *p) { + Scheme_Logger *l = (Scheme_Logger *)p; + gcFIXUP(l->name); + gcFIXUP(l->parent); + gcFIXUP(l->readers); + gcFIXUP(l->timestamp); + return + gcBYTES_TO_WORDS(sizeof(Scheme_Logger)); +} + +#define mark_logger_IS_ATOMIC 0 +#define mark_logger_IS_CONST_SIZE 1 + + +static int mark_log_reader_SIZE(void *p) { + return + gcBYTES_TO_WORDS(sizeof(Scheme_Log_Reader)); +} + +static int mark_log_reader_MARK(void *p) { + Scheme_Log_Reader *lr = (Scheme_Log_Reader *)p; + gcMARK(lr->ch); + gcMARK(lr->head); + gcMARK(lr->tail); + return + gcBYTES_TO_WORDS(sizeof(Scheme_Log_Reader)); +} + +static int mark_log_reader_FIXUP(void *p) { + Scheme_Log_Reader *lr = (Scheme_Log_Reader *)p; + gcFIXUP(lr->ch); + gcFIXUP(lr->head); + gcFIXUP(lr->tail); + return + gcBYTES_TO_WORDS(sizeof(Scheme_Log_Reader)); +} + +#define mark_log_reader_IS_ATOMIC 0 +#define mark_log_reader_IS_CONST_SIZE 1 + + #endif /* TYPE */ /**********************************************************************/ @@ -2765,6 +2825,7 @@ static int mark_optimize_info_MARK(void *p) { gcMARK(i->top_level_consts); gcMARK(i->transitive_use); gcMARK(i->transitive_use_len); + gcMARK(i->context); return gcBYTES_TO_WORDS(sizeof(Optimize_Info)); @@ -2781,6 +2842,7 @@ static int mark_optimize_info_FIXUP(void *p) { gcFIXUP(i->top_level_consts); gcFIXUP(i->transitive_use); gcFIXUP(i->transitive_use_len); + gcFIXUP(i->context); return gcBYTES_TO_WORDS(sizeof(Optimize_Info)); diff --git a/src/mzscheme/src/mzmarksrc.c b/src/mzscheme/src/mzmarksrc.c index 1f2447565d..e6170b2a79 100644 --- a/src/mzscheme/src/mzmarksrc.c +++ b/src/mzscheme/src/mzmarksrc.c @@ -651,6 +651,8 @@ thread_val { gcMARK(pr->current_local_bindings); gcMARK(pr->current_mt); + + gcMARK(pr->constant_folding); gcMARK(pr->overflow_reply); @@ -1047,6 +1049,27 @@ mark_pipe { gcBYTES_TO_WORDS(sizeof(Scheme_Pipe)); } +mark_logger { + mark: + Scheme_Logger *l = (Scheme_Logger *)p; + gcMARK(l->name); + gcMARK(l->parent); + gcMARK(l->readers); + gcMARK(l->timestamp); + size: + gcBYTES_TO_WORDS(sizeof(Scheme_Logger)); +} + +mark_log_reader { + mark: + Scheme_Log_Reader *lr = (Scheme_Log_Reader *)p; + gcMARK(lr->ch); + gcMARK(lr->head); + gcMARK(lr->tail); + size: + gcBYTES_TO_WORDS(sizeof(Scheme_Log_Reader)); +} + END type; /**********************************************************************/ @@ -1111,6 +1134,7 @@ mark_optimize_info { gcMARK(i->top_level_consts); gcMARK(i->transitive_use); gcMARK(i->transitive_use_len); + gcMARK(i->context); size: gcBYTES_TO_WORDS(sizeof(Optimize_Info)); diff --git a/src/mzscheme/src/schemef.h b/src/mzscheme/src/schemef.h index 0ff22b1279..6e52272f58 100644 --- a/src/mzscheme/src/schemef.h +++ b/src/mzscheme/src/schemef.h @@ -176,6 +176,11 @@ MZ_EXTERN void scheme_warning(char *msg, ...); MZ_EXTERN void scheme_raise(Scheme_Object *exn); +MZ_EXTERN int scheme_log_level_p(Scheme_Logger *logger, int level); +MZ_EXTERN void scheme_log(Scheme_Logger *logger, int level, int flags, + char *msg, ...); +MZ_EXTERN void scheme_log_message(Scheme_Logger *logger, int level, char *buffer, long len, Scheme_Object *data); + MZ_EXTERN void scheme_wrong_count(const char *name, int minc, int maxc, int argc, Scheme_Object **argv); MZ_EXTERN void scheme_wrong_count_m(const char *name, int minc, int maxc, diff --git a/src/mzscheme/src/schemex.h b/src/mzscheme/src/schemex.h index 52f2c4cc8f..8e86711f3b 100644 --- a/src/mzscheme/src/schemex.h +++ b/src/mzscheme/src/schemex.h @@ -138,6 +138,10 @@ void (*scheme_signal_error)(const char *msg, ...); void (*scheme_raise_exn)(int exnid, ...); void (*scheme_warning)(char *msg, ...); void (*scheme_raise)(Scheme_Object *exn); +int (*scheme_log_level_p)(Scheme_Logger *logger, int level); +void (*scheme_log)(Scheme_Logger *logger, int level, int flags, + char *msg, ...); +void (*scheme_log_message)(Scheme_Logger *logger, int level, char *buffer, long len, Scheme_Object *data); void (*scheme_wrong_count)(const char *name, int minc, int maxc, int argc, Scheme_Object **argv); void (*scheme_wrong_count_m)(const char *name, int minc, int maxc, diff --git a/src/mzscheme/src/schemex.inc b/src/mzscheme/src/schemex.inc index 23bcb5a049..add805befa 100644 --- a/src/mzscheme/src/schemex.inc +++ b/src/mzscheme/src/schemex.inc @@ -83,6 +83,9 @@ scheme_extension_table->scheme_raise_exn = scheme_raise_exn; scheme_extension_table->scheme_warning = scheme_warning; scheme_extension_table->scheme_raise = scheme_raise; + scheme_extension_table->scheme_log_level_p = scheme_log_level_p; + scheme_extension_table->scheme_log = scheme_log; + scheme_extension_table->scheme_log_message = scheme_log_message; scheme_extension_table->scheme_wrong_count = scheme_wrong_count; scheme_extension_table->scheme_wrong_count_m = scheme_wrong_count_m; scheme_extension_table->scheme_case_lambda_wrong_count = scheme_case_lambda_wrong_count; diff --git a/src/mzscheme/src/schemexm.h b/src/mzscheme/src/schemexm.h index bb9b36d826..d496cd9088 100644 --- a/src/mzscheme/src/schemexm.h +++ b/src/mzscheme/src/schemexm.h @@ -83,6 +83,9 @@ #define scheme_raise_exn (scheme_extension_table->scheme_raise_exn) #define scheme_warning (scheme_extension_table->scheme_warning) #define scheme_raise (scheme_extension_table->scheme_raise) +#define scheme_log_level_p (scheme_extension_table->scheme_log_level_p) +#define scheme_log (scheme_extension_table->scheme_log) +#define scheme_log_message (scheme_extension_table->scheme_log_message) #define scheme_wrong_count (scheme_extension_table->scheme_wrong_count) #define scheme_wrong_count_m (scheme_extension_table->scheme_wrong_count_m) #define scheme_case_lambda_wrong_count (scheme_extension_table->scheme_case_lambda_wrong_count) diff --git a/src/mzscheme/src/schminc.h b/src/mzscheme/src/schminc.h index 781276969c..b37c76aaf1 100644 --- a/src/mzscheme/src/schminc.h +++ b/src/mzscheme/src/schminc.h @@ -13,7 +13,7 @@ #define USE_COMPILED_STARTUP 1 -#define EXPECTED_PRIM_COUNT 917 +#define EXPECTED_PRIM_COUNT 925 #ifdef MZSCHEME_SOMETHING_OMITTED # undef USE_COMPILED_STARTUP diff --git a/src/mzscheme/src/schpriv.h b/src/mzscheme/src/schpriv.h index 689a7ba2fb..65db4c3969 100644 --- a/src/mzscheme/src/schpriv.h +++ b/src/mzscheme/src/schpriv.h @@ -1313,6 +1313,7 @@ void scheme_get_outof_line(Scheme_Channel_Syncer *ch_w); void scheme_post_syncing_nacks(Syncing *syncing); int scheme_try_channel_get(Scheme_Object *ch); +int scheme_try_channel_put(Scheme_Object *ch, Scheme_Object *v); /*========================================================================*/ /* numbers */ @@ -1843,6 +1844,8 @@ typedef struct Optimize_Info int transitive_use_pos; /* set to pos + 1 when optimizing a letrec-bound procedure */ mzshort **transitive_use; int *transitive_use_len; + + Scheme_Object *context; /* for logging */ } Optimize_Info; typedef struct Scheme_Object *(*Scheme_Syntax_Optimizer)(Scheme_Object *data, Optimize_Info *info); @@ -1872,7 +1875,7 @@ typedef struct Scheme_Closure_Data mzshort closure_size; mzshort *closure_map; /* actually a Closure_Info* until resolved; if CLOS_HAS_REF_ARGS, followed by bit array */ Scheme_Object *code; - Scheme_Object *name; + Scheme_Object *name; /* name or (vector name src line col pos span generated?) */ #ifdef MZ_USE_JIT union { struct Scheme_Closure_Data *jit_clone; @@ -2293,7 +2296,8 @@ void scheme_prepare_env_renames(Scheme_Env *env, int kind); int scheme_used_app_only(Scheme_Comp_Env *env, int which); int scheme_used_ever(Scheme_Comp_Env *env, int which); -int scheme_omittable_expr(Scheme_Object *o, int vals, int fuel, int resolved); +int scheme_omittable_expr(Scheme_Object *o, int vals, int fuel, int resolved, + Optimize_Info *warn_info); int scheme_is_env_variable_boxed(Scheme_Comp_Env *env, int which); @@ -2721,6 +2725,33 @@ Scheme_Object *scheme_get_or_check_arity(Scheme_Object *p, long a); int scheme_native_arity_check(Scheme_Object *closure, int argc); Scheme_Object *scheme_get_native_arity(Scheme_Object *closure); +struct Scheme_Logger { + Scheme_Object so; + Scheme_Object *name; + Scheme_Logger *parent; + int want_level; + long *timestamp, local_timestamp; /* determines when want_level is up-to-date */ + int syslog_level, stderr_level; + Scheme_Object *readers; /* list of weak boxes */ +}; + +typedef struct Scheme_Log_Reader { + Scheme_Object so; + int want_level; + Scheme_Object *ch; + Scheme_Object *head, *tail; +} Scheme_Log_Reader; + +extern Scheme_Logger *scheme_main_logger; + +char *scheme_optimize_context_to_string(Scheme_Object *context); + +void scheme_write_proc_context(Scheme_Object *port, int print_width, + Scheme_Object *name, + Scheme_Object *src, Scheme_Object *line, + Scheme_Object *col, Scheme_Object *pos, + int generated); + /*========================================================================*/ /* filesystem utilities */ /*========================================================================*/ @@ -2773,6 +2804,7 @@ int scheme_is_special_filename(const char *_f, int not_nul); #endif char *scheme_get_exec_path(void); +Scheme_Object *scheme_get_run_cmd(void); Scheme_Object *scheme_get_fd_identity(Scheme_Object *port, long fd); diff --git a/src/mzscheme/src/schvers.h b/src/mzscheme/src/schvers.h index e7bc90ad8e..5749ddb116 100644 --- a/src/mzscheme/src/schvers.h +++ b/src/mzscheme/src/schvers.h @@ -13,12 +13,12 @@ consistently.) */ -#define MZSCHEME_VERSION "4.0.2.3" +#define MZSCHEME_VERSION "4.0.2.4" #define MZSCHEME_VERSION_X 4 #define MZSCHEME_VERSION_Y 0 #define MZSCHEME_VERSION_Z 2 -#define MZSCHEME_VERSION_W 3 +#define MZSCHEME_VERSION_W 4 #define MZSCHEME_VERSION_MAJOR ((MZSCHEME_VERSION_X * 100) + MZSCHEME_VERSION_Y) #define MZSCHEME_VERSION_MINOR ((MZSCHEME_VERSION_Z * 1000) + MZSCHEME_VERSION_W) diff --git a/src/mzscheme/src/sema.c b/src/mzscheme/src/sema.c index f68a76f28d..6fe168cead 100644 --- a/src/mzscheme/src/sema.c +++ b/src/mzscheme/src/sema.c @@ -955,6 +955,19 @@ Scheme_Object *scheme_make_channel_put_evt(Scheme_Object *ch, Scheme_Object *v) return (Scheme_Object *)cp; } +int scheme_try_channel_put(Scheme_Object *ch, Scheme_Object *v) +{ + if (((Scheme_Channel *)ch)->get_first) { + Scheme_Object *a[2]; + v = scheme_make_channel_put_evt(ch, v); + a[0] = scheme_make_integer(0); + a[1] = v; + v = scheme_sync_timeout(2, a); + return SCHEME_TRUEP(v); + } else + return 0; +} + static Scheme_Object *make_channel_put(int argc, Scheme_Object **argv) { if (!SCHEME_CHANNELP(argv[0])) diff --git a/src/mzscheme/src/stypes.h b/src/mzscheme/src/stypes.h index acede7433d..fea6451187 100644 --- a/src/mzscheme/src/stypes.h +++ b/src/mzscheme/src/stypes.h @@ -165,80 +165,82 @@ enum { scheme_cust_box_type, /* 147 */ scheme_resolved_module_path_type, /* 148 */ scheme_module_phase_exports_type, /* 149 */ + scheme_logger_type, /* 150 */ + scheme_log_reader_type, /* 151 */ #ifdef MZTAG_REQUIRED - _scheme_last_normal_type_, /* 150 */ + _scheme_last_normal_type_, /* 152 */ - scheme_rt_weak_array, /* 151 */ + scheme_rt_weak_array, /* 153 */ - scheme_rt_comp_env, /* 152 */ - scheme_rt_constant_binding, /* 153 */ - scheme_rt_resolve_info, /* 154 */ - scheme_rt_optimize_info, /* 155 */ - scheme_rt_compile_info, /* 156 */ - scheme_rt_cont_mark, /* 157 */ - scheme_rt_saved_stack, /* 158 */ - scheme_rt_reply_item, /* 159 */ - scheme_rt_closure_info, /* 160 */ - scheme_rt_overflow, /* 161 */ - scheme_rt_overflow_jmp, /* 162 */ - scheme_rt_meta_cont, /* 163 */ - scheme_rt_dyn_wind_cell, /* 164 */ - scheme_rt_dyn_wind_info, /* 165 */ - scheme_rt_dyn_wind, /* 166 */ - scheme_rt_dup_check, /* 167 */ - scheme_rt_thread_memory, /* 168 */ - scheme_rt_input_file, /* 169 */ - scheme_rt_input_fd, /* 170 */ - scheme_rt_oskit_console_input, /* 171 */ - scheme_rt_tested_input_file, /* 172 */ - scheme_rt_tested_output_file, /* 173 */ - scheme_rt_indexed_string, /* 174 */ - scheme_rt_output_file, /* 175 */ - scheme_rt_load_handler_data, /* 176 */ - scheme_rt_pipe, /* 177 */ - scheme_rt_beos_process, /* 178 */ - scheme_rt_system_child, /* 179 */ - scheme_rt_tcp, /* 180 */ - scheme_rt_write_data, /* 181 */ - scheme_rt_tcp_select_info, /* 182 */ - scheme_rt_namespace_option, /* 183 */ - scheme_rt_param_data, /* 184 */ - scheme_rt_will, /* 185 */ - scheme_rt_struct_proc_info, /* 186 */ - scheme_rt_linker_name, /* 187 */ - scheme_rt_param_map, /* 188 */ - scheme_rt_finalization, /* 189 */ - scheme_rt_finalizations, /* 190 */ - scheme_rt_cpp_object, /* 191 */ - scheme_rt_cpp_array_object, /* 192 */ - scheme_rt_stack_object, /* 193 */ - scheme_rt_preallocated_object, /* 194 */ - scheme_thread_hop_type, /* 195 */ - scheme_rt_srcloc, /* 196 */ - scheme_rt_evt, /* 197 */ - scheme_rt_syncing, /* 198 */ - scheme_rt_comp_prefix, /* 199 */ - scheme_rt_user_input, /* 200 */ - scheme_rt_user_output, /* 201 */ - scheme_rt_compact_port, /* 202 */ - scheme_rt_read_special_dw, /* 203 */ - scheme_rt_regwork, /* 204 */ - scheme_rt_buf_holder, /* 205 */ - scheme_rt_parameterization, /* 206 */ - scheme_rt_print_params, /* 207 */ - scheme_rt_read_params, /* 208 */ - scheme_rt_native_code, /* 209 */ - scheme_rt_native_code_plus_case, /* 210 */ - scheme_rt_jitter_data, /* 211 */ - scheme_rt_module_exports, /* 212 */ - scheme_rt_delay_load_info, /* 213 */ - scheme_rt_marshal_info, /* 214 */ - scheme_rt_unmarshal_info, /* 215 */ - scheme_rt_runstack, /* 216 */ - scheme_rt_sfs_info, /* 217 */ - scheme_rt_validate_clearing, /* 218 */ - scheme_rt_rb_node, /* 219 */ + scheme_rt_comp_env, /* 154 */ + scheme_rt_constant_binding, /* 155 */ + scheme_rt_resolve_info, /* 156 */ + scheme_rt_optimize_info, /* 157 */ + scheme_rt_compile_info, /* 158 */ + scheme_rt_cont_mark, /* 159 */ + scheme_rt_saved_stack, /* 160 */ + scheme_rt_reply_item, /* 161 */ + scheme_rt_closure_info, /* 162 */ + scheme_rt_overflow, /* 163 */ + scheme_rt_overflow_jmp, /* 164 */ + scheme_rt_meta_cont, /* 165 */ + scheme_rt_dyn_wind_cell, /* 166 */ + scheme_rt_dyn_wind_info, /* 167 */ + scheme_rt_dyn_wind, /* 168 */ + scheme_rt_dup_check, /* 169 */ + scheme_rt_thread_memory, /* 170 */ + scheme_rt_input_file, /* 171 */ + scheme_rt_input_fd, /* 172 */ + scheme_rt_oskit_console_input, /* 173 */ + scheme_rt_tested_input_file, /* 174 */ + scheme_rt_tested_output_file, /* 175 */ + scheme_rt_indexed_string, /* 176 */ + scheme_rt_output_file, /* 177 */ + scheme_rt_load_handler_data, /* 178 */ + scheme_rt_pipe, /* 179 */ + scheme_rt_beos_process, /* 180 */ + scheme_rt_system_child, /* 181 */ + scheme_rt_tcp, /* 182 */ + scheme_rt_write_data, /* 183 */ + scheme_rt_tcp_select_info, /* 184 */ + scheme_rt_namespace_option, /* 185 */ + scheme_rt_param_data, /* 186 */ + scheme_rt_will, /* 187 */ + scheme_rt_struct_proc_info, /* 188 */ + scheme_rt_linker_name, /* 189 */ + scheme_rt_param_map, /* 190 */ + scheme_rt_finalization, /* 191 */ + scheme_rt_finalizations, /* 192 */ + scheme_rt_cpp_object, /* 193 */ + scheme_rt_cpp_array_object, /* 194 */ + scheme_rt_stack_object, /* 195 */ + scheme_rt_preallocated_object, /* 196 */ + scheme_thread_hop_type, /* 197 */ + scheme_rt_srcloc, /* 198 */ + scheme_rt_evt, /* 199 */ + scheme_rt_syncing, /* 200 */ + scheme_rt_comp_prefix, /* 201 */ + scheme_rt_user_input, /* 202 */ + scheme_rt_user_output, /* 203 */ + scheme_rt_compact_port, /* 204 */ + scheme_rt_read_special_dw, /* 205 */ + scheme_rt_regwork, /* 206 */ + scheme_rt_buf_holder, /* 207 */ + scheme_rt_parameterization, /* 208 */ + scheme_rt_print_params, /* 209 */ + scheme_rt_read_params, /* 210 */ + scheme_rt_native_code, /* 211 */ + scheme_rt_native_code_plus_case, /* 212 */ + scheme_rt_jitter_data, /* 213 */ + scheme_rt_module_exports, /* 214 */ + scheme_rt_delay_load_info, /* 215 */ + scheme_rt_marshal_info, /* 216 */ + scheme_rt_unmarshal_info, /* 217 */ + scheme_rt_runstack, /* 218 */ + scheme_rt_sfs_info, /* 219 */ + scheme_rt_validate_clearing, /* 220 */ + scheme_rt_rb_node, /* 221 */ #endif _scheme_last_type_ diff --git a/src/mzscheme/src/syntax.c b/src/mzscheme/src/syntax.c index 806b9e4a69..06dd3067be 100644 --- a/src/mzscheme/src/syntax.c +++ b/src/mzscheme/src/syntax.c @@ -3018,7 +3018,7 @@ scheme_optimize_lets(Scheme_Object *form, Optimize_Info *info, int for_inline) to (let-values ([id e] ...) body) for simple e. */ if ((pre_body->count != 1) && is_values_apply(value) - && scheme_omittable_expr(value, pre_body->count, -1, 0)) { + && scheme_omittable_expr(value, pre_body->count, -1, 0, info)) { if (!pre_body->count && !i) { /* We want to drop the clause entirely, but doing it here messes up the loop for letrec. So wait and @@ -3225,7 +3225,7 @@ scheme_optimize_lets(Scheme_Object *form, Optimize_Info *info, int for_inline) } } if (!used - && scheme_omittable_expr(pre_body->value, pre_body->count, -1, 0)) { + && scheme_omittable_expr(pre_body->value, pre_body->count, -1, 0, info)) { for (j = pre_body->count; j--; ) { if (pre_body->flags[j] & SCHEME_WAS_USED) { pre_body->flags[j] -= SCHEME_WAS_USED; @@ -3604,7 +3604,7 @@ scheme_resolve_lets(Scheme_Object *form, Resolve_Info *info) } if (j >= 0) break; - if (!scheme_omittable_expr(clv->value, clv->count, -1, 0)) + if (!scheme_omittable_expr(clv->value, clv->count, -1, 0, NULL)) break; } if (i < 0) { @@ -5478,7 +5478,7 @@ static Scheme_Object *eval_letmacro_rhs(Scheme_Object *a, Scheme_Comp_Env *rhs_e save_runstack = scheme_push_prefix(NULL, rp, NULL, NULL, phase, phase); - if (scheme_omittable_expr(a, 1, -1, 0)) { + if (scheme_omittable_expr(a, 1, -1, 0, NULL)) { /* short cut */ a = _scheme_eval_linked_expr_multi(a); } else { diff --git a/src/mzscheme/src/thread.c b/src/mzscheme/src/thread.c index 81d9e635f9..17dee8a78c 100644 --- a/src/mzscheme/src/thread.c +++ b/src/mzscheme/src/thread.c @@ -206,11 +206,16 @@ Scheme_Object *scheme_exn_handler_key; Scheme_Object *scheme_break_enabled_key; long scheme_total_gc_time; -static long start_this_gc_time; +static long start_this_gc_time, end_this_gc_time; +#ifndef MZ_PRECISE_GC extern MZ_DLLIMPORT void (*GC_collect_start_callback)(void); extern MZ_DLLIMPORT void (*GC_collect_end_callback)(void); +#endif static void get_ready_for_GC(void); static void done_with_GC(void); +#ifdef MZ_PRECISE_GC +static void inform_GC(int major_gc, long pre_used, long post_used); +#endif static volatile short delayed_break_ready = 0; static Scheme_Thread *main_break_target_thread; @@ -2105,6 +2110,9 @@ static Scheme_Thread *make_thread(Scheme_Config *config, GC_collect_start_callback = get_ready_for_GC; GC_collect_end_callback = done_with_GC; +#ifdef MZ_PRECISE_GC + GC_collect_inform_callback = inform_GC; +#endif #ifdef LINK_EXTENSIONS_BY_TABLE scheme_current_thread_ptr = &scheme_current_thread; @@ -7184,9 +7192,24 @@ static void done_with_GC() scheme_block_child_signals(0); #endif - scheme_total_gc_time += (scheme_get_process_milliseconds() - start_this_gc_time); + end_this_gc_time = scheme_get_process_milliseconds(); + scheme_total_gc_time += (end_this_gc_time - start_this_gc_time); } +#ifdef MZ_PRECISE_GC +static void inform_GC(int major_gc, long pre_used, long post_used) +{ + if (scheme_main_logger) + scheme_log(scheme_main_logger, + SCHEME_LOG_INFO, 0, + "GC [%s] at %ld bytes; %ld collected in %ld msec", + (major_gc ? "major" : "minor"), + pre_used, pre_used - post_used, + end_this_gc_time - start_this_gc_time); +} +#endif + + #ifdef MZ_XFORM END_XFORM_SKIP; #endif diff --git a/src/mzscheme/src/type.c b/src/mzscheme/src/type.c index cd903b336c..789a632be5 100644 --- a/src/mzscheme/src/type.c +++ b/src/mzscheme/src/type.c @@ -266,6 +266,9 @@ scheme_init_type (Scheme_Env *env) set_name(scheme_already_comp_type, ""); + set_name(scheme_logger_type, ""); + set_name(scheme_log_reader_type, ""); + set_name(_scheme_values_types_, ""); set_name(_scheme_compiled_values_types_, ""); @@ -610,6 +613,9 @@ void scheme_register_traversers(void) GC_REG_TRAV(scheme_resolved_module_path_type, small_object); + GC_REG_TRAV(scheme_logger_type, mark_logger); + GC_REG_TRAV(scheme_log_reader_type, mark_log_reader); + GC_REG_TRAV(scheme_rt_runstack, runstack_val); } diff --git a/src/mzscheme/uconfig.h b/src/mzscheme/uconfig.h index 65094f5d91..12610b9bf0 100644 --- a/src/mzscheme/uconfig.h +++ b/src/mzscheme/uconfig.h @@ -18,6 +18,8 @@ #define UNIX_PROCESSES #define CLOSE_ALL_FDS_AFTER_FORK +#define USE_C_SYSLOG + #define EXPAND_FILENAME_TILDE #define DO_STACK_CHECK