suzanne.soy/racket
1
0
Fork 0
Code Issues Pull Requests Actions Packages Projects Releases Wiki Activity

v4.0.2.4: logging

Browse Source 
svn: r10818
This commit is contained in:
Matthew Flatt 2008-07-17 15:20:17 +00:00
parent 9e776c0712
commit 9af00fcfb4
63 changed files with 1944 additions and 561 deletions
Show Stats Download Patch File Download Diff File Expand all files Collapse all files

2
collects/algol60/cfg-parser.ss
View File

@ -686,7 +686,7 @@
#f #f
"bad grammar clause" "bad grammar clause"
stx stx
(car #f))] (car clauses))]
[_else [_else
(loop (cdr clauses) (loop (cdr clauses)
cfg-start cfg-start

2
collects/compiler/to-core.ss
View File

@ -403,7 +403,7 @@
stx stx
(#,set-stx #,id #,(add-identifier/pos (apply-certs certs #'x) li trans?) #,(loop #'e))))] (#,set-stx #,id #,(add-identifier/pos (apply-certs certs #'x) li trans?) #,(loop #'e))))]
[(#%variable-reference e) [(#%variable-reference e)
(add-literal stx li)] (add-literal stx li safe-vector-ref-stx id)]
[(if e ...) [(if e ...)
(quasisyntax/loc+props (quasisyntax/loc+props
stx stx

3
collects/framework/private/text.ss
View File

@ -2822,7 +2822,8 @@ designates the character that triggers autocompletion
[else [else
(raise (make-exn:fail:contract (raise (make-exn:fail:contract
(string->immutable-string (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 (define autocomplete-append-after
(make-guarded-parameter 'append-after "string" "" string?)) (make-guarded-parameter 'append-after "string" "" string?))

2
collects/games/gcalc/gcalc.ss
View File

@ -576,7 +576,7 @@
(message-box (message-box
"Open" (format "~s is not a GCalc file." f) "Open" (format "~s is not a GCalc file." f)
gcalc-frame '(ok)))]) gcalc-frame '(ok)))])
(or (equal? "GCALC" (read)) (error)) (or (equal? "GCALC" (read)) (error "gcalc"))
(set-file-name! f) (set-file-name! f)
(for-each (lambda (c) ((custom-setter c) (read))) customs) (for-each (lambda (c) ((custom-setter c) (read))) customs)
(send main-cell set-contents! (validate-contents (read))) (send main-cell set-contents! (validate-contents (read)))

4
collects/games/gl-board-game/gl-board.ss
View File

@ -106,7 +106,7 @@
pieces)]) pieces)])
(if p (if p
(set-piece-enabled?! p (and on? #t)) (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 ;; enabled?: info -> boolean
(define/public (enabled? info) (define/public (enabled? info)
@ -115,7 +115,7 @@
pieces))) pieces)))
(if p (if p
(piece-enabled? p) (piece-enabled? p)
(raise-mismatch-error "no matching piece: " info)))) (raise-mismatch-error 'enabled? "no matching piece: " info))))
;; remove-piece: info -> ;; remove-piece: info ->
;; Removes all pieces whose info is equal? to p-i from this board. ;; Removes all pieces whose info is equal? to p-i from this board.

3
collects/gui-debugger/marks.ss
View File

@ -16,7 +16,7 @@
(provide/contract (provide/contract
;[make-debug-info (-> any? binding-set? varref-set? any? boolean? syntax?)] ; (location tail-bound free label lifting? -> mark-stx) ;[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))))] [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-all-bindings ((identifier? . -> . boolean?) mark-list? . -> . (listof any/c))]
[lookup-first-binding ((identifier? . -> . boolean?) mark-list? ( -> any) . -> . any)] [lookup-first-binding ((identifier? . -> . boolean?) mark-list? ( -> any) . -> . any)]
[lookup-binding (mark-list? identifier? . -> . any)]) [lookup-binding (mark-list? identifier? . -> . any)])
@ -179,5 +179,6 @@
(define (assemble-debug-info tail-bound free-vars label lifting?) (define (assemble-debug-info tail-bound free-vars label lifting?)
(map make-mark-binding-stx free-vars)) (map make-mark-binding-stx free-vars))
#;
(define (make-top-level-mark source-expr) (define (make-top-level-mark source-expr)
(make-full-mark source-expr 'top-level null))) (make-full-mark source-expr 'top-level null)))

2
collects/lang/run-teaching-program.ss
View File

@ -49,7 +49,7 @@
(with-handlers ((exn:fail? (λ (x) (error 'teachpack (missing-tp-message tp))))) (with-handlers ((exn:fail? (λ (x) (error 'teachpack (missing-tp-message tp)))))
(unless (file-exists? (build-path (apply collection-path (cddr tp)) (unless (file-exists? (build-path (apply collection-path (cddr tp))
(cadr tp))) (cadr tp)))
(error)))) (error "fail"))))
teachpacks) teachpacks)
(rewrite-module (rewrite-module
(expand (expand

18
collects/little-helper/indexer/planet/galore.plt/2/2/private/raw-red-black-tree-set.scm
View File

@ -115,12 +115,12 @@
[($ B l _ r) (let ([height-left (check l)] [($ B l _ r) (let ([height-left (check l)]
[height-right (check r)]) [height-right (check r)])
(if (not (= height-left height-right)) (if (not (= height-left height-right))
(error) (error "fail")
(+ height-left 1)))] (+ height-left 1)))]
[($ R l _ r) (let ([height-left (check l)] [($ R l _ r) (let ([height-left (check l)]
[height-right (check r)]) [height-right (check r)])
(if (not (= height-left height-right)) (if (not (= height-left height-right))
(error) (error "fail")
height-left))])) height-left))]))
;;; SET OPERATIONS ;;; SET OPERATIONS
@ -208,7 +208,7 @@
(match s1 (match s1
[($ B _ _ _) s1] [($ B _ _ _) s1]
[($ R a y b) (B- a y b)] [($ R a y b) (B- a y b)]
[() (error)]))) [() (error "fail")])))
(define (insert/combiner cmp x s combine) (define (insert/combiner cmp x s combine)
(define (ins s) (define (ins s)
@ -232,7 +232,7 @@
(match s1 (match s1
[($ B _ _ _) s1] [($ B _ _ _) s1]
[($ R a y b) (B- a y b)] [($ R a y b) (B- a y b)]
[() (error)]))) [() (error "fail")])))
(define (insert* cmp xs s) (define (insert* cmp xs s)
(list:foldl (lambda (x acc) (insert cmp x acc)) s xs)) (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)] [($ 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 ($ 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)] [($ 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 ; (* [unbalanced_right] repares invariant (2) when the black height of the
; right son exceeds (by 1) the black height of the left son *) ; 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)] [($ 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 ($ 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)] [($ 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 ; (* [remove_min s = (s',m,b)] extracts the minimum [m] of [s], [s'] being the
@ -274,7 +274,7 @@
; minimum is reached ; minimum is reached
[($ B () x ()) (values empty x #t)] [($ B () x ()) (values empty x #t)]
[($ B () x ($ R l y r)) (values (B- l y r) x #f)] [($ 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)] [($ R () x r) (values r x #f)]
; minimum is recursively extracted from [l] ; minimum is recursively extracted from [l]
[($ B l x r) (let-values ([(l1 m d) (remove-min l)]) [($ B l x r) (let-values ([(l1 m d) (remove-min l)])
@ -377,11 +377,11 @@
[(= k 0) (cond [(= k 0) (cond
[(= n 0) (cons '() sl)] [(= n 0) (cons '() sl)]
[else (match sl [else (match sl
[() (error)] [() (error "fail")]
[(x . sl) (cons (R- empty x empty) sl)])])] [(x . sl) (cons (R- empty x empty) sl)])])]
[else (let ([n1 (quotient (- n 1) 2)]) [else (let ([n1 (quotient (- n 1) 2)])
(match (build sl n1 (- k 1)) (match (build sl n1 (- k 1))
[(_ . ()) (error)] [(_ . ()) (error "fail")]
[(l . (x . sl)) (match-let ([(r . sl) (build sl (sub1 (- n n1)) (- k 1))]) [(l . (x . sl)) (match-let ([(r . sl) (build sl (sub1 (- n n1)) (- k 1))])
(cons (B- r x l) sl))]))])) (cons (B- r x l) sl))]))]))
(let ([n (length sl)]) (let ([n (length sl)])

2
collects/macro-debugger/util/notify.ss
View File

@ -20,7 +20,7 @@
(define-for-syntax (join . args) (define-for-syntax (join . args)
(define (->string x) (define (->string x)
(cond [(string? x) x] (cond [(string? x) x]
[(symbol? x) (symbol->string)] [(symbol? x) (symbol->string x)]
[(identifier? x) (symbol->string (syntax-e x))] [(identifier? x) (symbol->string (syntax-e x))]
[else (error '->string)])) [else (error '->string)]))
(string->symbol (apply string-append (map ->string args)))) (string->symbol (apply string-append (map ->string args))))

131
collects/mred/private/afm.ss
View File

@ -1,22 +1,21 @@
(module afm mzscheme (module afm scheme/base
(require mzlib/file (require scheme/file
mzlib/list) scheme/list)
(provide (protect afm-draw-text (provide (protect-out afm-draw-text
afm-get-text-extent afm-get-text-extent
afm-expand-name afm-expand-name
afm-glyph-exists? afm-glyph-exists?
afm-record-font afm-record-font
afm-fonts-string) afm-fonts-string)
current-ps-afm-file-paths current-ps-afm-file-paths
current-ps-cmap-file-paths) current-ps-cmap-file-paths)
(define orig-err (current-error-port))
(define (report-exn exn) (define (report-exn exn)
(fprintf orig-err "PostScript/AFM error: ~a~n" (log-error (format "PostScript/AFM error: ~a~n"
(if (exn? exn) (if (exn? exn)
(exn-message exn) (exn-message exn)
exn))) exn))))
(define bytes->number (define bytes->number
(case-lambda (case-lambda
@ -73,7 +72,7 @@
(define got-long-name-list? #f) (define got-long-name-list? #f)
(define (read-glyph-names gl.txt) (define (read-glyph-names gl.txt)
(let ([ht (make-hash-table 'equal)]) (let ([ht (make-hash)])
(with-handlers ([exn:fail? report-exn]) (with-handlers ([exn:fail? report-exn])
(call-with-input-file* (call-with-input-file*
gl.txt 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])$" (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)]) l)])
(when m (when m
(hash-table-put! ht (hash-set! ht
(cadr m) (cadr m)
(bytes->number (caddr m) 16)))) (bytes->number (caddr m) 16))))
(loop))))))) (loop)))))))
ht)) ht))
@ -102,7 +101,7 @@
;; Read glyph names: ;; Read glyph names:
(read-glyph-names file) (read-glyph-names file)
;; Make empty hash table: ;; Make empty hash table:
(make-hash-table))))) (make-hasheq)))))
;; Reads the Adobe char name -> Unicode table ;; Reads the Adobe char name -> Unicode table
(define (read-names! gl.txt long?) (define (read-names! gl.txt long?)
@ -112,22 +111,22 @@
;; Maps Adobe char name to Unicode, loading the table as necesary ;; Maps Adobe char name to Unicode, loading the table as necesary
(define (find-unicode font-glyphnames name) (define (find-unicode font-glyphnames name)
(hash-table-get (hash-ref
font-glyphnames font-glyphnames
name name
(lambda () (lambda ()
(unless adobe-name-to-code-point (unless adobe-name-to-code-point
(read-names! "glyphshortlist.txt" #f)) (read-names! "glyphshortlist.txt" #f))
(hash-table-get adobe-name-to-code-point (hash-ref adobe-name-to-code-point
name name
(lambda () (lambda ()
(if got-long-name-list? (if got-long-name-list?
(let ([m (regexp-match #rx#"^uni([0-9a-fA-Z]+)" name)]) (let ([m (regexp-match #rx#"^uni([0-9a-fA-Z]+)" name)])
(and m (and m
(string->number (bytes->string/latin-1 (cadr m)) 16))) (string->number (bytes->string/latin-1 (cadr m)) 16)))
(begin (begin
(read-names! "glyphlist.txt" #t) (read-names! "glyphlist.txt" #t)
(find-unicode font-glyphnames name)))))))) (find-unicode font-glyphnames name))))))))
;; ------------------------------------------------------------ ;; ------------------------------------------------------------
@ -140,15 +139,14 @@
;; when reading any other XXX -> Adobe-CNS to generate an ;; when reading any other XXX -> Adobe-CNS to generate an
;; XXX -> UTF-32 table. ;; XXX -> UTF-32 table.
(define (read-cmap file to-unicode) (define (read-cmap file to-unicode)
(let* ([ht (make-hash-table 'equal)] (let* ([ht (make-hash)]
[put! (if to-unicode [put! (if to-unicode
(lambda (c cns) (lambda (c cns)
(hash-table-put! ht (hash-set! ht
c c
(hash-table-get to-unicode cns (hash-ref to-unicode cns #f)))
(lambda () #f))))
(lambda (c cns) (lambda (c cns)
(hash-table-put! ht cns c)))]) (hash-set! ht cns c)))])
(with-handlers ([exn:fail? report-exn]) (with-handlers ([exn:fail? report-exn])
(call-with-input-file* (call-with-input-file*
file file
@ -199,18 +197,18 @@
(find-path (current-ps-cmap-file-paths) "UniCNS-UTF32-H") (find-path (current-ps-cmap-file-paths) "UniCNS-UTF32-H")
#f))) #f)))
(define cmap-table (make-hash-table 'equal)) (define cmap-table (make-hash))
(define (get-cmap name) (define (get-cmap name)
(unless cns->unicode-table (unless cns->unicode-table
(read-cns->unicode!)) (read-cns->unicode!))
(hash-table-get (hash-ref
cmap-table cmap-table
name name
(lambda () (lambda ()
(let ([t (read-cmap (let ([t (read-cmap
(find-path (current-ps-cmap-file-paths) (bytes->path name)) (find-path (current-ps-cmap-file-paths) (bytes->path name))
cns->unicode-table)]) cns->unicode-table)])
(hash-table-put! cmap-table name t) (hash-set! cmap-table name t)
t)))) t))))
;; ---------------------------------------- ;; ----------------------------------------
@ -260,7 +258,7 @@
[bbox-up #f] [bbox-up #f]
[ascender #f] [ascender #f]
[cap-height #f] [cap-height #f]
[achars (make-hash-table 'equal)] [achars (make-hash)]
[kern-pairs null] [kern-pairs null]
[char-set #f] [char-set #f]
[char-set-name #f] [char-set-name #f]
@ -309,10 +307,10 @@
(bytes->number (cadr nm)) (bytes->number (cadr nm))
(cadr nm))) (cadr nm)))
0)]) 0)])
(hash-table-put! (hash-set!
achars achars
(if (and char-set is-cid?) (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)) (find-unicode font-glyphnames name))
(make-achar (make-achar
(let ([v (if (eq? n 'c) (let ([v (if (eq? n 'c)
@ -347,7 +345,7 @@
(let ([c1 (car kp)] (let ([c1 (car kp)]
[c2 (cadr kp)] [c2 (cadr kp)]
[amt (caddr 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)))) (achar-add-kern! achar c2 amt))))
kern-pairs) kern-pairs)
(let* ([descender (- (or descender bbox-down 0))] (let* ([descender (- (or descender bbox-down 0))]
@ -376,20 +374,20 @@
(extract-ligatures font-glyphnames rest))) (extract-ligatures font-glyphnames rest)))
null))) null)))
(define fonts (make-hash-table 'equal)) (define fonts (make-hash))
(define (get-font name) (define (get-font name)
(hash-table-get fonts name (hash-ref fonts name
(lambda () (lambda ()
(hash-table-put! fonts (hash-set! fonts
name name
(with-handlers ([void (lambda (exn) (with-handlers ([void (lambda (exn)
(report-exn exn) (report-exn exn)
#f)]) #f)])
(parse-afm (parse-afm
(find-path (current-ps-afm-file-paths) (find-path (current-ps-afm-file-paths)
(format "~a.afm" name))))) (format "~a.afm" name)))))
(get-font name)))) (get-font name))))
;; ---------------------------------------- ;; ----------------------------------------
@ -465,7 +463,7 @@
(let loop ([cl (map-symbols sym-map? (string->list string))][width 0.0]) (let loop ([cl (map-symbols sym-map? (string->list string))][width 0.0])
(cond (cond
[(empty? cl) width] [(empty? cl) width]
[else (let ([achar (hash-table-get [else (let ([achar (hash-ref
(font-achars font) (font-achars font)
(char->integer (car cl)) (char->integer (car cl))
(lambda () (lambda ()
@ -502,14 +500,14 @@
;; pen is positioned at text top-left: ;; pen is positioned at text top-left:
(define (afm-draw-text font-name size string out kern? sym-map? used-fonts) (define (afm-draw-text font-name size string out kern? sym-map? used-fonts)
(let* ([l (map-symbols sym-map? (string->list string))] (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) [font (or (get-font font-name)
(make-font 0 0 0 0 #hash() #f #f))] (make-font 0 0 0 0 #hash() #f #f))]
[show-simples (lambda (simples special-font-name special-font) [show-simples (lambda (simples special-font-name special-font)
(unless (null? simples) (unless (null? simples)
(when special-font (when special-font
(let ([name (afm-expand-name special-font-name)]) (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" (fprintf out "currentfont~n/~a findfont~n~a scalefont setfont~n"
name name
size))) size)))
@ -553,8 +551,7 @@
(cond (cond
[(null? l) [(null? l)
(show-simples simples special-font-name special-font)] (show-simples simples special-font-name special-font)]
[(hash-table-get (font-achars font) (char->integer (car l)) [(hash-ref (font-achars font) (char->integer (car l)) #f)
(lambda () #f))
=> (lambda (achar) => (lambda (achar)
(if (integer? (achar-enc achar)) (if (integer? (achar-enc achar))
;; It's simple... ;; It's simple...
@ -646,15 +643,15 @@
(define (afm-record-font name used-fonts) (define (afm-record-font name used-fonts)
(let ([used-fonts (or used-fonts (make-hash-table 'equal))]) (let ([used-fonts (or used-fonts (make-hash))])
(hash-table-put! used-fonts name #t) (hash-set! used-fonts name #t)
used-fonts)) used-fonts))
(define (afm-fonts-string used-fonts) (define (afm-fonts-string used-fonts)
(if (hash-table? used-fonts) (if (hash? used-fonts)
(let ([s (open-output-string)] (let ([s (open-output-string)]
[pos 0]) [pos 0])
(hash-table-for-each (hash-for-each
used-fonts used-fonts
(lambda (k v) (lambda (k v)
(let ([len (string-length k)]) (let ([len (string-length k)])
@ -681,9 +678,9 @@
(define (afm-glyph-exists?* font-name char-val) (define (afm-glyph-exists?* font-name char-val)
(let ([f (get-font font-name)]) (let ([f (get-font font-name)])
(and f (and f
(let ([achar (hash-table-get (font-achars f) (let ([achar (hash-ref (font-achars f)
char-val char-val
(lambda () #f))]) #f)])
(and achar (and achar
(list font-name f achar)))))) (list font-name f achar))))))

4
collects/mred/private/snipfile.ss
View File

@ -39,8 +39,8 @@
(if (or (ok-lib-path? m) (if (or (ok-lib-path? m)
(and (list? m) (and (list? m)
(= (length m) 2) (= (length m) 2)
(ok-lib-path? (car m) (ok-lib-path? (car m))
(ok-lib-path? (cadr m))))) (ok-lib-path? (cadr m))))
(let ([m (if (ok-lib-path? m) (let ([m (if (ok-lib-path? m)
m m
(car m))]) (car m))])

2
collects/mzlib/port.ss
View File

@ -1627,7 +1627,7 @@
(begin (begin
(when (> len2 (bytes-length out-bytes)) (when (> len2 (bytes-length out-bytes))
(raise-insane-decoding-length)) (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-start 0)
(set! out-end len2) (set! out-end len2)
used))] used))]

2
collects/net/url-unit.ss
View File

@ -154,7 +154,7 @@
[(pair? strs) [(pair? strs)
(apply build-path (string->path/win (car strs)) (apply build-path (string->path/win (car strs))
(map string->path-element/same (cdr 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)]) (let ([elems (map string->path-element/same strs)])
(if (url-path-absolute? url) (if (url-path-absolute? url)
(apply build-path (bytes->path #"/" 'unix) elems) (apply build-path (bytes->path #"/" 'unix) elems)

2
collects/r6rs/private/find-version.ss
View File

@ -70,7 +70,7 @@
(version-match? cand v)) (version-match? cand v))
(cdr vers))] (cdr vers))]
[(eq? (car vers) 'not) [(eq? (car vers) 'not)
(not (version-match? (cadr vers)))] (not (version-match? cand (cadr vers)))]
[(sub-version-match? (car cand) (car vers)) [(sub-version-match? (car cand) (car vers))
(version-match? (cdr cand) (cdr vers))] (version-match? (cdr cand) (cdr vers))]
[else #f])) [else #f]))

2
collects/rnrs/base-6.ss
View File

@ -226,7 +226,7 @@
+nan.0 +nan.0
1.0)] 1.0)]
[else [else
(raise-type-error "real number" y)])) (raise-type-error 'div "real number" y)]))
(define (mod x y) (define (mod x y)
(- x (* (div x y) y))) (- x (* (div x y) y)))

4
collects/scheme/match/define-forms.ss
View File

@ -40,8 +40,8 @@
(for/list ([ps pss]) (for/list ([ps pss])
(unless (= (length (syntax->list ps)) len) (unless (= (length (syntax->list ps)) len)
(raise-syntax-error (raise-syntax-error
'match "unequal number of patterns in match clauses" #f "unequal number of patterns in match clauses"
stx ps ps1))) stx ps)))
(with-syntax ([(vars ...) (generate-temporaries (car pss))]) (with-syntax ([(vars ...) (generate-temporaries (car pss))])
(syntax/loc stx (syntax/loc stx
(lambda (vars ...) (match* (vars ...) [pats . rhs] ...)))))])) (lambda (vars ...) (match* (vars ...) [pats . rhs] ...)))))]))

7
collects/scheme/mzscheme.ss
View File

@ -22,7 +22,8 @@
(#%provide require require-for-syntax require-for-template require-for-label (#%provide require require-for-syntax require-for-template require-for-label
provide provide-for-syntax provide-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) (rename old-case case)
(all-from "private/misc.ss") (all-from "private/misc.ss")
(all-from-except "private/stxcase-scheme.ss" _) (all-from-except "private/stxcase-scheme.ss" _)
@ -55,7 +56,9 @@
hash-copy hash-count hash-copy hash-count
hash-map hash-for-each hash-map hash-for-each
hash-iterate-first hash-iterate-next 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 syntax->datum syntax-object->datum)
(rename datum->syntax datum->syntax-object) (rename datum->syntax datum->syntax-object)
(rename free-identifier=? module-identifier=?) (rename free-identifier=? module-identifier=?)

6
collects/scheme/private/for.ss
View File

@ -673,15 +673,15 @@
[loop-arg ...]) ...) (reverse (syntax->list #'binds))]) [loop-arg ...]) ...) (reverse (syntax->list #'binds))])
#'(let-values (outer-binding ... ...) #'(let-values (outer-binding ... ...)
outer-check ... outer-check ...
(let comp-loop ([fold-var fold-init] ... (let for-loop ([fold-var fold-init] ...
loop-binding ... ...) loop-binding ... ...)
(if (and pos-guard ...) (if (and pos-guard ...)
(let-values (inner-binding ... ...) (let-values (inner-binding ... ...)
(if (and pre-guard ...) (if (and pre-guard ...)
(let-values ([(fold-var ...) (let-values ([(fold-var ...)
(for/foldX/derived [orig-stx nested? #f ()] ([fold-var fold-var] ...) rest expr1 . body)]) (for/foldX/derived [orig-stx nested? #f ()] ([fold-var fold-var] ...) rest expr1 . body)])
(if (and post-guard ...) (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 ...))) (values* fold-var ...)))
(values* fold-var ...)))))] (values* fold-var ...)))))]

22
collects/scheme/private/more-scheme.ss
View File

@ -330,9 +330,29 @@
(printf "cpu time: ~s real time: ~s gc time: ~s~n" cpu user gc) (printf "cpu time: ~s real time: ~s gc time: ~s~n" cpu user gc)
(apply values v)))]))) (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 (#%provide case old-case do
parameterize parameterize* current-parameterization call-with-parameterization parameterize parameterize* current-parameterization call-with-parameterization
parameterize-break current-break-parameterization call-with-break-parameterization parameterize-break current-break-parameterization call-with-break-parameterization
with-handlers with-handlers* call-with-exception-handler with-handlers with-handlers* call-with-exception-handler
set!-values set!-values
let/cc fluid-let time)) let/cc fluid-let time
log-fatal log-error log-warning log-info log-debug))

12
collects/scheme/private/old-procs.ss
View File

@ -54,21 +54,21 @@
(make-hash) (make-hash)
(if (eq? a 'weak) (if (eq? a 'weak)
(make-weak-hasheq) (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) [(a b) (if (or (and (eq? a 'equal)
(eq? b 'weak)) (eq? b 'weak))
(and (eq? a 'weak) (and (eq? a 'weak)
(eq? b 'equal))) (eq? b 'equal)))
(make-weak-hash) (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 (define make-immutable-hash-table
(case-lambda (case-lambda
[(l) (make-immutable-hasheq l)] [(l) (make-immutable-hasheq l)]
[(l a) (if (eq? a 'equal) [(l a) (if (eq? a 'equal)
(make-immutable-hash l) (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? (define hash-table?
(case-lambda (case-lambda
[(v) (hash? v)] [(v) (hash? v)]
@ -78,7 +78,7 @@
(if (eq? a 'weak) (if (eq? a 'weak)
(and (hash? v) (and (hash? v)
(hash-weak? 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) [(v a b) (if (or (and (eq? a 'equal)
(eq? b 'weak)) (eq? b 'weak))
(and (eq? a 'weak) (and (eq? a 'weak)
@ -86,4 +86,4 @@
(and (hash? v) (and (hash? v)
(not (hash-eq? v)) (not (hash-eq? v))
(hash-weak? v)) (hash-weak? v))
(raise-mismatch-error "hash-table?: bad arguments: " (list a b)))]))) (raise-mismatch-error 'hash-table? "bad arguments: " (list a b)))])))

117
collects/scribblings/reference/evts.scrbl
View File

@ -38,129 +38,134 @@ types can generate events (see @scheme[prop:evt]).
@itemize{ @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}.} @scheme[semaphore-wait] would not block. @ResultItself{semaphore}.}
@item{@scheme[semaphore-peek] --- a semaphore-peek event returned by @item{@scheme[_semaphore-peek] --- a semaphore-peek event returned by
@scheme[semaphore-peek-evt] applied to @scheme[semaphore] is ready @scheme[semaphore-peek-evt] applied to @scheme[_semaphore] is ready
exactly when @scheme[semaphore] is exactly when @scheme[_semaphore] is
ready. @ResultItself{semaphore-peek}.} 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 @scheme[make-channel] is ready when @scheme[channel-get] would not
block. The channel's result as an event is the same as the block. The channel's result as an event is the same as the
@scheme[channel-get] result.} @scheme[channel-get] result.}
@item{@scheme[channel-put] --- an event returned by @item{@scheme[_channel-put] --- an event returned by
@scheme[channel-put-evt] applied to @scheme[channel] is ready when @scheme[channel-put-evt] applied to @scheme[_channel] is ready when
@scheme[channel-put] would not block on @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}.} @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 @scheme[write-bytes-avail] would not block or
when the port contains buffered characters and when the port contains buffered characters and
@scheme[write-bytes-avail*] can flush part of the buffer (although @scheme[write-bytes-avail*] can flush part of the buffer (although
@scheme[write-bytes-avail] might block). @ResultItself{output-port}.} @scheme[write-bytes-avail] might block). @ResultItself{output-port}.}
@item{@scheme[progress] --- an event produced by @item{@scheme[_progress] --- an event produced by
@scheme[port-progress-evt] applied to @scheme[input-port] is ready after @scheme[port-progress-evt] applied to @scheme[_input-port] is ready after
any subsequent read from @scheme[input-port]. @ResultItself{progress}.} 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}.} @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}.} 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[thread-dead-evt] applied to @scheme[thd] is ready when
@scheme[thd] has terminated. @ResultItself{thread-dead}.} @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[thread-resume-evt] applied to @scheme[thd] is ready when
@scheme[thd] subsequently resumes execution (if it was not already @scheme[thd] subsequently resumes execution (if it was not already
running). The event's result is @scheme[thd].} 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[thread-suspend-evt] applied to @scheme[thd] is ready when
@scheme[thd] subsequently suspends execution (if it was not already @scheme[thd] subsequently suspends execution (if it was not already
suspended). The event's result is @scheme[thd].} 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}.} 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. @scheme[subprocess-wait] would not block.
@ResultItself{subprocess}.} @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. @scheme[will-execute] would not block.
@ResultItself{will-executor}.} @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 @scheme[udp-receive!-evt] is ready when a send or receive on the
original socket would block, respectively. @ResultItself{udp}.} original socket would block, respectively. @ResultItself{udp}.}
@item{@scheme[choice] --- an event returned by @scheme[choice-evt] is @item{@scheme[_log-receiver] --- a @tech{log receiver} as produced by
ready when one or more of the @scheme[evt]s supplied to @scheme[make-log-receiver] is ready when a logged message is
@scheme[chocie-evt] are ready. If the choice event is chosen, one of available. The event's result is a vector, as described with
its ready @scheme[evt]s is chosen pseudo-randomly, and the result is @scheme[make-log-receiver].}
the chosen @scheme[evt]'s result.}
@item{@scheme[wrap] --- an event returned by @scheme[wrap-evt] @item{@scheme[_choice] --- an event returned by @scheme[choice-evt] is
applied to @scheme[evt] and @scheme[proc] is ready when @scheme[evt] is ready when one or more of the @scheme[_evt]s supplied to
ready. The event's result is obtained by a call to @scheme[proc] (with @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].} breaks disabled) on the result of @scheme[evt].}
@item{@scheme[handle] --- an event returned by @scheme[handle-evt] @item{@scheme[_handle] --- an event returned by @scheme[handle-evt]
applied to @scheme[evt] and @scheme[proc] is ready when @scheme[evt] is 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 ready. The event's result is obtained by a tail call to @scheme[_proc] on
the result of @scheme[evt].} the result of @scheme[_evt].}
@item{@elemtag["guard-evt"]{@scheme[guard]} --- an event returned by @scheme[guard-evt] applied @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 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] (or whenever it is part of a choice event
used with @scheme[sync], etc.); the generated event is the result of used with @scheme[sync], etc.); the generated event is the result of
calling @scheme[thunk] when the synchronization begins; if @scheme[thunk] calling @scheme[_thunk] when the synchronization begins; if @scheme[_thunk]
returns a non-event, then @scheme[thunk]'s result is replaced with an returns a non-event, then @scheme[_thunk]'s result is replaced with an
event that is ready and whose result is @scheme[guard].} event that is ready and whose result is @scheme[_guard].}
@item{@elemtag["nack-guard-evt"]{@scheme[nack-guard]} --- an event @item{@elemtag["nack-guard-evt"]{@scheme[_nack-guard]} --- an event
returned by @scheme[nack-guard-evt] applied to @scheme[proc] returned by @scheme[nack-guard-evt] applied to @scheme[_proc]
generates a new event every time that @scheme[nack-guard] is used 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] (or whenever it is part of a choice event used
with @scheme[sync], etc.); the generated event is the result of with @scheme[sync], etc.); the generated event is the result of
calling @scheme[proc] with a NACK (``negative acknowledgment'') event calling @scheme[_proc] with a NACK (``negative acknowledgment'') event
when the synchronization begins; if @scheme[proc] returns a when the synchronization begins; if @scheme[_proc] returns a
non-event, then @scheme[proc]'s result is replaced with an event that non-event, then @scheme[_proc]'s result is replaced with an event that
is ready and whose result is @scheme[nack-guard]. is ready and whose result is @scheme[_nack-guard].
If the event from @scheme[proc] is not ultimately chosen as the If the event from @scheme[_proc] is not ultimately chosen as the
unblocked event, then the NACK event supplied to @scheme[proc] unblocked event, then the NACK event supplied to @scheme[_proc]
becomes ready with a @|void-const| value. This NACK event becomes ready becomes ready with a @|void-const| value. This NACK event becomes ready
when the event is abandoned because some other event is chosen, when the event is abandoned because some other event is chosen,
because the synchronizing thread is dead, or because control escaped because the synchronizing thread is dead, or because control escaped
from the call to @scheme[sync] (even if @scheme[nack-guard]'s @scheme[proc] 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 has not yet returned a value). If the event returned by @scheme[_proc] is
chosen, then the NACK event never becomes ready.} chosen, then the NACK event never becomes ready.}
@item{@elemtag["poll-guard-evt"]{@scheme[poll-guard]} --- an event @item{@elemtag["poll-guard-evt"]{@scheme[_poll-guard]} --- an event
returned by @scheme[poll-guard-evt] applied to @scheme[proc] returned by @scheme[poll-guard-evt] applied to @scheme[_proc]
generates a new event every time that @scheme[poll-guard] is used 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] (or whenever it is part of a choice event used
with @scheme[sync], etc.); the generated event is the result of 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. 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 the polling thread is not terminated, and if polling the resulting
event produces a result, the event will certainly be chosen for its event produces a result, the event will certainly be chosen for its
result.} 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 @scheme[prop:evt] property identifies/generates an event through the
property.} 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{@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 produced by @scheme[system-idle-evt] is ready when, if this event
were replaced by @scheme[never-evt], no thread in the system would were replaced by @scheme[never-evt], no thread in the system would
be available to run. In other words, all threads must be suspended be available to run. In other words, all threads must be suspended

174
collects/scribblings/reference/logging.scrbl Normal file
View File

@ -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.}

24
collects/scribblings/reference/module-reflect.scrbl
View File

@ -301,24 +301,26 @@ import.}
Dynamically instantiates the module specified by @scheme[mod] for Dynamically instantiates the module specified by @scheme[mod] for
@tech{phase} 0 in the current namespace's registry, if it is not yet @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 @tech{module name resolver} may load a module declaration to resolve
it (see @scheme[current-module-name-resolver]); the path is resolved it (see @scheme[current-module-name-resolver]); the path is resolved
relative to @scheme[current-load-relative-directory] and/or relative to @scheme[current-load-relative-directory] and/or
@scheme[current-directory]. @scheme[current-directory].
If @scheme[provided] is @scheme[#f], then the result is If @scheme[provided] is @scheme[#f], then the result is @|void-const|,
@|void-const|. Otherwise, when @scheme[provided] is a symbol, the and the module is not @tech{visit}ed (see
value of the module's export with the given name is returned. If the @secref["mod-parse"]). Otherwise, when @scheme[provided] is a symbol,
module exports @scheme[provide] as syntax, then a use of the binding the value of the module's export with the given name is returned, and
is expanded and evaluated (in a fresh namespace to which the module is still the module is not @tech{visit}ed. If the module exports
attached). If the module has no such exported variable or syntax, or @scheme[provide] as syntax, then a use of the binding is expanded and
if the variable is protected (see @secref["modprotect"]), the evaluated in a fresh namespace to which the module is attached, which
@exnraise[exn:fail:contract]. 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 If @scheme[provided] is @|void-const|, then the module is
@tech{visit}ed (see @secref["mod-parse"]), but not @tech{visit}ed but not @tech{instantiate}d (see
@tech{instantiate}d. The result is @|void-const|.} @secref["mod-parse"]). The result is @|void-const|.}
@defproc[(dynamic-require-for-syntax [mod module-path?] @defproc[(dynamic-require-for-syntax [mod module-path?]

7
collects/scribblings/reference/namespaces.scrbl
View File

@ -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[dest-namespace] is the same as inspector of the invocation in
@scheme[src-namespace]. @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 @scheme[src-namespace], or if the name of any module to be attached
already has a different declaration or instance in 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 If @scheme[src-namespace] and @scheme[dest-namespace] do not have the
same @tech{base phase}, then the @exnraise[exn:fail:contract].} same @tech{base phase}, then the @exnraise[exn:fail:contract].}

1
collects/scribblings/reference/os.scrbl
View File

@ -9,6 +9,7 @@
@include-section["filesystem.scrbl"] @include-section["filesystem.scrbl"]
@include-section["networking.scrbl"] @include-section["networking.scrbl"]
@include-section["subprocess.scrbl"] @include-section["subprocess.scrbl"]
@include-section["logging.scrbl"]
@include-section["time.scrbl"] @include-section["time.scrbl"]
@include-section["runtime.scrbl"] @include-section["runtime.scrbl"]
@include-section["cmdline.scrbl"] @include-section["cmdline.scrbl"]

22
collects/scribblings/reference/startup.scrbl
View File

@ -40,11 +40,11 @@ The core PLT Scheme run-time system is available in two main variants:
@section[#:tag "init-actions"]{Initialization} @section[#:tag "init-actions"]{Initialization}
On startup, the top-level environment contains no bindings---not even On startup, the top-level environment contains no bindings---not even
for function application. Primitive modules with names that start with @scheme[#%app] for function application. Primitive modules with names
@schemeidfont{#%} are defined, but they are not meant for direct use, that start with @schemeidfont{#%} are defined, but they are not meant
and the set of such modules can change. For example, the for direct use, and the set of such modules can change. For example,
@indexed-scheme['#%kernel] module is eventually used to bootstrap the the @indexed-scheme['#%kernel] module is eventually used to bootstrap
implemetation of @schememodname[scheme/base], and the implemetation of @schememodname[scheme/base], and
@scheme['#%mred-kernel] is used for @schememodname[scheme/gui/base]. @scheme['#%mred-kernel] is used for @schememodname[scheme/gui/base].
The first action of MzScheme or MrEd is to initialize 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 ports. This flag currently has no effect, because binary mode
is always used.} 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: @item{Meta options:

3
collects/srfi/19/time.ss
View File

@ -1233,7 +1233,8 @@
((char=? ch #\8) 8) ((char=? ch #\8) 8)
((char=? ch #\9) 9) ((char=? ch #\9) 9)
(else (tm:time-error 'bad-date-template-string (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 ;; read an integer upto n characters long on port; upto -> #f if any length
(define (tm:integer-reader upto port) (define (tm:integer-reader upto port)

72
collects/tests/mzscheme/logger.ss Normal file
View File

@ -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)

1
collects/tests/mzscheme/mz.ss
View File

@ -16,6 +16,7 @@
(load-relative "unit.ss") (load-relative "unit.ss")
(load-relative "unitsig.ss") (load-relative "unitsig.ss")
(load-relative "thread.ss") (load-relative "thread.ss")
(load-relative "logger.ss")
(load-relative "sync.ss") (load-relative "sync.ss")
(load-relative "deep.ss") (load-relative "deep.ss")
(load-relative "contmark.ss") (load-relative "contmark.ss")

2
collects/texpict/face.ss
View File

@ -249,7 +249,7 @@
(define (narrow-grimace flip?) (define (narrow-grimace flip?)
(grimace (grimace
(* 1.2 w) (* h 0.9) (- (* 0.1 pi)) 15 (* 1.2 w) (* h 0.9) (- (* 0.1 pi))
flip?)) flip?))
(define (large-smile flip?) (define (large-smile flip?)

5
doc/release-notes/mzscheme/HISTORY.txt
View File

@ -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 Version 4.0, June 2008
>> See MzScheme_4.txt >> See MzScheme_4.txt

79
src/mzscheme/cmdline.inc
View File

@ -381,6 +381,43 @@ static int finish_cmd_line_run(FinishArgs *fa, Repl_Proc repl)
return exit_val; 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 #ifdef USE_OSKIT_CONSOLE
/* Hack to disable normal input mode: */ /* Hack to disable normal input mode: */
int osk_not_console = 0; 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 was_config_flag = 0, saw_nc_flag = 0;
int no_compiled = 0; int no_compiled = 0;
int init_ns = 0, no_init_ns = 0; int init_ns = 0, no_init_ns = 0;
int syslog_level = -1, stderr_level = -1;
FinishArgs *fa; FinishArgs *fa;
FinishArgsAtoms *fa_a; FinishArgsAtoms *fa_a;
@ -629,6 +667,10 @@ static int run_from_cmd_line(int argc, char *_argv[],
argv[0] = "-i"; argv[0] = "-i";
else if (!strcmp("--binary", argv[0])) else if (!strcmp("--binary", argv[0]))
argv[0] = "-b"; 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])) else if (!strcmp("--collects", argv[0]))
argv[0] = "-X"; argv[0] = "-X";
else if (!strcmp("--search", argv[0])) else if (!strcmp("--search", argv[0]))
@ -857,6 +899,22 @@ static int run_from_cmd_line(int argc, char *_argv[],
osk_not_console = 1; osk_not_console = 1;
break; break;
#endif #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: default:
specific_switch[0] = *str; specific_switch[0] = *str;
specific_switch[1] = 0; specific_switch[1] = 0;
@ -922,6 +980,25 @@ static int run_from_cmd_line(int argc, char *_argv[],
} }
#endif /* DONT_PARSE_COMMAND_LINE */ #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(); global_env = mk_basic_env();
sch_argv = scheme_make_vector(argc, NULL); sch_argv = scheme_make_vector(argc, NULL);
@ -1071,6 +1148,8 @@ static int run_from_cmd_line(int argc, char *_argv[],
# endif # endif
" -d, --no-delay: Disable on-demand loading of syntax and code\n" " -d, --no-delay: Disable on-demand loading of syntax and code\n"
" -b, --binary : Read stdin and write stdout/stderr in binary mode\n" " -b, --binary : Read stdin and write stdout/stderr in binary mode\n"
" -W <level>, --warn <level> : Set stderr logging to <level>\n"
" -L <level>, --syslog <level> : Set syslog logging to <level>\n"
" Meta options:\n" " Meta options:\n"
" -- : No argument following this switch is used as a switch\n" " -- : No argument following this switch is used as a switch\n"
" -h, --help : Show this information and exits, ignoring other options\n" " -h, --help : Show this information and exits, ignoring other options\n"

1
src/mzscheme/gc2/compact.c
View File

@ -147,6 +147,7 @@ static int current_mark_type;
/********************* Client hooks *********************/ /********************* Client hooks *********************/
void (*GC_collect_start_callback)(void); void (*GC_collect_start_callback)(void);
void (*GC_collect_end_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); void (*GC_out_of_memory)(void);
unsigned long (*GC_get_thread_stack_base)(void); unsigned long (*GC_get_thread_stack_base)(void);

1
src/mzscheme/gc2/gc2.h
View File

@ -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_start_callback)(void);
GC2_EXTERN void (*GC_collect_end_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 Called by GC before/after performing a collection. Used by MzScheme
to zero out some data and record collection times. The end to zero out some data and record collection times. The end

7
src/mzscheme/gc2/newgc.c
View File

@ -126,6 +126,7 @@
/* the externals */ /* the externals */
void (*GC_collect_start_callback)(void); void (*GC_collect_start_callback)(void);
void (*GC_collect_end_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); void (*GC_out_of_memory)(void);
unsigned long (*GC_get_thread_stack_base)(void); unsigned long (*GC_get_thread_stack_base)(void);
void (*GC_mark_xtagged)(void *obj); 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 since_last_full = 0;
static unsigned int running_finalizers = 0; static unsigned int running_finalizers = 0;
static unsigned long last_full_mem_use = (20 * 1024 * 1024); 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; int next_gc_full;
TIME_DECLS(); TIME_DECLS();
@ -3177,8 +3178,10 @@ static void garbage_collect(int force_full)
last_full_mem_use = memory_in_use; last_full_mem_use = memory_in_use;
/* inform the system (if it wants us to) that we're done with collection */ /* 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(); 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"); TIME_STEP("ended");

3
src/mzscheme/include/mzscheme.exp
View File

@ -75,6 +75,9 @@ scheme_signal_error
scheme_raise_exn scheme_raise_exn
scheme_warning scheme_warning
scheme_raise scheme_raise
scheme_log_level_p
scheme_log
scheme_log_message
scheme_wrong_count scheme_wrong_count
scheme_wrong_count_m scheme_wrong_count_m
scheme_case_lambda_wrong_count scheme_case_lambda_wrong_count

3
src/mzscheme/include/mzscheme3m.exp
View File

@ -75,6 +75,9 @@ scheme_signal_error
scheme_raise_exn scheme_raise_exn
scheme_warning scheme_warning
scheme_raise scheme_raise
scheme_log_level_p
scheme_log
scheme_log_message
scheme_wrong_count scheme_wrong_count
scheme_wrong_count_m scheme_wrong_count_m
scheme_case_lambda_wrong_count scheme_case_lambda_wrong_count

3
src/mzscheme/include/mzwin.def
View File

@ -77,6 +77,9 @@ EXPORTS
scheme_raise_exn scheme_raise_exn
scheme_warning scheme_warning
scheme_raise scheme_raise
scheme_log_level_p
scheme_log
scheme_log_message
scheme_wrong_count scheme_wrong_count
scheme_wrong_count_m scheme_wrong_count_m
scheme_case_lambda_wrong_count scheme_case_lambda_wrong_count

3
src/mzscheme/include/mzwin3m.def
View File

@ -77,6 +77,9 @@ EXPORTS
scheme_raise_exn scheme_raise_exn
scheme_warning scheme_warning
scheme_raise scheme_raise
scheme_log_level_p
scheme_log
scheme_log_message
scheme_wrong_count scheme_wrong_count
scheme_wrong_count_m scheme_wrong_count_m
scheme_case_lambda_wrong_count scheme_case_lambda_wrong_count

14
src/mzscheme/include/scheme.h
View File

@ -1010,7 +1010,7 @@ typedef struct Scheme_Thread {
struct Scheme_Marshal_Tables *current_mt; struct Scheme_Marshal_Tables *current_mt;
char skip_error; Scheme_Object *constant_folding; /* compiler hack */
Scheme_Object *(*overflow_k)(void); Scheme_Object *(*overflow_k)(void);
Scheme_Object *overflow_reply; Scheme_Object *overflow_reply;
@ -1210,6 +1210,8 @@ enum {
MZCONFIG_EXPAND_OBSERVE, MZCONFIG_EXPAND_OBSERVE,
MZCONFIG_LOGGER,
__MZCONFIG_BUILTIN_COUNT__ __MZCONFIG_BUILTIN_COUNT__
}; };
@ -1330,6 +1332,14 @@ struct Scheme_Output_Port
# include "../src/schexn.h" # include "../src/schexn.h"
#endif #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 */ /* 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_use_jit(int);
MZ_EXTERN void scheme_set_startup_load_on_demand(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_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 int scheme_get_allow_set_undefined();
MZ_EXTERN Scheme_Thread *scheme_current_thread; MZ_EXTERN Scheme_Thread *scheme_current_thread;
MZ_EXTERN Scheme_Thread *scheme_first_thread; MZ_EXTERN Scheme_Thread *scheme_first_thread;

12
src/mzscheme/sconfig.h
View File

@ -509,6 +509,9 @@
# define GETENV_FUNCTION # define GETENV_FUNCTION
# define DIR_FUNCTION # define DIR_FUNCTION
# define USE_WINDOWS_EVENT_LOG
# define INIT_SYSLOG_LEVEL SCHEME_LOG_ERROR
# define DO_STACK_CHECK # define DO_STACK_CHECK
# define WINDOWS_FIND_STACK_BOUNDS # define WINDOWS_FIND_STACK_BOUNDS
@ -651,6 +654,8 @@
# include "uconfig.h" # include "uconfig.h"
# define INIT_SYSLOG_LEVEL SCHEME_LOG_ERROR
# undef HAS_STANDARD_IOB # undef HAS_STANDARD_IOB
# define HAS_BSD_IOB # define HAS_BSD_IOB
@ -979,6 +984,13 @@
/* MKDIR_NO_MODE_FLAG specifies that mkdir() takes only one argument, /* MKDIR_NO_MODE_FLAG specifies that mkdir() takes only one argument,
instead of a directory name and mode flags. */ 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 */ /* Ports */
/***********************/ /***********************/

380
src/mzscheme/src/cstartup.inc
View File

@ -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, 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,
16,0,20,0,25,0,38,0,41,0,46,0,53,0,60,0,64,0,69,0,78, 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, 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, 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, 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, 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, 110,29,11,11,63,108,101,116,64,99,111,110,100,66,117,110,108,101,115,115,66,
112,97,114,97,109,101,116,101,114,105,122,101,62,111,114,64,99,111,110,100,66, 100,101,102,105,110,101,64,119,104,101,110,64,108,101,116,42,72,112,97,114,97,
108,101,116,114,101,99,66,117,110,108,101,115,115,63,108,101,116,64,119,104,101, 109,101,116,101,114,105,122,101,63,97,110,100,66,108,101,116,114,101,99,62,111,
110,68,104,101,114,101,45,115,116,120,65,113,117,111,116,101,29,94,2,14,68, 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, 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, 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, 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, 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, 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, 10,35,11,8,133,217,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,2,5,2,2,2,6,2,2,2,7,2,2,2,8,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, 2,2,10,2,2,2,4,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, 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,182,216,16,0,97,10,37,11,8,182,216,16,0,13,16, 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, 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, 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, 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, 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, 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, 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, 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, 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,55,55,27,248,22,65,248,22,189,3,23,197,1,28,248,22, 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, 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, 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, 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, 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,55,57,16,4, 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,56,48,248,22,189,3,193,27,248, 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, 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, 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, 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, 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, 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, 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, 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, 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, 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, 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, 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, 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, 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, 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, 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,48,50,16,4, 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,48,51,18,158,94,10,64,118,111, 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, 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, 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, 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, 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, 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, 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, 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, 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, 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,7,89,162,8,44, 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, 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, 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, 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,5,89,162,8,44,36, 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, 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, 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,8, 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, 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, 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}; 0,11,16,0,94,2,15,2,16,93,2,15,9,9,35,0};
EVAL_ONE_SIZED_STR((char *)expr, 2031); 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, 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, 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, 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,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, 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, 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, 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, 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, 28,248,22,147,13,23,195,2,23,194,1,28,248,22,146,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, 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,154,13,2,20,23,197,1,10,28,23,193,2,249,22,63,248,22, 40,48,248,22,162,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, 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,139,13,23, 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,138,13,23,195,2,249,22,140,13,23,196,1,250, 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,154,13,2,20,11,10,250,80,158,45,48,248,22,154,13, 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,142,13,249,22,140,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,155,13,248,80,159,45,52,36,248,22,65,23,199,1,87,94, 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, 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, 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, 27,28,248,22,147,13,23,195,2,23,194,1,28,248,22,146,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, 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,154,13,2,20,23,197,1,10,28,23,193,2,249,22,63,248, 158,43,48,248,22,162,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,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,179,12,23, 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, 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, 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,179,12,23,196,2,28,23,193,2,192,87,94,23, 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,137,13,23,197,2,28,23,193, 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,138,13,23,197,2,11,12,250,22,180,8,76, 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, 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, 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, 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, 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, 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, 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,188,12,248,22,157,7,250,22,173,13,0,6,35,114,120,34,47, 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,167,13,0,22,35,114,120,34,91,47,92,92,93,91,46,32,93, 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,173,13,0,19, 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, 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, 1,6,2,2,92,49,80,158,43,36,2,21,28,248,22,145,6,194,248,22,131,
12,194,193,87,94,28,27,248,22,179,12,23,196,2,28,23,193,2,192,87,94, 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,137,13,23,197,2,28,23, 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,138,13,23,197,2,11,12,250,22,180,8, 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,137,13,23,195,2,12,248,22,134,11, 23,196,2,2,22,23,197,2,28,248,22,145,13,23,195,2,12,248,22,142,11,
249,22,143,10,248,22,174,6,250,22,129,7,2,23,23,200,1,23,201,1,247, 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,179,12,23,196,2,28,23,193,2,192,87,94,23, 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,137,13,23,197,2,28,23,193, 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,138,13,23,197,2,11,12,250,22,180,8,23, 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,137,13,23,195,2,12,248,22,134,11,249, 196,2,2,22,23,197,2,28,248,22,145,13,23,195,2,12,248,22,142,11,249,
22,143,10,248,22,174,6,250,22,129,7,2,23,23,200,1,23,201,1,247,22, 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,179,12,23,196,2,28,23,193,2,192,87,94, 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,137,13,23,197,2,28,23, 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,138,13,23,197,2,11,12,250,22,180,8, 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,137,13,23,195,2,12,248,22,134,11,249,22, 195,2,22,23,197,2,28,248,22,145,13,23,195,2,12,248,22,142,11,249,22,
143,10,248,22,174,6,250,22,129,7,2,23,199,23,201,1,247,22,23,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,134,11,249,22,173,10, 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, 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, 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, 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, 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, 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,133,13,248,22,64,23,202,2,23,199,2,28, 23,205,1,23,198,1,27,249,22,141,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,136,13,23,194,2,27,250,22,1,22,141,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, 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, 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, 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, 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,128,13,23,194,2,27,250,22,1,22,133,13,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,128,13,193,192,253,2,38,203,204,205,206,23,15,248,22, 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, 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, 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, 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, 23,203,1,250,22,1,22,141,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, 141,13,248,22,64,23,197,2,23,201,2,28,248,22,136,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, 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, 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, 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,179,12,23,195,2,28,23,193,2,192,87,94,23,193,1, 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,137,13,23,196,2,28,23,193,2,192, 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,138,13,23,196,2,11,12,252,22,180,8,23,200,2, 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, 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, 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, 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, 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, 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,137,13,23,198,2,28, 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,138,13,23,198,2,11,12,252,22,180, 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, 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, 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, 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, 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,185,12, 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, 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, 202,1,28,248,22,188,12,23,199,2,248,22,189,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, 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,180,12,23,196,2,10,27,248,22, 11,90,161,37,35,11,87,95,28,28,248,22,188,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, 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,137,13,23,198,2,28,23,193,2,192,87,94,23,193,1,248, 197,2,27,248,22,145,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, 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, 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, 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, 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, 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,185,12,23,203,1,6,1,1,95,28,248,22,145,6,23,202,2, 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,180,12,23,199,2,248, 249,22,157,7,23,203,1,8,63,23,201,1,28,248,22,188,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, 22,189,12,23,199,1,87,94,23,198,1,247,22,190,12,28,248,22,187,12,194,
249,22,133,13,195,194,192,249,247,22,132,6,194,11,248,80,158,36,46,9,27, 249,22,141,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, 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, 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, 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, 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, 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, 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, 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, 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,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,188,12,23,197,1,194, 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, 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, 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, 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, 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, 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, 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, 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,141, 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,137,13, 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,133,13,23,200,2,23,198, 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, 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, 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,128,13,193,10,248,22,191,12,193,192,11,11,28,23,193, 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,141,13,23,202,2,28, 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,137,13,23,194,2,250,2, 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,133,13,23,201,1,23,198,1,250,2,51,201, 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,140,13,248,22,64,23,199, 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,133,13,23,196,1,23,197,2,28,248,22,191,12,23,194,2,250, 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, 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, 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,191,12,23,194,2,250,2,51,201,202,195,87,94, 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, 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, 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, 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,137,13,23,197,2,28,23,193,2,192,87,94,23,193,1, 23,196,2,27,248,22,145,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, 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, 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, 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,137,13,23, 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,138,13,23,198,2,11,248, 198,2,28,23,193,2,192,87,94,23,193,1,248,22,146,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, 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, 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, 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,136,13,23,198,2,249,22,150,8,194,68,114,101,108, 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, 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, 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,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,140,13,23,196,1,28,248,22,191,12,193, 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, 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, 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, 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, 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, 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, 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, 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, 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, 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, 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, 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, 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); 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, 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, 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, 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, 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, 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, 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, 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); 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, 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, 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, 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, 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, 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, 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, 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,136,13,23,197,1,87,95,83,160, 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, 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, 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, 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,133,13,23,197,1,23,199,1,249,80,158,42,38,23,198,1,2, 247,194,250,22,141,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, 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, 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, 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,150,13, 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, 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,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,150,13,196,11,32,0,89,162, 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, 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, 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, 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, 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, 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, 11,28,248,22,147,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, 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, 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, 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, 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, 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, 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, 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, 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, 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, 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, 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, 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, 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, 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, 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, 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, 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, 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,185,13,247, 193,1,27,247,22,121,87,94,250,22,131,2,80,158,42,42,248,22,129,14,247,
22,162,11,195,192,250,22,131,2,195,198,66,97,116,116,97,99,104,251,211,197, 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, 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, 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, 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, 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, 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, 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, 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, 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,179,12,23,197,2,10,248,22,164,4,23,197, 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, 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, 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, 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, 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, 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, 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, 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, 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,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, 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, 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, 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, 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, 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, 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, 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, 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, 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, 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, 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, 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, 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, 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, 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, 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, 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, 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, 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, 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, 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, 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, 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,179,12,23,194,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, 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, 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, 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, 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, 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, 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, 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, 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, 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, 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, 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, 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,185, 94,23,193,1,27,247,22,121,87,94,250,22,131,2,80,158,52,42,248,22,129,
13,247,22,162,11,195,192,87,95,28,23,209,1,27,250,22,133,2,23,197,2, 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, 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, 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, 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, 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, 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, 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, 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, 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, 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, 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, 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, 141,4,248,80,158,37,49,247,22,170,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, 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, 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, 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, 193,30,2,5,72,112,97,116,104,45,115,116,114,105,110,103,63,10,30,2,5,

1
src/mzscheme/src/env.c
View File

@ -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->letrec_not_twice = info->letrec_not_twice;
naya->enforce_const = info->enforce_const; naya->enforce_const = info->enforce_const;
naya->top_level_consts = info->top_level_consts; naya->top_level_consts = info->top_level_consts;
naya->context = info->context;
return naya; return naya;
} }

676
src/mzscheme/src/error.c
View File

@ -28,6 +28,10 @@
#ifdef DOS_FILE_SYSTEM #ifdef DOS_FILE_SYSTEM
# include <windows.h> # include <windows.h>
#endif #endif
#ifdef USE_C_SYSLOG
# include <syslog.h>
# include <stdarg.h>
#endif
#define mzVA_ARG(x, y) HIDE_FROM_XFORM(va_arg(x, y)) #define mzVA_ARG(x, y) HIDE_FROM_XFORM(va_arg(x, y))
#define TMP_CMARK_VALUE scheme_parameterization_key #define TMP_CMARK_VALUE scheme_parameterization_key
@ -40,6 +44,8 @@ void (*scheme_console_output)(char *str, long len);
Scheme_Exit_Proc scheme_exit; Scheme_Exit_Proc scheme_exit;
void scheme_set_exit(Scheme_Exit_Proc p) { scheme_exit = p; } void scheme_set_exit(Scheme_Exit_Proc p) { scheme_exit = p; }
Scheme_Logger *scheme_main_logger;
#ifdef MEMORY_COUNTING_ON #ifdef MEMORY_COUNTING_ON
long scheme_misc_count; long scheme_misc_count;
#endif #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_error_value_string_proc(int, Scheme_Object *[]);
static Scheme_Object *def_exit_handler_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 *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_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_err_val_proc;
static Scheme_Object *def_error_esc_proc; static Scheme_Object *def_error_esc_proc;
static Scheme_Object *default_display_handler, *emergency_display_handler; 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 char *prepared_buf;
static long prepared_buf_len; 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 { typedef struct {
int args; int args;
Scheme_Object *type; Scheme_Object *type;
@ -563,6 +595,49 @@ void scheme_init_error(Scheme_Env *env)
0, 1), 0, 1),
env); 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); REGISTER_SO(scheme_def_exit_proc);
scheme_def_exit_proc = scheme_make_prim_w_arity(def_exit_handler_proc, scheme_def_exit_proc = scheme_make_prim_w_arity(def_exit_handler_proc,
"default-exit-handler", "default-exit-handler",
@ -577,6 +652,25 @@ void scheme_init_error(Scheme_Env *env)
prepared_buf = ""; prepared_buf = "";
prepared_buf = init_buf(NULL, &prepared_buf_len); 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); REGISTER_SO(arity_property);
{ {
Scheme_Object *guard; Scheme_Object *guard;
@ -631,8 +725,15 @@ scheme_inescapeable_error(const char *a, const char *b)
static void static void
call_error(char *buffer, int len, Scheme_Object *exn) call_error(char *buffer, int len, Scheme_Object *exn)
{ {
if (scheme_current_thread->skip_error) { if (scheme_current_thread->constant_folding) {
scheme_longjmp (scheme_error_buf, 1); 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 { } else {
mz_jmp_buf savebuf; mz_jmp_buf savebuf;
Scheme_Object *p[2], *display_handler, *escape_handler, *v; 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)); 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) static char *error_write_to_string_w_max(Scheme_Object *v, int len, int *lenout)
{ {
Scheme_Object *o, *args[2]; Scheme_Object *o, *args[2];
@ -2203,6 +2345,36 @@ static Scheme_Object *error_print_srcloc(int argc, Scheme_Object *argv[])
-1, NULL, NULL, 1); -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 * static Scheme_Object *
def_error_display_proc(int argc, Scheme_Object *argv[]) 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); loc = SCHEME_CDR(name);
name = SCHEME_CAR(name); name = SCHEME_CAR(name);
if (SCHEME_TRUEP(loc)) { if (SCHEME_TRUEP(loc)) {
Scheme_Structure *sloc = (Scheme_Structure *)loc; Scheme_Structure *sloc = (Scheme_Structure *)loc;
scheme_display_w_max(sloc->slots[0], port, print_width); scheme_write_proc_context(port, print_width,
if (SCHEME_TRUEP(sloc->slots[1])) { name,
/* Line + column */ sloc->slots[0], sloc->slots[1],
scheme_write_byte_string(":", 1, port); sloc->slots[2], sloc->slots[3],
scheme_display_w_max(sloc->slots[1], port, print_width); 0);
scheme_write_byte_string(":", 1, port); } else {
scheme_display_w_max(sloc->slots[2], port, print_width); scheme_write_proc_context(port, print_width,
} else { name,
/* Position */ NULL, NULL, NULL, NULL,
scheme_write_byte_string("::", 2, port); 0);
scheme_display_w_max(sloc->slots[3], 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);
}
scheme_write_byte_string("\n", 1, port); scheme_write_byte_string("\n", 1, port);
l = SCHEME_CDR(l); l = SCHEME_CDR(l);
--max_cnt; --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 void
scheme_raise_exn(int id, ...) 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; 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); scheme_longjmp (scheme_error_buf, 1);
} }

272
src/mzscheme/src/eval.c
View File

@ -818,12 +818,29 @@ static int is_proc_spec_proc(Scheme_Object *p)
return 0; 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 /* Checks whether the bytecode `o' returns `vals' values with no
side-effects and without pushing and using continuation marks. side-effects and without pushing and using continuation marks.
-1 for vals means that any return count is ok. -1 for vals means that any return count is ok.
Also used with fully resolved expression by `module' to check 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; 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_compiled_unclosed_procedure_type)
|| (vtype == scheme_case_lambda_sequence_type) || (vtype == scheme_case_lambda_sequence_type)
|| (vtype == scheme_quote_syntax_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)); return ((vals == 1) || (vals < 0));
}
if (vtype == scheme_toplevel_type) { if (vtype == scheme_toplevel_type) {
note_match(1, vals, warn_info);
if (resolved && ((vals == 1) || (vals < 0))) { if (resolved && ((vals == 1) || (vals < 0))) {
if (SCHEME_TOPLEVEL_FLAGS(o) if (SCHEME_TOPLEVEL_FLAGS(o)
& (SCHEME_TOPLEVEL_CONST | SCHEME_TOPLEVEL_READY)) & (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) 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; return 1;
}
if ((vtype == scheme_compiled_quote_syntax_type)) { if ((vtype == scheme_compiled_quote_syntax_type)) {
note_match(1, vals, warn_info);
return ((vals == 1) || (vals < 0)); return ((vals == 1) || (vals < 0));
} }
if ((vtype == scheme_branch_type)) { if ((vtype == scheme_branch_type)) {
Scheme_Branch_Rec *b; Scheme_Branch_Rec *b;
b = (Scheme_Branch_Rec *)o; b = (Scheme_Branch_Rec *)o;
return (scheme_omittable_expr(b->test, 1, fuel - 1, resolved) return (scheme_omittable_expr(b->test, 1, fuel - 1, resolved, warn_info)
&& scheme_omittable_expr(b->tbranch, vals, fuel - 1, resolved) && scheme_omittable_expr(b->tbranch, vals, fuel - 1, resolved, warn_info)
&& scheme_omittable_expr(b->fbranch, vals, fuel - 1, resolved)); && scheme_omittable_expr(b->fbranch, vals, fuel - 1, resolved, warn_info));
} }
#if 0 #if 0
@ -876,15 +899,15 @@ int scheme_omittable_expr(Scheme_Object *o, int vals, int fuel, int resolved)
a let_value_type! */ a let_value_type! */
if ((vtype == scheme_let_value_type)) { if ((vtype == scheme_let_value_type)) {
Scheme_Let_Value *lv = (Scheme_Let_Value *)o; Scheme_Let_Value *lv = (Scheme_Let_Value *)o;
return (scheme_omittable_expr(lv->value, lv->count, 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)); && scheme_omittable_expr(lv->body, vals, fuel - 1, resolved, warn_info));
} }
#endif #endif
if ((vtype == scheme_let_one_type)) { if ((vtype == scheme_let_one_type)) {
Scheme_Let_One *lo = (Scheme_Let_One *)o; Scheme_Let_One *lo = (Scheme_Let_One *)o;
return (scheme_omittable_expr(lo->value, 1, fuel - 1, resolved) return (scheme_omittable_expr(lo->value, 1, fuel - 1, resolved, warn_info)
&& scheme_omittable_expr(lo->body, vals, fuel - 1, resolved)); && scheme_omittable_expr(lo->body, vals, fuel - 1, resolved, warn_info));
} }
if ((vtype == scheme_let_void_type)) { 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; Scheme_Let_Value *lv2 = (Scheme_Let_Value *)lv->body;
if ((lv2->count == 1) if ((lv2->count == 1)
&& (lv2->position == 0) && (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; o = lv2->body;
else else
o = lv->body; 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 ((lh->count == 1) && (lh->num_clauses == 1)) {
if (SAME_TYPE(SCHEME_TYPE(lh->body), scheme_compiled_let_value_type)) { if (SAME_TYPE(SCHEME_TYPE(lh->body), scheme_compiled_let_value_type)) {
Scheme_Compiled_Let_Value *lv = (Scheme_Compiled_Let_Value *)lh->body; 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; o = lv->body;
goto try_again; 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'. /* Look for multiple values, or for `make-struct-type'.
(The latter is especially useful to Honu.) */ (The latter is especially useful to Honu.) */
Scheme_App_Rec *app = (Scheme_App_Rec *)o; Scheme_App_Rec *app = (Scheme_App_Rec *)o;
if (((vals == 5) || (vals < 0)) if ((app->num_args >= 4) && (app->num_args <= 10)
&& (app->num_args >= 4) && (app->num_args <= 10)
&& SAME_OBJ(scheme_make_struct_type_proc, app->args[0])) { && 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]) */ /* Look for (make-struct-type sym #f non-neg-int non-neg-int [omitable null]) */
if (SCHEME_SYMBOLP(app->args[1]) if (SCHEME_SYMBOLP(app->args[1])
&& SCHEME_FALSEP(app->args[2]) && SCHEME_FALSEP(app->args[2])
&& SCHEME_INTP(app->args[3]) && SCHEME_INTP(app->args[3])
&& (SCHEME_INT_VAL(app->args[3]) >= 0) && (SCHEME_INT_VAL(app->args[3]) >= 0)
&& SCHEME_INTP(app->args[4]) && SCHEME_INTP(app->args[4])
&& (SCHEME_INT_VAL(app->args[4]) >= 0) && (SCHEME_INT_VAL(app->args[4]) >= 0)
&& ((app->num_args < 5) && ((app->num_args < 5)
|| scheme_omittable_expr(app->args[5], 1, fuel - 1, resolved)) || scheme_omittable_expr(app->args[5], 1, fuel - 1, resolved, warn_info))
&& ((app->num_args < 6) && ((app->num_args < 6)
|| SCHEME_NULLP(app->args[6])) || SCHEME_NULLP(app->args[6]))
&& ((app->num_args < 7) && ((app->num_args < 7)
|| SCHEME_FALSEP(app->args[7]) || SCHEME_FALSEP(app->args[7])
|| is_current_inspector_call(app->args[7])) || is_current_inspector_call(app->args[7]))
&& ((app->num_args < 8) && ((app->num_args < 8)
|| SCHEME_FALSEP(app->args[8]) || SCHEME_FALSEP(app->args[8])
|| is_proc_spec_proc(app->args[8])) || is_proc_spec_proc(app->args[8]))
&& ((app->num_args < 9) && ((app->num_args < 9)
|| SCHEME_NULLP(app->args[9]))) { || SCHEME_NULLP(app->args[9]))) {
return 1; return 1;
}
} }
} }
/* (values <omittable> ...) */ /* (values <omittable> ...) */
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; int i;
for (i = app->num_args; 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 0;
} }
return 1; return 1;
} }
} }
/* (void <omittable> ...) */ /* (void <omittable> ...) */
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; int i;
for (i = app->num_args; 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 0;
} }
return 1; return 1;
@ -978,11 +1005,12 @@ int scheme_omittable_expr(Scheme_Object *o, int vals, int fuel, int resolved)
if ((vtype == scheme_application2_type)) { if ((vtype == scheme_application2_type)) {
/* (values <omittable>) or (void <omittable>) */ /* (values <omittable>) or (void <omittable>) */
if ((vals == 1) || (vals < 0)) { Scheme_App2_Rec *app = (Scheme_App2_Rec *)o;
Scheme_App2_Rec *app = (Scheme_App2_Rec *)o; if (SAME_OBJ(scheme_values_func, app->rator)
if (SAME_OBJ(scheme_values_func, app->rator) || SAME_OBJ(scheme_void_proc, app->rator)) {
|| SAME_OBJ(scheme_void_proc, app->rator)) { note_match(1, vals, warn_info);
if (scheme_omittable_expr(app->rand, 1, fuel - 1, resolved)) if ((vals == 1) || (vals < 0)) {
if (scheme_omittable_expr(app->rand, 1, fuel - 1, resolved, warn_info))
return 1; return 1;
} }
} }
@ -990,20 +1018,21 @@ int scheme_omittable_expr(Scheme_Object *o, int vals, int fuel, int resolved)
if ((vtype == scheme_application3_type)) { if ((vtype == scheme_application3_type)) {
/* (values <omittable> <omittable>) */ /* (values <omittable> <omittable>) */
if ((vals == 2) || (vals < 0)) { Scheme_App3_Rec *app = (Scheme_App3_Rec *)o;
Scheme_App3_Rec *app = (Scheme_App3_Rec *)o; if (SAME_OBJ(scheme_values_func, app->rator)) {
if (SAME_OBJ(scheme_values_func, app->rator)) { note_match(2, vals, warn_info);
if (scheme_omittable_expr(app->rand1, 1, fuel - 1, resolved) if ((vals == 2) || (vals < 0)) {
&& scheme_omittable_expr(app->rand2, 1, fuel - 1, resolved)) 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; return 1;
} }
} }
/* (void <omittable> <omittable>) */ /* (void <omittable> <omittable>) */
if ((vals == 1) || (vals < 0)) { if (SAME_OBJ(scheme_void_proc, app->rator)) {
Scheme_App3_Rec *app = (Scheme_App3_Rec *)o; note_match(1, vals, warn_info);
if (SAME_OBJ(scheme_void_proc, app->rator)) { if ((vals == 1) || (vals < 0)) {
if (scheme_omittable_expr(app->rand1, 1, fuel - 1, resolved) if (scheme_omittable_expr(app->rand1, 1, fuel - 1, resolved, warn_info)
&& scheme_omittable_expr(app->rand2, 1, fuel - 1, resolved)) && scheme_omittable_expr(app->rand2, 1, fuel - 1, resolved, warn_info))
return 1; return 1;
} }
} }
@ -1049,14 +1078,14 @@ int scheme_get_eval_type(Scheme_Object *obj)
return SCHEME_EVAL_GENERAL; 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 /* Apply `f' to `args' and ignore failues --- used for constant
folding attempts */ folding attempts */
{ {
Scheme_Object * volatile result; Scheme_Object * volatile result;
mz_jmp_buf *savebuf, newbuf; mz_jmp_buf *savebuf, newbuf;
scheme_current_thread->skip_error = 5; scheme_current_thread->constant_folding = context;
savebuf = scheme_current_thread->error_buf; savebuf = scheme_current_thread->error_buf;
scheme_current_thread->error_buf = &newbuf; 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); result = _scheme_apply_to_list(f, args);
scheme_current_thread->error_buf = savebuf; scheme_current_thread->error_buf = savebuf;
scheme_current_thread->skip_error = 0; scheme_current_thread->constant_folding = NULL;
return result; return result;
} }
@ -1114,7 +1143,7 @@ static Scheme_Object *make_application(Scheme_Object *v)
== SCHEME_PRIM_OPT_FOLDING)) == SCHEME_PRIM_OPT_FOLDING))
|| (SAME_TYPE(SCHEME_TYPE(f), scheme_closure_type) || (SAME_TYPE(SCHEME_TYPE(f), scheme_closure_type)
&& (foldable_body(f)))) { && (foldable_body(f)))) {
f = try_apply(f, SCHEME_CDR(v)); f = try_apply(f, SCHEME_CDR(v), scheme_false);
if (f) if (f)
return f; return f;
@ -1605,7 +1634,7 @@ Scheme_Object *scheme_make_sequence_compilation(Scheme_Object *seq, int opt)
total++; total++;
} else if (opt } else if (opt
&& (((opt > 0) && !last) || ((opt < 0) && !first)) && (((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. */ /* A value that is not the result. We'll drop it. */
total++; total++;
} else { } else {
@ -1629,7 +1658,7 @@ Scheme_Object *scheme_make_sequence_compilation(Scheme_Object *seq, int opt)
return scheme_compiled_void(); return scheme_compiled_void();
if (count == 1) { 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 /* We can't optimize (begin0 expr cont) to expr because
exp is not in tail position in the original (so we'd mess exp is not in tail position in the original (so we'd mess
up continuation marks). */ up continuation marks). */
@ -1661,7 +1690,7 @@ Scheme_Object *scheme_make_sequence_compilation(Scheme_Object *seq, int opt)
} else if (opt } else if (opt
&& (((opt > 0) && (k < total)) && (((opt > 0) && (k < total))
|| ((opt < 0) && k)) || ((opt < 0) && k))
&& scheme_omittable_expr(v, -1, -1, 0)) { && scheme_omittable_expr(v, -1, -1, 0, NULL)) {
/* Value not the result. Do nothing. */ /* Value not the result. Do nothing. */
} else } else
o->array[i++] = v; o->array[i++] = v;
@ -1686,7 +1715,7 @@ static Scheme_Object *look_for_letv_change(Scheme_Sequence *s)
v = s->array[i]; v = s->array[i];
if (SAME_TYPE(SCHEME_TYPE(v), scheme_let_value_type)) { if (SAME_TYPE(SCHEME_TYPE(v), scheme_let_value_type)) {
Scheme_Let_Value *lv = (Scheme_Let_Value *)v; 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 esize = s->count - (i + 1);
int nsize = i + 1; int nsize = i + 1;
Scheme_Object *nv, *ev; Scheme_Object *nv, *ev;
@ -2188,7 +2217,7 @@ static Scheme_Object *try_optimize_fold(Scheme_Object *f, Scheme_Object *o, Opti
break; break;
} }
return try_apply(f, args); return try_apply(f, args, info->context);
} }
return NULL; 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 */ /* If not app, app2, or app3, just return a known procedure, if any */
{ {
int offset = 0, single_use = 0; int offset = 0, single_use = 0;
Scheme_Object *bad_app = NULL;
if (SAME_TYPE(SCHEME_TYPE(le), scheme_local_type)) { if (SAME_TYPE(SCHEME_TYPE(le), scheme_local_type)) {
/* Check for inlining: */ /* 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), sz, info->inline_fuel * (argc + 2),
info->inline_fuel)); 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) if (opt >= SCHEME_PRIM_OPT_NONCM)
*_flags = (CLOS_PRESERVES_MARKS | CLOS_SINGLE_RESULT); *_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; 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) static void reset_rator(Scheme_Object *app, Scheme_Object *a)
{ {
switch (SCHEME_TYPE(app)) { 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) 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->preserves_marks = 1;
info->single_result = 1; info->single_result = 1;
return app->rand; return app->rand;
@ -2647,7 +2785,7 @@ static Scheme_Object *optimize_sequence(Scheme_Object *o, Optimize_Info *info)
/* Inlining and constant propagation can expose /* Inlining and constant propagation can expose
omittable expressions. */ omittable expressions. */
if ((i + 1 != s->count) if ((i + 1 != s->count)
&& scheme_omittable_expr(le, -1, -1, 0)) { && scheme_omittable_expr(le, -1, -1, 0, NULL)) {
drop++; drop++;
s->array[i] = NULL; s->array[i] = NULL;
} else { } 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, it might not because (1) it was introduced late by inlining,
or (2) the rhs expression doesn't always produce a single or (2) the rhs expression doesn't always produce a single
value. */ value. */
if (scheme_omittable_expr(rhs, 1, -1, 1)) { if (scheme_omittable_expr(rhs, 1, -1, 1, NULL)) {
rhs = scheme_false; rhs = scheme_false;
} else { } else {
Scheme_Object *clr; Scheme_Object *clr;

15
src/mzscheme/src/file.c
View File

@ -5624,6 +5624,15 @@ enum {
id_addon_dir 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 * static Scheme_Object *
find_system_path(int argc, Scheme_Object **argv) find_system_path(int argc, Scheme_Object **argv)
{ {
@ -5654,11 +5663,7 @@ find_system_path(int argc, Scheme_Object **argv)
} }
return exec_cmd; return exec_cmd;
} else if (argv[0] == run_file_symbol) { } else if (argv[0] == run_file_symbol) {
if (!run_cmd) { return scheme_get_run_cmd();
REGISTER_SO(run_cmd);
run_cmd = scheme_make_path("mzscheme");
}
return run_cmd;
} else if (argv[0] == collects_dir_symbol) { } else if (argv[0] == collects_dir_symbol) {
if (!collects_path) { if (!collects_path) {
REGISTER_SO(collects_path); REGISTER_SO(collects_path);

14
src/mzscheme/src/fun.c
View File

@ -944,7 +944,7 @@ Scheme_Object *
scheme_optimize_closure_compilation(Scheme_Object *_data, Optimize_Info *info) scheme_optimize_closure_compilation(Scheme_Object *_data, Optimize_Info *info)
{ {
Scheme_Closure_Data *data; Scheme_Closure_Data *data;
Scheme_Object *code; Scheme_Object *code, *ctx;
Closure_Info *cl; Closure_Info *cl;
mzshort dcs, *dcm; mzshort dcs, *dcm;
int i; 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, info = scheme_optimize_info_add_frame(info, data->num_params, data->num_params,
SCHEME_LAMBDA_FRAME); 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; cl = (Closure_Info *)data->closure_map;
for (i = 0; i < data->num_params; i++) { 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 { } else {
Scheme_Object *name; 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; name = SCHEME_COMPILED_CLOS_CODE(p)->name;
} else { } else {
/* Native closure: */ /* Native closure: */

20
src/mzscheme/src/module.c
View File

@ -4652,12 +4652,15 @@ static Scheme_Object *
module_optimize(Scheme_Object *data, Optimize_Info *info) module_optimize(Scheme_Object *data, Optimize_Info *info)
{ {
Scheme_Module *m = (Scheme_Module *)data; Scheme_Module *m = (Scheme_Module *)data;
Scheme_Object *e, *vars; Scheme_Object *e, *vars, *old_context;
int start_simltaneous = 0, i_m, cnt; int start_simltaneous = 0, i_m, cnt;
Scheme_Object *cl_first = NULL, *cl_last = NULL; Scheme_Object *cl_first = NULL, *cl_last = NULL;
Scheme_Hash_Table *consts = NULL, *ready_table = NULL, *re_consts = NULL; Scheme_Hash_Table *consts = NULL, *ready_table = NULL, *re_consts = NULL;
int cont; int cont;
old_context = info->context;
info->context = (Scheme_Object *)m;
cnt = SCHEME_VEC_SIZE(m->body); cnt = SCHEME_VEC_SIZE(m->body);
for (i_m = 0; i_m < cnt; i_m++) { for (i_m = 0; i_m < cnt; i_m++) {
/* Optimize this expression: */ /* Optimize this expression: */
@ -4678,7 +4681,7 @@ module_optimize(Scheme_Object *data, Optimize_Info *info)
e = SCHEME_CDR(e); e = SCHEME_CDR(e);
n = scheme_list_length(vars); 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)) { if ((n == 1) && scheme_compiled_propagate_ok(e, info)) {
Scheme_Toplevel *tl; Scheme_Toplevel *tl;
@ -4749,7 +4752,7 @@ module_optimize(Scheme_Object *data, Optimize_Info *info)
} }
} }
} else { } else {
cont = scheme_omittable_expr(e, -1, -1, 0); cont = scheme_omittable_expr(e, -1, -1, 0, NULL);
} }
if (i_m + 1 == cnt) if (i_m + 1 == cnt)
cont = 0; cont = 0;
@ -4824,7 +4827,7 @@ module_optimize(Scheme_Object *data, Optimize_Info *info)
for (i_m = 0; i_m < cnt; i_m++) { for (i_m = 0; i_m < cnt; i_m++) {
/* Optimize this expression: */ /* Optimize this expression: */
e = SCHEME_VEC_ELS(m->body)[i_m]; 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++; can_omit++;
} }
} }
@ -4835,7 +4838,7 @@ module_optimize(Scheme_Object *data, Optimize_Info *info)
for (i_m = 0; i_m < cnt; i_m++) { for (i_m = 0; i_m < cnt; i_m++) {
/* Optimize this expression: */ /* Optimize this expression: */
e = SCHEME_VEC_ELS(m->body)[i_m]; 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; 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 */ /* Exp-time body was optimized during compilation */
return scheme_make_syntax_compiled(MODULE_EXPD, data); 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); t = SCHEME_TYPE(e);
if (scheme_omittable_expr(e, len, fuel, 1)) if (scheme_omittable_expr(e, len, fuel, 1, NULL))
return 1; return 1;
if (t == scheme_sequence_type) { 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); m = scheme_compile_expr_lift_to_let(code, eenv, &mrec, 0);
oi = scheme_optimize_info_create(); oi = scheme_optimize_info_create();
oi->context = (Scheme_Object *)env->genv->module;
m = scheme_optimize_expr(m, oi); m = scheme_optimize_expr(m, oi);
/* Simplify only in compile mode; it is too slow in expand mode. */ /* 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; Scheme_Object *prev = NULL, *next;
for (p = first; !SCHEME_NULLP(p); p = next) { for (p = first; !SCHEME_NULLP(p); p = next) {
next = SCHEME_CDR(p); 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) if (prev)
SCHEME_CDR(prev) = next; SCHEME_CDR(prev) = next;
else else

62
src/mzscheme/src/mzmark.c
View File

@ -1636,6 +1636,8 @@ static int thread_val_MARK(void *p) {
gcMARK(pr->current_local_bindings); gcMARK(pr->current_local_bindings);
gcMARK(pr->current_mt); gcMARK(pr->current_mt);
gcMARK(pr->constant_folding);
gcMARK(pr->overflow_reply); gcMARK(pr->overflow_reply);
@ -1737,6 +1739,8 @@ static int thread_val_FIXUP(void *p) {
gcFIXUP(pr->current_local_bindings); gcFIXUP(pr->current_local_bindings);
gcFIXUP(pr->current_mt); gcFIXUP(pr->current_mt);
gcFIXUP(pr->constant_folding);
gcFIXUP(pr->overflow_reply); gcFIXUP(pr->overflow_reply);
@ -2637,6 +2641,62 @@ static int mark_pipe_FIXUP(void *p) {
#define mark_pipe_IS_CONST_SIZE 1 #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 */ #endif /* TYPE */
/**********************************************************************/ /**********************************************************************/
@ -2765,6 +2825,7 @@ static int mark_optimize_info_MARK(void *p) {
gcMARK(i->top_level_consts); gcMARK(i->top_level_consts);
gcMARK(i->transitive_use); gcMARK(i->transitive_use);
gcMARK(i->transitive_use_len); gcMARK(i->transitive_use_len);
gcMARK(i->context);
return return
gcBYTES_TO_WORDS(sizeof(Optimize_Info)); 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->top_level_consts);
gcFIXUP(i->transitive_use); gcFIXUP(i->transitive_use);
gcFIXUP(i->transitive_use_len); gcFIXUP(i->transitive_use_len);
gcFIXUP(i->context);
return return
gcBYTES_TO_WORDS(sizeof(Optimize_Info)); gcBYTES_TO_WORDS(sizeof(Optimize_Info));

24
src/mzscheme/src/mzmarksrc.c
View File

@ -651,6 +651,8 @@ thread_val {
gcMARK(pr->current_local_bindings); gcMARK(pr->current_local_bindings);
gcMARK(pr->current_mt); gcMARK(pr->current_mt);
gcMARK(pr->constant_folding);
gcMARK(pr->overflow_reply); gcMARK(pr->overflow_reply);
@ -1047,6 +1049,27 @@ mark_pipe {
gcBYTES_TO_WORDS(sizeof(Scheme_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; END type;
/**********************************************************************/ /**********************************************************************/
@ -1111,6 +1134,7 @@ mark_optimize_info {
gcMARK(i->top_level_consts); gcMARK(i->top_level_consts);
gcMARK(i->transitive_use); gcMARK(i->transitive_use);
gcMARK(i->transitive_use_len); gcMARK(i->transitive_use_len);
gcMARK(i->context);
size: size:
gcBYTES_TO_WORDS(sizeof(Optimize_Info)); gcBYTES_TO_WORDS(sizeof(Optimize_Info));

5
src/mzscheme/src/schemef.h
View File

@ -176,6 +176,11 @@ MZ_EXTERN void scheme_warning(char *msg, ...);
MZ_EXTERN void scheme_raise(Scheme_Object *exn); 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, MZ_EXTERN void scheme_wrong_count(const char *name, int minc, int maxc,
int argc, Scheme_Object **argv); int argc, Scheme_Object **argv);
MZ_EXTERN void scheme_wrong_count_m(const char *name, int minc, int maxc, MZ_EXTERN void scheme_wrong_count_m(const char *name, int minc, int maxc,

4
src/mzscheme/src/schemex.h
View File

@ -138,6 +138,10 @@ void (*scheme_signal_error)(const char *msg, ...);
void (*scheme_raise_exn)(int exnid, ...); void (*scheme_raise_exn)(int exnid, ...);
void (*scheme_warning)(char *msg, ...); void (*scheme_warning)(char *msg, ...);
void (*scheme_raise)(Scheme_Object *exn); 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, void (*scheme_wrong_count)(const char *name, int minc, int maxc,
int argc, Scheme_Object **argv); int argc, Scheme_Object **argv);
void (*scheme_wrong_count_m)(const char *name, int minc, int maxc, void (*scheme_wrong_count_m)(const char *name, int minc, int maxc,

3
src/mzscheme/src/schemex.inc
View File

@ -83,6 +83,9 @@
scheme_extension_table->scheme_raise_exn = scheme_raise_exn; scheme_extension_table->scheme_raise_exn = scheme_raise_exn;
scheme_extension_table->scheme_warning = scheme_warning; scheme_extension_table->scheme_warning = scheme_warning;
scheme_extension_table->scheme_raise = scheme_raise; 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 = scheme_wrong_count;
scheme_extension_table->scheme_wrong_count_m = scheme_wrong_count_m; scheme_extension_table->scheme_wrong_count_m = scheme_wrong_count_m;
scheme_extension_table->scheme_case_lambda_wrong_count = scheme_case_lambda_wrong_count; scheme_extension_table->scheme_case_lambda_wrong_count = scheme_case_lambda_wrong_count;

3
src/mzscheme/src/schemexm.h
View File

@ -83,6 +83,9 @@
#define scheme_raise_exn (scheme_extension_table->scheme_raise_exn) #define scheme_raise_exn (scheme_extension_table->scheme_raise_exn)
#define scheme_warning (scheme_extension_table->scheme_warning) #define scheme_warning (scheme_extension_table->scheme_warning)
#define scheme_raise (scheme_extension_table->scheme_raise) #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 (scheme_extension_table->scheme_wrong_count)
#define scheme_wrong_count_m (scheme_extension_table->scheme_wrong_count_m) #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) #define scheme_case_lambda_wrong_count (scheme_extension_table->scheme_case_lambda_wrong_count)

2
src/mzscheme/src/schminc.h
View File

@ -13,7 +13,7 @@
#define USE_COMPILED_STARTUP 1 #define USE_COMPILED_STARTUP 1
#define EXPECTED_PRIM_COUNT 917 #define EXPECTED_PRIM_COUNT 925
#ifdef MZSCHEME_SOMETHING_OMITTED #ifdef MZSCHEME_SOMETHING_OMITTED
# undef USE_COMPILED_STARTUP # undef USE_COMPILED_STARTUP

36
src/mzscheme/src/schpriv.h
View File

@ -1313,6 +1313,7 @@ void scheme_get_outof_line(Scheme_Channel_Syncer *ch_w);
void scheme_post_syncing_nacks(Syncing *syncing); void scheme_post_syncing_nacks(Syncing *syncing);
int scheme_try_channel_get(Scheme_Object *ch); int scheme_try_channel_get(Scheme_Object *ch);
int scheme_try_channel_put(Scheme_Object *ch, Scheme_Object *v);
/*========================================================================*/ /*========================================================================*/
/* numbers */ /* numbers */
@ -1843,6 +1844,8 @@ typedef struct Optimize_Info
int transitive_use_pos; /* set to pos + 1 when optimizing a letrec-bound procedure */ int transitive_use_pos; /* set to pos + 1 when optimizing a letrec-bound procedure */
mzshort **transitive_use; mzshort **transitive_use;
int *transitive_use_len; int *transitive_use_len;
Scheme_Object *context; /* for logging */
} Optimize_Info; } Optimize_Info;
typedef struct Scheme_Object *(*Scheme_Syntax_Optimizer)(Scheme_Object *data, Optimize_Info *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_size;
mzshort *closure_map; /* actually a Closure_Info* until resolved; if CLOS_HAS_REF_ARGS, followed by bit array */ mzshort *closure_map; /* actually a Closure_Info* until resolved; if CLOS_HAS_REF_ARGS, followed by bit array */
Scheme_Object *code; Scheme_Object *code;
Scheme_Object *name; Scheme_Object *name; /* name or (vector name src line col pos span generated?) */
#ifdef MZ_USE_JIT #ifdef MZ_USE_JIT
union { union {
struct Scheme_Closure_Data *jit_clone; 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_app_only(Scheme_Comp_Env *env, int which);
int scheme_used_ever(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); 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); int scheme_native_arity_check(Scheme_Object *closure, int argc);
Scheme_Object *scheme_get_native_arity(Scheme_Object *closure); 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 */ /* filesystem utilities */
/*========================================================================*/ /*========================================================================*/
@ -2773,6 +2804,7 @@ int scheme_is_special_filename(const char *_f, int not_nul);
#endif #endif
char *scheme_get_exec_path(void); char *scheme_get_exec_path(void);
Scheme_Object *scheme_get_run_cmd(void);
Scheme_Object *scheme_get_fd_identity(Scheme_Object *port, long fd); Scheme_Object *scheme_get_fd_identity(Scheme_Object *port, long fd);

4
src/mzscheme/src/schvers.h
View File

@ -13,12 +13,12 @@
consistently.) consistently.)
*/ */
#define MZSCHEME_VERSION "4.0.2.3" #define MZSCHEME_VERSION "4.0.2.4"
#define MZSCHEME_VERSION_X 4 #define MZSCHEME_VERSION_X 4
#define MZSCHEME_VERSION_Y 0 #define MZSCHEME_VERSION_Y 0
#define MZSCHEME_VERSION_Z 2 #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_MAJOR ((MZSCHEME_VERSION_X * 100) + MZSCHEME_VERSION_Y)
#define MZSCHEME_VERSION_MINOR ((MZSCHEME_VERSION_Z * 1000) + MZSCHEME_VERSION_W) #define MZSCHEME_VERSION_MINOR ((MZSCHEME_VERSION_Z * 1000) + MZSCHEME_VERSION_W)

13
src/mzscheme/src/sema.c
View File

@ -955,6 +955,19 @@ Scheme_Object *scheme_make_channel_put_evt(Scheme_Object *ch, Scheme_Object *v)
return (Scheme_Object *)cp; 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) static Scheme_Object *make_channel_put(int argc, Scheme_Object **argv)
{ {
if (!SCHEME_CHANNELP(argv[0])) if (!SCHEME_CHANNELP(argv[0]))

142
src/mzscheme/src/stypes.h
View File

@ -165,80 +165,82 @@ enum {
scheme_cust_box_type, /* 147 */ scheme_cust_box_type, /* 147 */
scheme_resolved_module_path_type, /* 148 */ scheme_resolved_module_path_type, /* 148 */
scheme_module_phase_exports_type, /* 149 */ scheme_module_phase_exports_type, /* 149 */
scheme_logger_type, /* 150 */
scheme_log_reader_type, /* 151 */
#ifdef MZTAG_REQUIRED #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_comp_env, /* 154 */
scheme_rt_constant_binding, /* 153 */ scheme_rt_constant_binding, /* 155 */
scheme_rt_resolve_info, /* 154 */ scheme_rt_resolve_info, /* 156 */
scheme_rt_optimize_info, /* 155 */ scheme_rt_optimize_info, /* 157 */
scheme_rt_compile_info, /* 156 */ scheme_rt_compile_info, /* 158 */
scheme_rt_cont_mark, /* 157 */ scheme_rt_cont_mark, /* 159 */
scheme_rt_saved_stack, /* 158 */ scheme_rt_saved_stack, /* 160 */
scheme_rt_reply_item, /* 159 */ scheme_rt_reply_item, /* 161 */
scheme_rt_closure_info, /* 160 */ scheme_rt_closure_info, /* 162 */
scheme_rt_overflow, /* 161 */ scheme_rt_overflow, /* 163 */
scheme_rt_overflow_jmp, /* 162 */ scheme_rt_overflow_jmp, /* 164 */
scheme_rt_meta_cont, /* 163 */ scheme_rt_meta_cont, /* 165 */
scheme_rt_dyn_wind_cell, /* 164 */ scheme_rt_dyn_wind_cell, /* 166 */
scheme_rt_dyn_wind_info, /* 165 */ scheme_rt_dyn_wind_info, /* 167 */
scheme_rt_dyn_wind, /* 166 */ scheme_rt_dyn_wind, /* 168 */
scheme_rt_dup_check, /* 167 */ scheme_rt_dup_check, /* 169 */
scheme_rt_thread_memory, /* 168 */ scheme_rt_thread_memory, /* 170 */
scheme_rt_input_file, /* 169 */ scheme_rt_input_file, /* 171 */
scheme_rt_input_fd, /* 170 */ scheme_rt_input_fd, /* 172 */
scheme_rt_oskit_console_input, /* 171 */ scheme_rt_oskit_console_input, /* 173 */
scheme_rt_tested_input_file, /* 172 */ scheme_rt_tested_input_file, /* 174 */
scheme_rt_tested_output_file, /* 173 */ scheme_rt_tested_output_file, /* 175 */
scheme_rt_indexed_string, /* 174 */ scheme_rt_indexed_string, /* 176 */
scheme_rt_output_file, /* 175 */ scheme_rt_output_file, /* 177 */
scheme_rt_load_handler_data, /* 176 */ scheme_rt_load_handler_data, /* 178 */
scheme_rt_pipe, /* 177 */ scheme_rt_pipe, /* 179 */
scheme_rt_beos_process, /* 178 */ scheme_rt_beos_process, /* 180 */
scheme_rt_system_child, /* 179 */ scheme_rt_system_child, /* 181 */
scheme_rt_tcp, /* 180 */ scheme_rt_tcp, /* 182 */
scheme_rt_write_data, /* 181 */ scheme_rt_write_data, /* 183 */
scheme_rt_tcp_select_info, /* 182 */ scheme_rt_tcp_select_info, /* 184 */
scheme_rt_namespace_option, /* 183 */ scheme_rt_namespace_option, /* 185 */
scheme_rt_param_data, /* 184 */ scheme_rt_param_data, /* 186 */
scheme_rt_will, /* 185 */ scheme_rt_will, /* 187 */
scheme_rt_struct_proc_info, /* 186 */ scheme_rt_struct_proc_info, /* 188 */
scheme_rt_linker_name, /* 187 */ scheme_rt_linker_name, /* 189 */
scheme_rt_param_map, /* 188 */ scheme_rt_param_map, /* 190 */
scheme_rt_finalization, /* 189 */ scheme_rt_finalization, /* 191 */
scheme_rt_finalizations, /* 190 */ scheme_rt_finalizations, /* 192 */
scheme_rt_cpp_object, /* 191 */ scheme_rt_cpp_object, /* 193 */
scheme_rt_cpp_array_object, /* 192 */ scheme_rt_cpp_array_object, /* 194 */
scheme_rt_stack_object, /* 193 */ scheme_rt_stack_object, /* 195 */
scheme_rt_preallocated_object, /* 194 */ scheme_rt_preallocated_object, /* 196 */
scheme_thread_hop_type, /* 195 */ scheme_thread_hop_type, /* 197 */
scheme_rt_srcloc, /* 196 */ scheme_rt_srcloc, /* 198 */
scheme_rt_evt, /* 197 */ scheme_rt_evt, /* 199 */
scheme_rt_syncing, /* 198 */ scheme_rt_syncing, /* 200 */
scheme_rt_comp_prefix, /* 199 */ scheme_rt_comp_prefix, /* 201 */
scheme_rt_user_input, /* 200 */ scheme_rt_user_input, /* 202 */
scheme_rt_user_output, /* 201 */ scheme_rt_user_output, /* 203 */
scheme_rt_compact_port, /* 202 */ scheme_rt_compact_port, /* 204 */
scheme_rt_read_special_dw, /* 203 */ scheme_rt_read_special_dw, /* 205 */
scheme_rt_regwork, /* 204 */ scheme_rt_regwork, /* 206 */
scheme_rt_buf_holder, /* 205 */ scheme_rt_buf_holder, /* 207 */
scheme_rt_parameterization, /* 206 */ scheme_rt_parameterization, /* 208 */
scheme_rt_print_params, /* 207 */ scheme_rt_print_params, /* 209 */
scheme_rt_read_params, /* 208 */ scheme_rt_read_params, /* 210 */
scheme_rt_native_code, /* 209 */ scheme_rt_native_code, /* 211 */
scheme_rt_native_code_plus_case, /* 210 */ scheme_rt_native_code_plus_case, /* 212 */
scheme_rt_jitter_data, /* 211 */ scheme_rt_jitter_data, /* 213 */
scheme_rt_module_exports, /* 212 */ scheme_rt_module_exports, /* 214 */
scheme_rt_delay_load_info, /* 213 */ scheme_rt_delay_load_info, /* 215 */
scheme_rt_marshal_info, /* 214 */ scheme_rt_marshal_info, /* 216 */
scheme_rt_unmarshal_info, /* 215 */ scheme_rt_unmarshal_info, /* 217 */
scheme_rt_runstack, /* 216 */ scheme_rt_runstack, /* 218 */
scheme_rt_sfs_info, /* 217 */ scheme_rt_sfs_info, /* 219 */
scheme_rt_validate_clearing, /* 218 */ scheme_rt_validate_clearing, /* 220 */
scheme_rt_rb_node, /* 219 */ scheme_rt_rb_node, /* 221 */
#endif #endif
_scheme_last_type_ _scheme_last_type_

8
src/mzscheme/src/syntax.c
View File

@ -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. */ to (let-values ([id e] ...) body) for simple e. */
if ((pre_body->count != 1) if ((pre_body->count != 1)
&& is_values_apply(value) && 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) { if (!pre_body->count && !i) {
/* We want to drop the clause entirely, but doing it /* We want to drop the clause entirely, but doing it
here messes up the loop for letrec. So wait and 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 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--; ) { for (j = pre_body->count; j--; ) {
if (pre_body->flags[j] & SCHEME_WAS_USED) { if (pre_body->flags[j] & SCHEME_WAS_USED) {
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) if (j >= 0)
break; break;
if (!scheme_omittable_expr(clv->value, clv->count, -1, 0)) if (!scheme_omittable_expr(clv->value, clv->count, -1, 0, NULL))
break; break;
} }
if (i < 0) { 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); 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 */ /* short cut */
a = _scheme_eval_linked_expr_multi(a); a = _scheme_eval_linked_expr_multi(a);
} else { } else {

27
src/mzscheme/src/thread.c
View File

@ -206,11 +206,16 @@ Scheme_Object *scheme_exn_handler_key;
Scheme_Object *scheme_break_enabled_key; Scheme_Object *scheme_break_enabled_key;
long scheme_total_gc_time; 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_start_callback)(void);
extern MZ_DLLIMPORT void (*GC_collect_end_callback)(void); extern MZ_DLLIMPORT void (*GC_collect_end_callback)(void);
#endif
static void get_ready_for_GC(void); static void get_ready_for_GC(void);
static void done_with_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 volatile short delayed_break_ready = 0;
static Scheme_Thread *main_break_target_thread; 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_start_callback = get_ready_for_GC;
GC_collect_end_callback = done_with_GC; GC_collect_end_callback = done_with_GC;
#ifdef MZ_PRECISE_GC
GC_collect_inform_callback = inform_GC;
#endif
#ifdef LINK_EXTENSIONS_BY_TABLE #ifdef LINK_EXTENSIONS_BY_TABLE
scheme_current_thread_ptr = &scheme_current_thread; scheme_current_thread_ptr = &scheme_current_thread;
@ -7184,9 +7192,24 @@ static void done_with_GC()
scheme_block_child_signals(0); scheme_block_child_signals(0);
#endif #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 #ifdef MZ_XFORM
END_XFORM_SKIP; END_XFORM_SKIP;
#endif #endif

6
src/mzscheme/src/type.c
View File

@ -266,6 +266,9 @@ scheme_init_type (Scheme_Env *env)
set_name(scheme_already_comp_type, "<internal:already-compiled>"); set_name(scheme_already_comp_type, "<internal:already-compiled>");
set_name(scheme_logger_type, "<logger>");
set_name(scheme_log_reader_type, "<log-receiver>");
set_name(_scheme_values_types_, "<resurrected>"); set_name(_scheme_values_types_, "<resurrected>");
set_name(_scheme_compiled_values_types_, "<internal>"); set_name(_scheme_compiled_values_types_, "<internal>");
@ -610,6 +613,9 @@ void scheme_register_traversers(void)
GC_REG_TRAV(scheme_resolved_module_path_type, small_object); 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); GC_REG_TRAV(scheme_rt_runstack, runstack_val);
} }

2
src/mzscheme/uconfig.h
View File

@ -18,6 +18,8 @@
#define UNIX_PROCESSES #define UNIX_PROCESSES
#define CLOSE_ALL_FDS_AFTER_FORK #define CLOSE_ALL_FDS_AFTER_FORK
#define USE_C_SYSLOG
#define EXPAND_FILENAME_TILDE #define EXPAND_FILENAME_TILDE
#define DO_STACK_CHECK #define DO_STACK_CHECK