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
"bad grammar clause"
stx
(car #f))]
(car clauses))]
[_else
(loop (cdr clauses)
cfg-start

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

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

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

@ -2822,7 +2822,8 @@ designates the character that triggers autocompletion
[else
(raise (make-exn:fail:contract
(string->immutable-string
(format "parameter ~a: expected ~a, given: ~e" name description v))))]))))
(format "parameter ~a: expected ~a, given: ~e" name description v))
(current-continuation-marks)))]))))
(define autocomplete-append-after
(make-guarded-parameter 'append-after "string" "" string?))

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

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

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

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

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

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

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

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

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

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

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

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

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

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

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

2
collects/mzlib/port.ss
View File

@ -1627,7 +1627,7 @@
(begin
(when (> len2 (bytes-length out-bytes))
(raise-insane-decoding-length))
(bytes-copy out-bytes 0 s2 start2 (+ start2 len2))
(bytes-copy! out-bytes 0 s2 start2 (+ start2 len2))
(set! out-start 0)
(set! out-end len2)
used))]

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

@ -154,7 +154,7 @@
[(pair? strs)
(apply build-path (string->path/win (car strs))
(map string->path-element/same (cdr strs)))]
[else (build-path)]) ; error
[else (error 'file://->path "no path elements: ~e" url)])
(let ([elems (map string->path-element/same strs)])
(if (url-path-absolute? url)
(apply build-path (bytes->path #"/" 'unix) elems)

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

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

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

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

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

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

7
collects/scheme/mzscheme.ss
View File

@ -22,7 +22,8 @@
(#%provide require require-for-syntax require-for-template require-for-label
provide provide-for-syntax provide-for-label
(all-from-except "private/more-scheme.ss" case old-case)
(all-from-except "private/more-scheme.ss" case old-case
log-fatal log-error log-warning log-info log-debug)
(rename old-case case)
(all-from "private/misc.ss")
(all-from-except "private/stxcase-scheme.ss" _)
@ -55,7 +56,9 @@
hash-copy hash-count
hash-map hash-for-each
hash-iterate-first hash-iterate-next
hash-iterate-value hash-iterate-key)
hash-iterate-value hash-iterate-key
log-message log-level? make-logger logger? current-logger logger-name
make-log-receiver log-receiver?)
(rename syntax->datum syntax-object->datum)
(rename datum->syntax datum->syntax-object)
(rename free-identifier=? module-identifier=?)

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

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

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)
(apply values v)))])))
(define-syntax (log-it stx)
(syntax-case stx ()
[(_ id mode str-expr)
#'(let ([l (current-logger)])
(when (log-level? l 'mode)
(log-message l 'mode str-expr (current-continuation-marks))))]))
(define-syntax (define-log stx)
(syntax-case stx ()
[(_ id mode)
#'(define-syntax (id stx)
(syntax-case stx ()
[(_ str-expr)
#'(log-it id mode str-expr)]))]))
(define-log log-fatal fatal)
(define-log log-error error)
(define-log log-warning warning)
(define-log log-info info)
(define-log log-debug debug)
(#%provide case old-case do
parameterize parameterize* current-parameterization call-with-parameterization
parameterize-break current-break-parameterization call-with-break-parameterization
with-handlers with-handlers* call-with-exception-handler
set!-values
let/cc fluid-let time))
let/cc fluid-let time
log-fatal log-error log-warning log-info log-debug))

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

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

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

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

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

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[src-namespace].
If @scheme[modname] does not refer to an instantiated module in
If @scheme[modname] does not refer to an @tech{instantiate}d module in
@scheme[src-namespace], or if the name of any module to be attached
already has a different declaration or instance in
@scheme[dest-namespace], then the @exnraise[exn:fail:contract].
@scheme[dest-namespace], then the @exnraise[exn:fail:contract]. If
the module to attach has not been @tech{visit}ed (see
@secref["mod-parse"]), then it is @tech{visit}ed in the original
namespace before being attached.
If @scheme[src-namespace] and @scheme[dest-namespace] do not have the
same @tech{base phase}, then the @exnraise[exn:fail:contract].}

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

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

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}
On startup, the top-level environment contains no bindings---not even
for function application. Primitive modules with names that start with
@schemeidfont{#%} are defined, but they are not meant for direct use,
and the set of such modules can change. For example, the
@indexed-scheme['#%kernel] module is eventually used to bootstrap the
implemetation of @schememodname[scheme/base], and
@scheme[#%app] for function application. Primitive modules with names
that start with @schemeidfont{#%} are defined, but they are not meant
for direct use, and the set of such modules can change. For example,
the @indexed-scheme['#%kernel] module is eventually used to bootstrap
the implemetation of @schememodname[scheme/base], and
@scheme['#%mred-kernel] is used for @schememodname[scheme/gui/base].
The first action of MzScheme or MrEd is to initialize
@ -250,6 +250,18 @@ flags:
ports. This flag currently has no effect, because binary mode
is always used.}
@item{@FlagFirst{W} @nonterm{level} or @DFlagFirst{warn}
@nonterm{level} : Sets the logging level for writing events to
the original error port. The possible @nonterm{level} values
are the same as for the @envvar{PLTSTDERR} environment
variable. See @secref["logging"] for more information.}
@item{@FlagFirst{L} @nonterm{level} or @DFlagFirst{syslog}
@nonterm{level} : Sets the logging level for writing events to
the system log. The possible @nonterm{level} values
are the same as for the @envvar{PLTSYSLOG} environment
variable. See @secref["logging"] for more information.}
}}
@item{Meta options:

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

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

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 "unitsig.ss")
(load-relative "thread.ss")
(load-relative "logger.ss")
(load-relative "sync.ss")
(load-relative "deep.ss")
(load-relative "contmark.ss")

2
collects/texpict/face.ss
View File

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

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
>> 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;
}
static int get_log_level(char *prog, char *real_switch, const char *envvar, const char *what, char *str)
{
if (!strcmp(str, "none"))
return 0;
else if (!strcmp(str, "fatal"))
return SCHEME_LOG_FATAL;
else if (!strcmp(str, "error"))
return SCHEME_LOG_ERROR;
else if (!strcmp(str, "warning"))
return SCHEME_LOG_WARNING;
else if (!strcmp(str, "info"))
return SCHEME_LOG_INFO;
else if (!strcmp(str, "debug"))
return SCHEME_LOG_DEBUG;
PRINTF("%s: %s level %s%s%s must be one of the following:\n"
" none fatal error warning info or debug\n"
" given: %s\n",
prog, what,
real_switch ? "after " : "in ",
real_switch ? real_switch : envvar,
real_switch ? " switch" : " envrionment variable",
str);
return -1;
}
static int get_arg_log_level(char *prog, char *real_switch, const char *what, int argc, char **argv)
{
if (argc < 2) {
PRINTF("%s: missing %s level after %s switch\n",
prog, what, real_switch);
return -1;
}
return get_log_level(prog, real_switch, NULL, what, argv[1]);
}
#ifdef USE_OSKIT_CONSOLE
/* Hack to disable normal input mode: */
int osk_not_console = 0;
@ -425,6 +462,7 @@ static int run_from_cmd_line(int argc, char *_argv[],
int was_config_flag = 0, saw_nc_flag = 0;
int no_compiled = 0;
int init_ns = 0, no_init_ns = 0;
int syslog_level = -1, stderr_level = -1;
FinishArgs *fa;
FinishArgsAtoms *fa_a;
@ -629,6 +667,10 @@ static int run_from_cmd_line(int argc, char *_argv[],
argv[0] = "-i";
else if (!strcmp("--binary", argv[0]))
argv[0] = "-b";
else if (!strcmp("--warn", argv[0]))
argv[0] = "-W";
else if (!strcmp("--syslog", argv[0]))
argv[0] = "-L";
else if (!strcmp("--collects", argv[0]))
argv[0] = "-X";
else if (!strcmp("--search", argv[0]))
@ -857,6 +899,22 @@ static int run_from_cmd_line(int argc, char *_argv[],
osk_not_console = 1;
break;
#endif
case 'W':
stderr_level = get_arg_log_level(prog, real_switch, "stderr", argc, argv);
if (stderr_level < 0)
goto show_need_help;
--argc;
argv++;
was_config_flag = 1;
break;
case 'L':
syslog_level = get_arg_log_level(prog, real_switch, "syslog", argc, argv);
if (syslog_level < 0)
goto show_need_help;
--argc;
argv++;
was_config_flag = 1;
break;
default:
specific_switch[0] = *str;
specific_switch[1] = 0;
@ -922,6 +980,25 @@ static int run_from_cmd_line(int argc, char *_argv[],
}
#endif /* DONT_PARSE_COMMAND_LINE */
#ifdef GETENV_FUNCTION
if (syslog_level < 0) {
char *s;
s = getenv("PLTSYSLOG");
if (s) {
syslog_level = get_log_level(prog, NULL, "PLTSYSLOG", "syslog", s);
}
}
if (stderr_level < 0) {
char *s;
s = getenv("PLTSTDERR");
if (s) {
stderr_level = get_log_level(prog, NULL, "PLTSTDERR", "stderr", s);
}
}
#endif
scheme_set_logging(syslog_level, stderr_level);
global_env = mk_basic_env();
sch_argv = scheme_make_vector(argc, NULL);
@ -1071,6 +1148,8 @@ static int run_from_cmd_line(int argc, char *_argv[],
# endif
" -d, --no-delay: Disable on-demand loading of syntax and code\n"
" -b, --binary : Read stdin and write stdout/stderr in binary mode\n"
" -W <level>, --warn <level> : Set stderr logging to <level>\n"
" -L <level>, --syslog <level> : Set syslog logging to <level>\n"
" Meta options:\n"
" -- : No argument following this switch is used as a switch\n"
" -h, --help : Show this information and exits, ignoring other options\n"

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

@ -147,6 +147,7 @@ static int current_mark_type;
/********************* Client hooks *********************/
void (*GC_collect_start_callback)(void);
void (*GC_collect_end_callback)(void);
void (*GC_collect_inform_callback)(int major_gc, long pre_used, long post_used);
void (*GC_out_of_memory)(void);
unsigned long (*GC_get_thread_stack_base)(void);

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_end_callback)(void);
GC2_EXTERN void (*GC_collect_inform_callback)(int major_gc, long pre_used, long post_used);
/*
Called by GC before/after performing a collection. Used by MzScheme
to zero out some data and record collection times. The end

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

@ -126,6 +126,7 @@
/* the externals */
void (*GC_collect_start_callback)(void);
void (*GC_collect_end_callback)(void);
void (*GC_collect_inform_callback)(int major_gc, long pre_used, long post_used);
void (*GC_out_of_memory)(void);
unsigned long (*GC_get_thread_stack_base)(void);
void (*GC_mark_xtagged)(void *obj);
@ -3026,7 +3027,7 @@ static void garbage_collect(int force_full)
static unsigned int since_last_full = 0;
static unsigned int running_finalizers = 0;
static unsigned long last_full_mem_use = (20 * 1024 * 1024);
unsigned long old_mem_use = memory_in_use;
unsigned long old_mem_use = memory_in_use, old_gen0 = gen0_current_size;
int next_gc_full;
TIME_DECLS();
@ -3177,8 +3178,10 @@ static void garbage_collect(int force_full)
last_full_mem_use = memory_in_use;
/* inform the system (if it wants us to) that we're done with collection */
if(GC_collect_start_callback)
if (GC_collect_start_callback)
GC_collect_end_callback();
if (GC_collect_inform_callback)
GC_collect_inform_callback(gc_full, old_mem_use + old_gen0, memory_in_use);
TIME_STEP("ended");

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

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

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

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

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

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

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

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

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

@ -1010,7 +1010,7 @@ typedef struct Scheme_Thread {
struct Scheme_Marshal_Tables *current_mt;
char skip_error;
Scheme_Object *constant_folding; /* compiler hack */
Scheme_Object *(*overflow_k)(void);
Scheme_Object *overflow_reply;
@ -1210,6 +1210,8 @@ enum {
MZCONFIG_EXPAND_OBSERVE,
MZCONFIG_LOGGER,
__MZCONFIG_BUILTIN_COUNT__
};
@ -1330,6 +1332,14 @@ struct Scheme_Output_Port
# include "../src/schexn.h"
#endif
#define SCHEME_LOG_FATAL 1
#define SCHEME_LOG_ERROR 2
#define SCHEME_LOG_WARNING 3
#define SCHEME_LOG_INFO 4
#define SCHEME_LOG_DEBUG 5
typedef struct Scheme_Logger Scheme_Logger;
/*========================================================================*/
/* security */
/*========================================================================*/
@ -1634,9 +1644,11 @@ MZ_EXTERN void scheme_set_binary_mode_stdio(int);
MZ_EXTERN void scheme_set_startup_use_jit(int);
MZ_EXTERN void scheme_set_startup_load_on_demand(int);
MZ_EXTERN void scheme_set_ignore_user_paths(int);
MZ_EXTERN void scheme_set_logging(int syslog_level, int stderr_level);
MZ_EXTERN int scheme_get_allow_set_undefined();
MZ_EXTERN Scheme_Thread *scheme_current_thread;
MZ_EXTERN Scheme_Thread *scheme_first_thread;

12
src/mzscheme/sconfig.h
View File

@ -509,6 +509,9 @@
# define GETENV_FUNCTION
# define DIR_FUNCTION
# define USE_WINDOWS_EVENT_LOG
# define INIT_SYSLOG_LEVEL SCHEME_LOG_ERROR
# define DO_STACK_CHECK
# define WINDOWS_FIND_STACK_BOUNDS
@ -651,6 +654,8 @@
# include "uconfig.h"
# define INIT_SYSLOG_LEVEL SCHEME_LOG_ERROR
# undef HAS_STANDARD_IOB
# define HAS_BSD_IOB
@ -979,6 +984,13 @@
/* MKDIR_NO_MODE_FLAG specifies that mkdir() takes only one argument,
instead of a directory name and mode flags. */
/* USE_C_SYSLOG uses the C syslog library for logging. */
/* USE_WINDOWS_EVENT_LOG uses the Windows event log API for logging. */
/* INIT_SYSLOG_LEVEL sets the initial level for filtering messages
sent to syslog. It default to 0 (i.e., no events). */
/***********************/
/* Ports */
/***********************/

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,
16,0,20,0,25,0,38,0,41,0,46,0,53,0,60,0,64,0,69,0,78,
static MZCOMPILED_STRING_FAR unsigned char expr[] = {35,126,7,52,46,48,46,50,46,52,50,0,0,0,1,0,0,6,0,9,0,
13,0,18,0,25,0,32,0,37,0,42,0,55,0,59,0,66,0,69,0,78,
0,84,0,98,0,112,0,115,0,119,0,121,0,132,0,134,0,148,0,155,0,
177,0,179,0,193,0,253,0,23,1,32,1,41,1,51,1,68,1,107,1,146,
1,215,1,4,2,92,2,137,2,142,2,162,2,53,3,73,3,124,3,190,3,
75,4,233,4,20,5,31,5,110,5,0,0,118,7,0,0,65,98,101,103,105,
110,29,11,11,66,100,101,102,105,110,101,63,97,110,100,64,108,101,116,42,72,
112,97,114,97,109,101,116,101,114,105,122,101,62,111,114,64,99,111,110,100,66,
108,101,116,114,101,99,66,117,110,108,101,115,115,63,108,101,116,64,119,104,101,
110,68,104,101,114,101,45,115,116,120,65,113,117,111,116,101,29,94,2,14,68,
110,29,11,11,63,108,101,116,64,99,111,110,100,66,117,110,108,101,115,115,66,
100,101,102,105,110,101,64,119,104,101,110,64,108,101,116,42,72,112,97,114,97,
109,101,116,101,114,105,122,101,63,97,110,100,66,108,101,116,114,101,99,62,111,
114,68,104,101,114,101,45,115,116,120,65,113,117,111,116,101,29,94,2,14,68,
35,37,107,101,114,110,101,108,11,29,94,2,14,68,35,37,112,97,114,97,109,
122,11,62,105,102,63,115,116,120,61,115,70,108,101,116,45,118,97,108,117,101,
115,61,120,73,108,101,116,114,101,99,45,118,97,108,117,101,115,66,108,97,109,
98,100,97,1,20,112,97,114,97,109,101,116,101,114,105,122,97,116,105,111,110,
45,107,101,121,61,118,73,100,101,102,105,110,101,45,118,97,108,117,101,115,98,
10,35,11,8,182,216,94,159,2,16,35,35,159,2,15,35,35,16,20,2,3,
2,2,2,7,2,2,2,4,2,2,2,5,2,2,2,6,2,2,2,9,2,
2,2,8,2,2,2,10,2,2,2,11,2,2,2,12,2,2,97,36,11,8,
182,216,93,159,2,15,35,36,16,2,2,13,161,2,2,36,2,13,2,2,2,
13,97,10,11,11,8,182,216,16,0,97,10,37,11,8,182,216,16,0,13,16,
10,35,11,8,133,217,94,159,2,16,35,35,159,2,15,35,35,16,20,2,3,
2,2,2,5,2,2,2,6,2,2,2,7,2,2,2,8,2,2,2,9,2,
2,2,10,2,2,2,4,2,2,2,11,2,2,2,12,2,2,97,36,11,8,
133,217,93,159,2,15,35,36,16,2,2,13,161,2,2,36,2,13,2,2,2,
13,97,10,11,11,8,133,217,16,0,97,10,37,11,8,133,217,16,0,13,16,
4,35,29,11,11,2,2,11,18,98,64,104,101,114,101,8,31,8,30,8,29,
8,28,8,27,27,248,22,189,3,23,196,1,249,22,182,3,80,158,38,35,251,
22,73,2,17,248,22,88,23,200,2,12,249,22,63,2,1,248,22,90,23,202,
@ -26,16 +26,16 @@
17,248,22,88,23,200,2,249,22,63,2,1,248,22,90,23,202,1,12,27,248,
22,65,248,22,189,3,23,197,1,28,248,22,71,23,194,2,20,15,159,36,35,
36,28,248,22,71,248,22,65,23,195,2,248,22,64,193,249,22,182,3,80,158,
38,35,251,22,73,2,17,248,22,64,23,200,2,249,22,63,2,4,248,22,65,
38,35,251,22,73,2,17,248,22,64,23,200,2,249,22,63,2,10,248,22,65,
23,202,1,11,18,100,10,8,31,8,30,8,29,8,28,8,27,16,4,11,11,
2,18,3,1,7,101,110,118,55,57,55,54,16,4,11,11,2,19,3,1,7,
101,110,118,55,57,55,55,27,248,22,65,248,22,189,3,23,197,1,28,248,22,
2,18,3,1,7,101,110,118,55,57,57,49,16,4,11,11,2,19,3,1,7,
101,110,118,55,57,57,50,27,248,22,65,248,22,189,3,23,197,1,28,248,22,
71,23,194,2,20,15,159,36,35,36,28,248,22,71,248,22,65,23,195,2,248,
22,64,193,249,22,182,3,80,158,38,35,250,22,73,2,20,248,22,73,249,22,
73,248,22,73,2,21,248,22,64,23,202,2,251,22,73,2,17,2,21,2,21,
249,22,63,2,7,248,22,65,23,205,1,18,100,11,8,31,8,30,8,29,8,
28,8,27,16,4,11,11,2,18,3,1,7,101,110,118,55,57,55,57,16,4,
11,11,2,19,3,1,7,101,110,118,55,57,56,48,248,22,189,3,193,27,248,
249,22,63,2,12,248,22,65,23,205,1,18,100,11,8,31,8,30,8,29,8,
28,8,27,16,4,11,11,2,18,3,1,7,101,110,118,55,57,57,52,16,4,
11,11,2,19,3,1,7,101,110,118,55,57,57,53,248,22,189,3,193,27,248,
22,189,3,194,249,22,63,248,22,73,248,22,64,196,248,22,65,195,27,248,22,
65,248,22,189,3,23,197,1,249,22,182,3,80,158,38,35,28,248,22,51,248,
22,183,3,248,22,64,23,198,2,27,249,22,2,32,0,89,162,8,44,36,42,
@ -49,7 +49,7 @@
22,2,32,0,89,162,8,44,36,46,9,222,33,42,248,22,189,3,248,22,64,
201,248,22,65,198,27,248,22,65,248,22,189,3,196,27,248,22,189,3,248,22,
64,195,249,22,182,3,80,158,39,35,28,248,22,71,195,250,22,74,2,20,9,
248,22,65,199,250,22,73,2,11,248,22,73,248,22,64,199,250,22,74,2,5,
248,22,65,199,250,22,73,2,3,248,22,73,248,22,64,199,250,22,74,2,8,
248,22,65,201,248,22,65,202,27,248,22,65,248,22,189,3,23,197,1,27,249,
22,1,22,77,249,22,2,22,189,3,248,22,189,3,248,22,64,199,249,22,182,
3,80,158,39,35,251,22,73,1,22,119,105,116,104,45,99,111,110,116,105,110,
@ -61,12 +61,12 @@
15,159,36,35,36,249,22,182,3,80,158,38,35,27,248,22,189,3,248,22,64,
23,198,2,28,249,22,150,8,62,61,62,248,22,183,3,248,22,88,23,197,2,
250,22,73,2,20,248,22,73,249,22,73,21,93,2,25,248,22,64,199,250,22,
74,2,8,249,22,73,2,25,249,22,73,248,22,97,203,2,25,248,22,65,202,
74,2,4,249,22,73,2,25,249,22,73,248,22,97,203,2,25,248,22,65,202,
251,22,73,2,17,28,249,22,150,8,248,22,183,3,248,22,64,23,201,2,64,
101,108,115,101,10,248,22,64,23,198,2,250,22,74,2,20,9,248,22,65,23,
201,1,249,22,63,2,8,248,22,65,23,203,1,99,8,31,8,30,8,29,8,
28,8,27,16,4,11,11,2,18,3,1,7,101,110,118,56,48,48,50,16,4,
11,11,2,19,3,1,7,101,110,118,56,48,48,51,18,158,94,10,64,118,111,
201,1,249,22,63,2,4,248,22,65,23,203,1,99,8,31,8,30,8,29,8,
28,8,27,16,4,11,11,2,18,3,1,7,101,110,118,56,48,49,55,16,4,
11,11,2,19,3,1,7,101,110,118,56,48,49,56,18,158,94,10,64,118,111,
105,100,8,47,27,248,22,65,248,22,189,3,196,249,22,182,3,80,158,38,35,
28,248,22,51,248,22,183,3,248,22,64,197,250,22,73,2,26,248,22,73,248,
22,64,199,248,22,88,198,27,248,22,183,3,248,22,64,197,250,22,73,2,26,
@ -78,28 +78,28 @@
11,11,11,11,11,16,10,2,3,2,4,2,5,2,6,2,7,2,8,2,9,
2,10,2,11,2,12,35,45,36,11,11,16,0,16,0,16,0,35,35,11,11,
11,16,0,16,0,16,0,35,35,16,11,16,5,93,2,13,20,15,159,35,35,
35,35,20,103,159,35,16,0,16,1,33,32,10,16,5,93,2,10,89,162,8,
35,35,20,103,159,35,16,0,16,1,33,32,10,16,5,93,2,5,89,162,8,
44,36,52,9,223,0,33,33,35,20,103,159,35,16,1,20,25,159,36,2,2,
2,13,16,0,11,16,5,93,2,12,89,162,8,44,36,52,9,223,0,33,34,
2,13,16,0,11,16,5,93,2,7,89,162,8,44,36,52,9,223,0,33,34,
35,20,103,159,35,16,1,20,25,159,36,2,2,2,13,16,0,11,16,5,93,
2,4,89,162,8,44,36,52,9,223,0,33,35,35,20,103,159,35,16,1,20,
25,159,36,2,2,2,13,16,1,33,36,11,16,5,93,2,7,89,162,8,44,
2,10,89,162,8,44,36,52,9,223,0,33,35,35,20,103,159,35,16,1,20,
25,159,36,2,2,2,13,16,1,33,36,11,16,5,93,2,12,89,162,8,44,
36,55,9,223,0,33,37,35,20,103,159,35,16,1,20,25,159,36,2,2,2,
13,16,1,33,38,11,16,5,93,2,11,89,162,8,44,36,57,9,223,0,33,
13,16,1,33,38,11,16,5,93,2,3,89,162,8,44,36,57,9,223,0,33,
41,35,20,103,159,35,16,1,20,25,159,36,2,2,2,13,16,0,11,16,5,
93,2,9,89,162,8,44,36,52,9,223,0,33,43,35,20,103,159,35,16,1,
20,25,159,36,2,2,2,13,16,0,11,16,5,93,2,5,89,162,8,44,36,
93,2,11,89,162,8,44,36,52,9,223,0,33,43,35,20,103,159,35,16,1,
20,25,159,36,2,2,2,13,16,0,11,16,5,93,2,8,89,162,8,44,36,
53,9,223,0,33,44,35,20,103,159,35,16,1,20,25,159,36,2,2,2,13,
16,0,11,16,5,93,2,6,89,162,8,44,36,54,9,223,0,33,45,35,20,
103,159,35,16,1,20,25,159,36,2,2,2,13,16,0,11,16,5,93,2,8,
16,0,11,16,5,93,2,9,89,162,8,44,36,54,9,223,0,33,45,35,20,
103,159,35,16,1,20,25,159,36,2,2,2,13,16,0,11,16,5,93,2,4,
89,162,8,44,36,57,9,223,0,33,46,35,20,103,159,35,16,1,20,25,159,
36,2,2,2,13,16,1,33,48,11,16,5,93,2,3,89,162,8,44,36,53,
36,2,2,2,13,16,1,33,48,11,16,5,93,2,6,89,162,8,44,36,53,
9,223,0,33,49,35,20,103,159,35,16,1,20,25,159,36,2,2,2,13,16,
0,11,16,0,94,2,15,2,16,93,2,15,9,9,35,0};
EVAL_ONE_SIZED_STR((char *)expr, 2031);
}
{
static MZCOMPILED_STRING_FAR unsigned char expr[] = {35,126,7,52,46,48,46,49,46,51,59,0,0,0,1,0,0,3,0,16,0,
static MZCOMPILED_STRING_FAR unsigned char expr[] = {35,126,7,52,46,48,46,50,46,52,59,0,0,0,1,0,0,3,0,16,0,
21,0,38,0,53,0,71,0,87,0,97,0,115,0,135,0,151,0,169,0,200,
0,229,0,251,0,9,1,15,1,29,1,34,1,44,1,52,1,80,1,112,1,
157,1,202,1,226,1,9,2,11,2,68,2,158,3,199,3,33,5,137,5,241,
@ -131,173 +131,173 @@
32,98,121,116,101,32,115,116,114,105,110,103,6,36,36,99,97,110,110,111,116,
32,97,100,100,32,97,32,115,117,102,102,105,120,32,116,111,32,97,32,114,111,
111,116,32,112,97,116,104,58,32,5,0,27,20,14,159,80,158,36,50,250,80,
158,39,51,249,22,27,11,80,158,41,50,22,158,12,10,248,22,134,5,23,196,
158,39,51,249,22,27,11,80,158,41,50,22,166,12,10,248,22,134,5,23,196,
2,28,248,22,176,5,23,194,2,12,87,94,248,22,153,8,23,194,1,248,80,
159,37,53,36,195,28,248,22,71,23,195,2,9,27,248,22,64,23,196,2,27,
28,248,22,139,13,23,195,2,23,194,1,28,248,22,138,13,23,195,2,249,22,
140,13,23,196,1,250,80,158,42,48,248,22,154,13,2,20,11,10,250,80,158,
40,48,248,22,154,13,2,20,23,197,1,10,28,23,193,2,249,22,63,248,22,
142,13,249,22,140,13,23,198,1,247,22,155,13,27,248,22,65,23,200,1,28,
248,22,71,23,194,2,9,27,248,22,64,23,195,2,27,28,248,22,139,13,23,
195,2,23,194,1,28,248,22,138,13,23,195,2,249,22,140,13,23,196,1,250,
80,158,47,48,248,22,154,13,2,20,11,10,250,80,158,45,48,248,22,154,13,
2,20,23,197,1,10,28,23,193,2,249,22,63,248,22,142,13,249,22,140,13,
23,198,1,247,22,155,13,248,80,159,45,52,36,248,22,65,23,199,1,87,94,
28,248,22,147,13,23,195,2,23,194,1,28,248,22,146,13,23,195,2,249,22,
148,13,23,196,1,250,80,158,42,48,248,22,162,13,2,20,11,10,250,80,158,
40,48,248,22,162,13,2,20,23,197,1,10,28,23,193,2,249,22,63,248,22,
150,13,249,22,148,13,23,198,1,247,22,163,13,27,248,22,65,23,200,1,28,
248,22,71,23,194,2,9,27,248,22,64,23,195,2,27,28,248,22,147,13,23,
195,2,23,194,1,28,248,22,146,13,23,195,2,249,22,148,13,23,196,1,250,
80,158,47,48,248,22,162,13,2,20,11,10,250,80,158,45,48,248,22,162,13,
2,20,23,197,1,10,28,23,193,2,249,22,63,248,22,150,13,249,22,148,13,
23,198,1,247,22,163,13,248,80,159,45,52,36,248,22,65,23,199,1,87,94,
23,193,1,248,80,159,43,52,36,248,22,65,23,197,1,87,94,23,193,1,27,
248,22,65,23,198,1,28,248,22,71,23,194,2,9,27,248,22,64,23,195,2,
27,28,248,22,139,13,23,195,2,23,194,1,28,248,22,138,13,23,195,2,249,
22,140,13,23,196,1,250,80,158,45,48,248,22,154,13,2,20,11,10,250,80,
158,43,48,248,22,154,13,2,20,23,197,1,10,28,23,193,2,249,22,63,248,
22,142,13,249,22,140,13,23,198,1,247,22,155,13,248,80,159,43,52,36,248,
22,65,23,199,1,248,80,159,41,52,36,248,22,65,196,27,248,22,179,12,23,
27,28,248,22,147,13,23,195,2,23,194,1,28,248,22,146,13,23,195,2,249,
22,148,13,23,196,1,250,80,158,45,48,248,22,162,13,2,20,11,10,250,80,
158,43,48,248,22,162,13,2,20,23,197,1,10,28,23,193,2,249,22,63,248,
22,150,13,249,22,148,13,23,198,1,247,22,163,13,248,80,159,43,52,36,248,
22,65,23,199,1,248,80,159,41,52,36,248,22,65,196,27,248,22,187,12,23,
195,2,28,23,193,2,192,87,94,23,193,1,28,248,22,145,6,23,195,2,27,
248,22,137,13,195,28,192,192,248,22,138,13,195,11,87,94,28,28,248,22,180,
12,23,195,2,10,27,248,22,179,12,23,196,2,28,23,193,2,192,87,94,23,
193,1,28,248,22,145,6,23,196,2,27,248,22,137,13,23,197,2,28,23,193,
2,192,87,94,23,193,1,248,22,138,13,23,197,2,11,12,250,22,180,8,76,
248,22,145,13,195,28,192,192,248,22,146,13,195,11,87,94,28,28,248,22,188,
12,23,195,2,10,27,248,22,187,12,23,196,2,28,23,193,2,192,87,94,23,
193,1,28,248,22,145,6,23,196,2,27,248,22,145,13,23,197,2,28,23,193,
2,192,87,94,23,193,1,248,22,146,13,23,197,2,11,12,250,22,180,8,76,
110,111,114,109,97,108,45,112,97,116,104,45,99,97,115,101,6,42,42,112,97,
116,104,32,40,102,111,114,32,97,110,121,32,115,121,115,116,101,109,41,32,111,
114,32,118,97,108,105,100,45,112,97,116,104,32,115,116,114,105,110,103,23,197,
2,28,28,248,22,180,12,23,195,2,249,22,150,8,248,22,181,12,23,197,2,
2,28,28,248,22,188,12,23,195,2,249,22,150,8,248,22,189,12,23,197,2,
2,21,249,22,150,8,247,22,164,7,2,21,27,28,248,22,145,6,23,196,2,
23,195,2,248,22,154,7,248,22,184,12,23,197,2,28,249,22,167,13,0,21,
23,195,2,248,22,154,7,248,22,128,13,23,197,2,28,249,22,175,13,0,21,
35,114,120,34,94,91,92,92,93,91,92,92,93,91,63,93,91,92,92,93,34,
23,195,2,28,248,22,145,6,195,248,22,187,12,195,194,27,248,22,184,6,23,
195,1,249,22,188,12,248,22,157,7,250,22,173,13,0,6,35,114,120,34,47,
34,28,249,22,167,13,0,22,35,114,120,34,91,47,92,92,93,91,46,32,93,
43,91,47,92,92,93,42,36,34,23,201,2,23,199,1,250,22,173,13,0,19,
23,195,2,28,248,22,145,6,195,248,22,131,13,195,194,27,248,22,184,6,23,
195,1,249,22,132,13,248,22,157,7,250,22,181,13,0,6,35,114,120,34,47,
34,28,249,22,175,13,0,22,35,114,120,34,91,47,92,92,93,91,46,32,93,
43,91,47,92,92,93,42,36,34,23,201,2,23,199,1,250,22,181,13,0,19,
35,114,120,34,91,32,46,93,43,40,91,47,92,92,93,42,41,36,34,23,202,
1,6,2,2,92,49,80,158,43,36,2,21,28,248,22,145,6,194,248,22,187,
12,194,193,87,94,28,27,248,22,179,12,23,196,2,28,23,193,2,192,87,94,
23,193,1,28,248,22,145,6,23,196,2,27,248,22,137,13,23,197,2,28,23,
193,2,192,87,94,23,193,1,248,22,138,13,23,197,2,11,12,250,22,180,8,
23,196,2,2,22,23,197,2,28,248,22,137,13,23,195,2,12,248,22,134,11,
249,22,143,10,248,22,174,6,250,22,129,7,2,23,23,200,1,23,201,1,247,
22,23,87,94,28,27,248,22,179,12,23,196,2,28,23,193,2,192,87,94,23,
193,1,28,248,22,145,6,23,196,2,27,248,22,137,13,23,197,2,28,23,193,
2,192,87,94,23,193,1,248,22,138,13,23,197,2,11,12,250,22,180,8,23,
196,2,2,22,23,197,2,28,248,22,137,13,23,195,2,12,248,22,134,11,249,
22,143,10,248,22,174,6,250,22,129,7,2,23,23,200,1,23,201,1,247,22,
23,87,94,87,94,28,27,248,22,179,12,23,196,2,28,23,193,2,192,87,94,
23,193,1,28,248,22,145,6,23,196,2,27,248,22,137,13,23,197,2,28,23,
193,2,192,87,94,23,193,1,248,22,138,13,23,197,2,11,12,250,22,180,8,
195,2,22,23,197,2,28,248,22,137,13,23,195,2,12,248,22,134,11,249,22,
143,10,248,22,174,6,250,22,129,7,2,23,199,23,201,1,247,22,23,249,22,
3,89,162,8,44,36,49,9,223,2,33,34,196,248,22,134,11,249,22,173,10,
1,6,2,2,92,49,80,158,43,36,2,21,28,248,22,145,6,194,248,22,131,
13,194,193,87,94,28,27,248,22,187,12,23,196,2,28,23,193,2,192,87,94,
23,193,1,28,248,22,145,6,23,196,2,27,248,22,145,13,23,197,2,28,23,
193,2,192,87,94,23,193,1,248,22,146,13,23,197,2,11,12,250,22,180,8,
23,196,2,2,22,23,197,2,28,248,22,145,13,23,195,2,12,248,22,142,11,
249,22,151,10,248,22,174,6,250,22,129,7,2,23,23,200,1,23,201,1,247,
22,23,87,94,28,27,248,22,187,12,23,196,2,28,23,193,2,192,87,94,23,
193,1,28,248,22,145,6,23,196,2,27,248,22,145,13,23,197,2,28,23,193,
2,192,87,94,23,193,1,248,22,146,13,23,197,2,11,12,250,22,180,8,23,
196,2,2,22,23,197,2,28,248,22,145,13,23,195,2,12,248,22,142,11,249,
22,151,10,248,22,174,6,250,22,129,7,2,23,23,200,1,23,201,1,247,22,
23,87,94,87,94,28,27,248,22,187,12,23,196,2,28,23,193,2,192,87,94,
23,193,1,28,248,22,145,6,23,196,2,27,248,22,145,13,23,197,2,28,23,
193,2,192,87,94,23,193,1,248,22,146,13,23,197,2,11,12,250,22,180,8,
195,2,22,23,197,2,28,248,22,145,13,23,195,2,12,248,22,142,11,249,22,
151,10,248,22,174,6,250,22,129,7,2,23,199,23,201,1,247,22,23,249,22,
3,89,162,8,44,36,49,9,223,2,33,34,196,248,22,142,11,249,22,181,10,
23,196,1,247,22,23,87,94,250,80,159,38,39,36,2,7,196,197,251,80,159,
39,41,36,2,7,32,0,89,162,8,44,36,44,9,222,33,36,197,198,32,38,
89,162,43,41,58,65,99,108,111,111,112,222,33,39,28,248,22,71,23,199,2,
87,94,23,198,1,248,23,196,1,251,22,129,7,2,24,23,199,1,28,248,22,
71,23,203,2,87,94,23,202,1,23,201,1,250,22,1,22,133,13,23,204,1,
23,205,1,23,198,1,27,249,22,133,13,248,22,64,23,202,2,23,199,2,28,
248,22,128,13,23,194,2,27,250,22,1,22,133,13,23,197,1,23,202,2,28,
248,22,128,13,23,194,2,192,87,94,23,193,1,27,248,22,65,23,202,1,28,
71,23,203,2,87,94,23,202,1,23,201,1,250,22,1,22,141,13,23,204,1,
23,205,1,23,198,1,27,249,22,141,13,248,22,64,23,202,2,23,199,2,28,
248,22,136,13,23,194,2,27,250,22,1,22,141,13,23,197,1,23,202,2,28,
248,22,136,13,23,194,2,192,87,94,23,193,1,27,248,22,65,23,202,1,28,
248,22,71,23,194,2,87,94,23,193,1,248,23,199,1,251,22,129,7,2,24,
23,202,1,28,248,22,71,23,206,2,87,94,23,205,1,23,204,1,250,22,1,
22,133,13,23,207,1,23,208,1,23,201,1,27,249,22,133,13,248,22,64,23,
197,2,23,202,2,28,248,22,128,13,23,194,2,27,250,22,1,22,133,13,23,
197,1,204,28,248,22,128,13,193,192,253,2,38,203,204,205,206,23,15,248,22,
22,141,13,23,207,1,23,208,1,23,201,1,27,249,22,141,13,248,22,64,23,
197,2,23,202,2,28,248,22,136,13,23,194,2,27,250,22,1,22,141,13,23,
197,1,204,28,248,22,136,13,193,192,253,2,38,203,204,205,206,23,15,248,22,
65,201,253,2,38,202,203,204,205,206,248,22,65,200,87,94,23,193,1,27,248,
22,65,23,201,1,28,248,22,71,23,194,2,87,94,23,193,1,248,23,198,1,
251,22,129,7,2,24,23,201,1,28,248,22,71,23,205,2,87,94,23,204,1,
23,203,1,250,22,1,22,133,13,23,206,1,23,207,1,23,200,1,27,249,22,
133,13,248,22,64,23,197,2,23,201,2,28,248,22,128,13,23,194,2,27,250,
22,1,22,133,13,23,197,1,203,28,248,22,128,13,193,192,253,2,38,202,203,
23,203,1,250,22,1,22,141,13,23,206,1,23,207,1,23,200,1,27,249,22,
141,13,248,22,64,23,197,2,23,201,2,28,248,22,136,13,23,194,2,27,250,
22,1,22,141,13,23,197,1,203,28,248,22,136,13,193,192,253,2,38,202,203,
204,205,206,248,22,65,201,253,2,38,201,202,203,204,205,248,22,65,200,27,247,
22,156,13,253,2,38,198,199,200,201,202,198,87,95,28,28,248,22,180,12,23,
194,2,10,27,248,22,179,12,23,195,2,28,23,193,2,192,87,94,23,193,1,
28,248,22,145,6,23,195,2,27,248,22,137,13,23,196,2,28,23,193,2,192,
87,94,23,193,1,248,22,138,13,23,196,2,11,12,252,22,180,8,23,200,2,
22,164,13,253,2,38,198,199,200,201,202,198,87,95,28,28,248,22,188,12,23,
194,2,10,27,248,22,187,12,23,195,2,28,23,193,2,192,87,94,23,193,1,
28,248,22,145,6,23,195,2,27,248,22,145,13,23,196,2,28,23,193,2,192,
87,94,23,193,1,248,22,146,13,23,196,2,11,12,252,22,180,8,23,200,2,
2,25,35,23,198,2,23,199,2,28,28,248,22,145,6,23,195,2,10,248,22,
133,7,23,195,2,87,94,23,194,1,12,252,22,180,8,23,200,2,2,26,36,
23,198,2,23,199,1,91,159,38,11,90,161,38,35,11,248,22,136,13,23,197,
23,198,2,23,199,1,91,159,38,11,90,161,38,35,11,248,22,144,13,23,197,
2,87,94,23,195,1,87,94,28,192,12,250,22,181,8,23,201,1,2,27,23,
199,1,249,22,7,194,195,91,159,37,11,90,161,37,35,11,87,95,28,28,248,
22,180,12,23,196,2,10,27,248,22,179,12,23,197,2,28,23,193,2,192,87,
94,23,193,1,28,248,22,145,6,23,197,2,27,248,22,137,13,23,198,2,28,
23,193,2,192,87,94,23,193,1,248,22,138,13,23,198,2,11,12,252,22,180,
22,188,12,23,196,2,10,27,248,22,187,12,23,197,2,28,23,193,2,192,87,
94,23,193,1,28,248,22,145,6,23,197,2,27,248,22,145,13,23,198,2,28,
23,193,2,192,87,94,23,193,1,248,22,146,13,23,198,2,11,12,252,22,180,
8,2,10,2,25,35,23,200,2,23,201,2,28,28,248,22,145,6,23,197,2,
10,248,22,133,7,23,197,2,12,252,22,180,8,2,10,2,26,36,23,200,2,
23,201,2,91,159,38,11,90,161,38,35,11,248,22,136,13,23,199,2,87,94,
23,201,2,91,159,38,11,90,161,38,35,11,248,22,144,13,23,199,2,87,94,
23,195,1,87,94,28,23,193,2,12,250,22,181,8,2,10,2,27,23,201,2,
249,22,7,23,195,1,23,196,1,27,249,22,189,12,250,22,172,13,0,18,35,
114,120,35,34,40,91,46,93,91,94,46,93,42,124,41,36,34,248,22,185,12,
249,22,7,23,195,1,23,196,1,27,249,22,133,13,250,22,180,13,0,18,35,
114,120,35,34,40,91,46,93,91,94,46,93,42,124,41,36,34,248,22,129,13,
23,201,1,28,248,22,145,6,23,203,2,249,22,157,7,23,204,1,8,63,23,
202,1,28,248,22,180,12,23,199,2,248,22,181,12,23,199,1,87,94,23,198,
1,247,22,182,12,28,248,22,179,12,194,249,22,133,13,195,194,192,91,159,37,
11,90,161,37,35,11,87,95,28,28,248,22,180,12,23,196,2,10,27,248,22,
179,12,23,197,2,28,23,193,2,192,87,94,23,193,1,28,248,22,145,6,23,
197,2,27,248,22,137,13,23,198,2,28,23,193,2,192,87,94,23,193,1,248,
22,138,13,23,198,2,11,12,252,22,180,8,2,11,2,25,35,23,200,2,23,
202,1,28,248,22,188,12,23,199,2,248,22,189,12,23,199,1,87,94,23,198,
1,247,22,190,12,28,248,22,187,12,194,249,22,141,13,195,194,192,91,159,37,
11,90,161,37,35,11,87,95,28,28,248,22,188,12,23,196,2,10,27,248,22,
187,12,23,197,2,28,23,193,2,192,87,94,23,193,1,28,248,22,145,6,23,
197,2,27,248,22,145,13,23,198,2,28,23,193,2,192,87,94,23,193,1,248,
22,146,13,23,198,2,11,12,252,22,180,8,2,11,2,25,35,23,200,2,23,
201,2,28,28,248,22,145,6,23,197,2,10,248,22,133,7,23,197,2,12,252,
22,180,8,2,11,2,26,36,23,200,2,23,201,2,91,159,38,11,90,161,38,
35,11,248,22,136,13,23,199,2,87,94,23,195,1,87,94,28,23,193,2,12,
35,11,248,22,144,13,23,199,2,87,94,23,195,1,87,94,28,23,193,2,12,
250,22,181,8,2,11,2,27,23,201,2,249,22,7,23,195,1,23,196,1,27,
249,22,189,12,249,22,143,7,250,22,173,13,0,9,35,114,120,35,34,91,46,
93,34,248,22,185,12,23,203,1,6,1,1,95,28,248,22,145,6,23,202,2,
249,22,157,7,23,203,1,8,63,23,201,1,28,248,22,180,12,23,199,2,248,
22,181,12,23,199,1,87,94,23,198,1,247,22,182,12,28,248,22,179,12,194,
249,22,133,13,195,194,192,249,247,22,132,6,194,11,248,80,158,36,46,9,27,
247,22,158,13,249,80,158,38,47,28,23,195,2,27,248,22,162,7,6,11,11,
249,22,133,13,249,22,143,7,250,22,181,13,0,9,35,114,120,35,34,91,46,
93,34,248,22,129,13,23,203,1,6,1,1,95,28,248,22,145,6,23,202,2,
249,22,157,7,23,203,1,8,63,23,201,1,28,248,22,188,12,23,199,2,248,
22,189,12,23,199,1,87,94,23,198,1,247,22,190,12,28,248,22,187,12,194,
249,22,141,13,195,194,192,249,247,22,132,6,194,11,248,80,158,36,46,9,27,
247,22,166,13,249,80,158,38,47,28,23,195,2,27,248,22,162,7,6,11,11,
80,76,84,67,79,76,76,69,67,84,83,28,192,192,6,0,0,6,0,0,27,
28,23,196,1,250,22,133,13,248,22,154,13,69,97,100,100,111,110,45,100,105,
28,23,196,1,250,22,141,13,248,22,162,13,69,97,100,100,111,110,45,100,105,
114,247,22,160,7,6,8,8,99,111,108,108,101,99,116,115,11,27,248,80,159,
41,52,36,249,22,77,23,202,1,248,22,73,248,22,154,13,72,99,111,108,108,
41,52,36,249,22,77,23,202,1,248,22,73,248,22,162,13,72,99,111,108,108,
101,99,116,115,45,100,105,114,28,23,194,2,249,22,63,23,196,1,23,195,1,
192,32,47,89,162,8,44,38,54,2,19,222,33,48,27,249,22,165,13,23,197,
192,32,47,89,162,8,44,38,54,2,19,222,33,48,27,249,22,173,13,23,197,
2,23,198,2,28,23,193,2,87,94,23,196,1,27,248,22,88,23,195,2,27,
27,248,22,97,23,197,1,27,249,22,165,13,23,201,2,23,196,2,28,23,193,
27,248,22,97,23,197,1,27,249,22,173,13,23,201,2,23,196,2,28,23,193,
2,87,94,23,194,1,27,248,22,88,23,195,2,27,250,2,47,23,203,2,23,
204,1,248,22,97,23,199,1,28,249,22,139,7,23,196,2,2,28,249,22,77,
23,202,2,194,249,22,63,248,22,188,12,23,197,1,23,195,1,87,95,23,199,
23,202,2,194,249,22,63,248,22,132,13,23,197,1,23,195,1,87,95,23,199,
1,23,193,1,28,249,22,139,7,23,196,2,2,28,249,22,77,23,200,2,9,
249,22,63,248,22,188,12,23,197,1,9,28,249,22,139,7,23,196,2,2,28,
249,22,77,197,194,87,94,23,196,1,249,22,63,248,22,188,12,23,197,1,194,
249,22,63,248,22,132,13,23,197,1,9,28,249,22,139,7,23,196,2,2,28,
249,22,77,197,194,87,94,23,196,1,249,22,63,248,22,132,13,23,197,1,194,
87,94,23,193,1,28,249,22,139,7,23,198,2,2,28,249,22,77,195,9,87,
94,23,194,1,249,22,63,248,22,188,12,23,199,1,9,87,95,28,28,248,22,
94,23,194,1,249,22,63,248,22,132,13,23,199,1,9,87,95,28,28,248,22,
133,7,194,10,248,22,145,6,194,12,250,22,180,8,2,14,6,21,21,98,121,
116,101,32,115,116,114,105,110,103,32,111,114,32,115,116,114,105,110,103,196,28,
28,248,22,72,195,249,22,4,22,179,12,196,11,12,250,22,180,8,2,14,6,
28,248,22,72,195,249,22,4,22,187,12,196,11,12,250,22,180,8,2,14,6,
13,13,108,105,115,116,32,111,102,32,112,97,116,104,115,197,250,2,47,197,195,
28,248,22,145,6,197,248,22,156,7,197,196,32,50,89,162,8,44,39,57,2,
19,222,33,53,32,51,89,162,8,44,38,54,70,102,111,117,110,100,45,101,120,
101,99,222,33,52,28,23,193,2,91,159,38,11,90,161,38,35,11,248,22,136,
13,23,199,2,87,95,23,195,1,23,194,1,27,28,23,198,2,27,248,22,141,
13,23,201,2,28,249,22,152,8,23,195,2,23,202,2,11,28,248,22,137,13,
23,194,2,250,2,51,23,201,2,23,202,2,249,22,133,13,23,200,2,23,198,
101,99,222,33,52,28,23,193,2,91,159,38,11,90,161,38,35,11,248,22,144,
13,23,199,2,87,95,23,195,1,23,194,1,27,28,23,198,2,27,248,22,149,
13,23,201,2,28,249,22,152,8,23,195,2,23,202,2,11,28,248,22,145,13,
23,194,2,250,2,51,23,201,2,23,202,2,249,22,141,13,23,200,2,23,198,
1,250,2,51,23,201,2,23,202,2,23,196,1,11,28,23,193,2,192,87,94,
23,193,1,27,28,248,22,179,12,23,196,2,27,249,22,133,13,23,198,2,23,
201,2,28,28,248,22,128,13,193,10,248,22,191,12,193,192,11,11,28,23,193,
2,192,87,94,23,193,1,28,23,199,2,11,27,248,22,141,13,23,202,2,28,
249,22,152,8,23,195,2,23,203,1,11,28,248,22,137,13,23,194,2,250,2,
51,23,202,1,23,203,1,249,22,133,13,23,201,1,23,198,1,250,2,51,201,
202,195,194,28,248,22,71,23,197,2,11,27,248,22,140,13,248,22,64,23,199,
2,27,249,22,133,13,23,196,1,23,197,2,28,248,22,191,12,23,194,2,250,
23,193,1,27,28,248,22,187,12,23,196,2,27,249,22,141,13,23,198,2,23,
201,2,28,28,248,22,136,13,193,10,248,22,135,13,193,192,11,11,28,23,193,
2,192,87,94,23,193,1,28,23,199,2,11,27,248,22,149,13,23,202,2,28,
249,22,152,8,23,195,2,23,203,1,11,28,248,22,145,13,23,194,2,250,2,
51,23,202,1,23,203,1,249,22,141,13,23,201,1,23,198,1,250,2,51,201,
202,195,194,28,248,22,71,23,197,2,11,27,248,22,148,13,248,22,64,23,199,
2,27,249,22,141,13,23,196,1,23,197,2,28,248,22,135,13,23,194,2,250,
2,51,198,199,195,87,94,23,193,1,27,248,22,65,23,200,1,28,248,22,71,
23,194,2,11,27,248,22,140,13,248,22,64,23,196,2,27,249,22,133,13,23,
196,1,23,200,2,28,248,22,191,12,23,194,2,250,2,51,201,202,195,87,94,
23,194,2,11,27,248,22,148,13,248,22,64,23,196,2,27,249,22,141,13,23,
196,1,23,200,2,28,248,22,135,13,23,194,2,250,2,51,201,202,195,87,94,
23,193,1,27,248,22,65,23,197,1,28,248,22,71,23,194,2,11,27,248,22,
140,13,248,22,64,195,27,249,22,133,13,23,196,1,202,28,248,22,191,12,193,
148,13,248,22,64,195,27,249,22,141,13,23,196,1,202,28,248,22,135,13,193,
250,2,51,204,205,195,251,2,50,204,205,206,248,22,65,199,87,95,28,27,248,
22,179,12,23,196,2,28,23,193,2,192,87,94,23,193,1,28,248,22,145,6,
23,196,2,27,248,22,137,13,23,197,2,28,23,193,2,192,87,94,23,193,1,
248,22,138,13,23,197,2,11,12,250,22,180,8,2,15,6,25,25,112,97,116,
22,187,12,23,196,2,28,23,193,2,192,87,94,23,193,1,28,248,22,145,6,
23,196,2,27,248,22,145,13,23,197,2,28,23,193,2,192,87,94,23,193,1,
248,22,146,13,23,197,2,11,12,250,22,180,8,2,15,6,25,25,112,97,116,
104,32,111,114,32,115,116,114,105,110,103,32,40,115,97,110,115,32,110,117,108,
41,23,197,2,28,28,23,195,2,28,27,248,22,179,12,23,197,2,28,23,193,
2,192,87,94,23,193,1,28,248,22,145,6,23,197,2,27,248,22,137,13,23,
198,2,28,23,193,2,192,87,94,23,193,1,248,22,138,13,23,198,2,11,248,
22,137,13,23,196,2,11,10,12,250,22,180,8,2,15,6,29,29,35,102,32,
41,23,197,2,28,28,23,195,2,28,27,248,22,187,12,23,197,2,28,23,193,
2,192,87,94,23,193,1,28,248,22,145,6,23,197,2,27,248,22,145,13,23,
198,2,28,23,193,2,192,87,94,23,193,1,248,22,146,13,23,198,2,11,248,
22,145,13,23,196,2,11,10,12,250,22,180,8,2,15,6,29,29,35,102,32,
111,114,32,114,101,108,97,116,105,118,101,32,112,97,116,104,32,111,114,32,115,
116,114,105,110,103,23,198,2,28,28,248,22,137,13,23,195,2,91,159,38,11,
90,161,38,35,11,248,22,136,13,23,198,2,249,22,150,8,194,68,114,101,108,
116,114,105,110,103,23,198,2,28,28,248,22,145,13,23,195,2,91,159,38,11,
90,161,38,35,11,248,22,144,13,23,198,2,249,22,150,8,194,68,114,101,108,
97,116,105,118,101,11,27,248,22,162,7,6,4,4,80,65,84,72,251,2,50,
23,199,1,23,200,1,23,201,1,28,23,197,2,27,249,80,158,43,47,23,200,
1,9,28,249,22,150,8,247,22,164,7,2,21,249,22,63,248,22,188,12,5,
1,46,23,195,1,192,9,27,248,22,140,13,23,196,1,28,248,22,191,12,193,
1,9,28,249,22,150,8,247,22,164,7,2,21,249,22,63,248,22,132,13,5,
1,46,23,195,1,192,9,27,248,22,148,13,23,196,1,28,248,22,135,13,193,
250,2,51,198,199,195,11,250,80,158,38,48,196,197,11,250,80,158,38,48,196,
11,11,87,94,249,22,137,6,247,22,178,4,195,248,22,152,5,249,22,162,3,
35,249,22,146,3,197,198,27,28,23,197,2,87,95,23,196,1,23,195,1,23,
197,1,87,94,23,197,1,27,248,22,154,13,2,20,27,249,80,158,40,48,23,
197,1,87,94,23,197,1,27,248,22,162,13,2,20,27,249,80,158,40,48,23,
196,1,11,27,27,248,22,165,3,23,200,1,28,192,192,35,27,27,248,22,165,
3,23,202,1,28,192,192,35,249,22,131,5,23,197,1,83,158,39,20,97,95,
89,162,8,44,35,47,9,224,3,2,33,57,23,195,1,23,196,1,27,248,22,
@ -331,7 +331,7 @@
80,159,35,44,36,83,158,35,16,2,32,0,89,162,43,36,43,2,12,222,33,
44,80,159,35,45,36,83,158,35,16,2,83,158,38,20,96,95,2,13,89,162,
43,35,42,9,223,0,33,45,89,162,43,36,52,9,223,0,33,46,80,159,35,
46,36,83,158,35,16,2,27,248,22,161,13,248,22,156,7,27,28,249,22,150,
46,36,83,158,35,16,2,27,248,22,169,13,248,22,156,7,27,28,249,22,150,
8,247,22,164,7,2,21,6,1,1,59,6,1,1,58,250,22,129,7,6,14,
14,40,91,94,126,97,93,42,41,126,97,40,46,42,41,23,196,2,23,196,1,
89,162,8,44,37,47,2,14,223,0,33,49,80,159,35,47,36,83,158,35,16,
@ -343,12 +343,12 @@
EVAL_ONE_SIZED_STR((char *)expr, 5056);
}
{
static MZCOMPILED_STRING_FAR unsigned char expr[] = {35,126,7,52,46,48,46,49,46,51,8,0,0,0,1,0,0,6,0,19,0,
static MZCOMPILED_STRING_FAR unsigned char expr[] = {35,126,7,52,46,48,46,50,46,52,8,0,0,0,1,0,0,6,0,19,0,
34,0,48,0,62,0,76,0,111,0,0,0,241,0,0,0,65,113,117,111,116,
101,29,94,2,1,67,35,37,117,116,105,108,115,11,29,94,2,1,69,35,37,
110,101,116,119,111,114,107,11,29,94,2,1,68,35,37,112,97,114,97,109,122,
11,29,94,2,1,68,35,37,101,120,112,111,98,115,11,29,94,2,1,68,35,
37,107,101,114,110,101,108,11,98,10,35,11,8,184,218,97,159,2,2,35,35,
37,107,101,114,110,101,108,11,98,10,35,11,8,135,219,97,159,2,2,35,35,
159,2,3,35,35,159,2,4,35,35,159,2,5,35,35,159,2,6,35,35,16,
0,159,35,20,103,159,35,16,1,65,98,101,103,105,110,16,0,83,158,41,20,
100,137,69,35,37,98,117,105,108,116,105,110,29,11,11,10,10,18,96,11,42,
@ -360,7 +360,7 @@
EVAL_ONE_SIZED_STR((char *)expr, 278);
}
{
static MZCOMPILED_STRING_FAR unsigned char expr[] = {35,126,7,52,46,48,46,49,46,51,52,0,0,0,1,0,0,3,0,14,0,
static MZCOMPILED_STRING_FAR unsigned char expr[] = {35,126,7,52,46,48,46,50,46,52,52,0,0,0,1,0,0,3,0,14,0,
41,0,47,0,60,0,74,0,96,0,122,0,134,0,152,0,172,0,184,0,200,
0,223,0,3,1,8,1,13,1,18,1,23,1,54,1,58,1,66,1,74,1,
82,1,185,1,230,1,250,1,29,2,64,2,98,2,108,2,155,2,165,2,172,
@ -383,30 +383,30 @@
101,45,110,97,109,101,45,114,101,115,111,108,118,101,114,63,108,105,98,67,105,
103,110,111,114,101,100,249,22,14,195,80,158,37,45,249,80,159,37,48,36,195,
10,27,28,23,195,2,28,249,22,150,8,23,197,2,80,158,38,46,87,94,23,
195,1,80,158,36,47,27,248,22,161,4,23,197,2,28,248,22,179,12,23,194,
2,91,159,38,11,90,161,38,35,11,248,22,136,13,23,197,1,87,95,83,160,
195,1,80,158,36,47,27,248,22,161,4,23,197,2,28,248,22,187,12,23,194,
2,91,159,38,11,90,161,38,35,11,248,22,144,13,23,197,1,87,95,83,160,
37,11,80,158,40,46,198,83,160,37,11,80,158,40,47,192,192,11,11,28,23,
193,2,192,87,94,23,193,1,27,247,22,133,6,28,192,192,247,22,155,13,20,
193,2,192,87,94,23,193,1,27,247,22,133,6,28,192,192,247,22,163,13,20,
14,159,80,158,35,39,250,80,158,38,40,249,22,27,11,80,158,40,39,22,133,
6,28,248,22,179,12,23,198,2,23,197,1,87,94,23,197,1,247,22,155,13,
247,194,250,22,133,13,23,197,1,23,199,1,249,80,158,42,38,23,198,1,2,
18,252,22,133,13,23,199,1,23,201,1,6,6,6,110,97,116,105,118,101,247,
6,28,248,22,187,12,23,198,2,23,197,1,87,94,23,197,1,247,22,163,13,
247,194,250,22,141,13,23,197,1,23,199,1,249,80,158,42,38,23,198,1,2,
18,252,22,141,13,23,199,1,23,201,1,6,6,6,110,97,116,105,118,101,247,
22,165,7,249,80,158,44,38,23,200,1,80,158,44,35,87,94,23,194,1,27,
23,194,1,27,250,22,150,13,196,11,32,0,89,162,8,44,35,40,9,222,11,
28,192,249,22,63,195,194,11,27,248,23,195,1,23,196,1,27,250,22,150,13,
23,194,1,27,250,22,158,13,196,11,32,0,89,162,8,44,35,40,9,222,11,
28,192,249,22,63,195,194,11,27,248,23,195,1,23,196,1,27,250,22,158,13,
196,11,32,0,89,162,8,44,35,40,9,222,11,28,192,249,22,63,195,194,11,
249,247,22,160,13,248,22,64,195,195,27,250,22,133,13,23,198,1,23,200,1,
249,80,158,43,38,23,199,1,2,18,27,250,22,150,13,196,11,32,0,89,162,
249,247,22,168,13,248,22,64,195,195,27,250,22,141,13,23,198,1,23,200,1,
249,80,158,43,38,23,199,1,2,18,27,250,22,158,13,196,11,32,0,89,162,
8,44,35,40,9,222,11,28,192,249,22,63,195,194,11,249,247,22,131,6,248,
22,64,195,195,249,247,22,131,6,194,195,87,94,28,248,80,158,36,37,23,195,
2,12,250,22,180,8,77,108,111,97,100,47,117,115,101,45,99,111,109,112,105,
108,101,100,6,25,25,112,97,116,104,32,111,114,32,118,97,108,105,100,45,112,
97,116,104,32,115,116,114,105,110,103,23,197,2,91,159,41,11,90,161,36,35,
11,28,248,22,139,13,23,201,2,23,200,1,27,247,22,133,6,28,23,193,2,
249,22,140,13,23,203,1,23,195,1,200,90,161,38,36,11,248,22,136,13,23,
11,28,248,22,147,13,23,201,2,23,200,1,27,247,22,133,6,28,23,193,2,
249,22,148,13,23,203,1,23,195,1,200,90,161,38,36,11,248,22,144,13,23,
194,2,87,94,23,196,1,90,161,36,39,11,28,249,22,150,8,23,196,2,68,
114,101,108,97,116,105,118,101,87,94,23,194,1,2,17,23,194,1,90,161,36,
40,11,247,22,157,13,27,89,162,43,36,49,62,122,111,225,7,5,3,33,27,
40,11,247,22,165,13,27,89,162,43,36,49,62,122,111,225,7,5,3,33,27,
27,89,162,43,36,51,9,225,8,6,4,33,28,27,249,22,5,89,162,8,44,
36,47,9,223,5,33,29,23,203,2,27,28,23,195,2,27,249,22,5,83,158,
39,20,97,94,89,162,8,44,36,47,9,223,5,33,30,23,198,1,23,205,2,
@ -419,11 +419,11 @@
199,193,11,11,11,11,28,192,249,80,159,48,54,36,203,89,162,43,35,45,9,
224,15,2,33,33,249,80,159,48,54,36,203,89,162,43,35,44,9,224,15,7,
33,34,32,36,89,162,8,44,36,54,2,19,222,33,38,0,17,35,114,120,34,
94,40,46,42,63,41,47,40,46,42,41,36,34,27,249,22,165,13,2,37,23,
94,40,46,42,63,41,47,40,46,42,41,36,34,27,249,22,173,13,2,37,23,
196,2,28,23,193,2,87,94,23,194,1,249,22,63,248,22,88,23,196,2,27,
248,22,97,23,197,1,27,249,22,165,13,2,37,23,196,2,28,23,193,2,87,
248,22,97,23,197,1,27,249,22,173,13,2,37,23,196,2,28,23,193,2,87,
94,23,194,1,249,22,63,248,22,88,23,196,2,27,248,22,97,23,197,1,27,
249,22,165,13,2,37,23,196,2,28,23,193,2,87,94,23,194,1,249,22,63,
249,22,173,13,2,37,23,196,2,28,23,193,2,87,94,23,194,1,249,22,63,
248,22,88,23,196,2,248,2,36,248,22,97,23,197,1,248,22,73,194,248,22,
73,194,248,22,73,194,32,39,89,162,43,36,54,2,19,222,33,40,28,248,22,
71,248,22,65,23,195,2,249,22,7,9,248,22,64,195,91,159,37,11,90,161,
@ -437,80 +437,80 @@
2,39,193,87,95,28,248,22,159,4,195,12,250,22,180,8,2,20,6,20,20,
114,101,115,111,108,118,101,100,45,109,111,100,117,108,101,45,112,97,116,104,197,
28,24,193,2,248,24,194,1,195,87,94,23,193,1,12,27,27,250,22,133,2,
80,158,41,42,248,22,185,13,247,22,162,11,11,28,23,193,2,192,87,94,23,
193,1,27,247,22,121,87,94,250,22,131,2,80,158,42,42,248,22,185,13,247,
22,162,11,195,192,250,22,131,2,195,198,66,97,116,116,97,99,104,251,211,197,
80,158,41,42,248,22,129,14,247,22,170,11,11,28,23,193,2,192,87,94,23,
193,1,27,247,22,121,87,94,250,22,131,2,80,158,42,42,248,22,129,14,247,
22,170,11,195,192,250,22,131,2,195,198,66,97,116,116,97,99,104,251,211,197,
198,199,10,28,192,250,22,179,8,11,196,195,248,22,177,8,194,28,249,22,151,
6,194,6,1,1,46,2,17,28,249,22,151,6,194,6,2,2,46,46,62,117,
112,192,28,249,22,152,8,248,22,65,23,200,2,23,197,1,28,249,22,150,8,
248,22,64,23,200,2,23,196,1,251,22,177,8,2,20,6,26,26,99,121,99,
108,101,32,105,110,32,108,111,97,100,105,110,103,32,97,116,32,126,101,58,32,
126,101,23,200,1,249,22,2,22,65,248,22,78,249,22,63,23,206,1,23,202,
1,12,12,247,192,20,14,159,80,158,39,44,249,22,63,247,22,162,11,23,197,
1,12,12,247,192,20,14,159,80,158,39,44,249,22,63,247,22,170,11,23,197,
1,20,14,159,80,158,39,39,250,80,158,42,40,249,22,27,11,80,158,44,39,
22,142,4,23,196,1,249,247,22,132,6,23,198,1,248,22,52,248,22,183,12,
23,198,1,87,94,28,28,248,22,179,12,23,197,2,10,248,22,164,4,23,197,
22,142,4,23,196,1,249,247,22,132,6,23,198,1,248,22,52,248,22,191,12,
23,198,1,87,94,28,28,248,22,187,12,23,197,2,10,248,22,164,4,23,197,
2,12,28,23,198,2,250,22,179,8,11,6,15,15,98,97,100,32,109,111,100,
117,108,101,32,112,97,116,104,23,201,2,250,22,180,8,2,20,6,19,19,109,
111,100,117,108,101,45,112,97,116,104,32,111,114,32,112,97,116,104,23,199,2,
28,28,248,22,61,23,197,2,249,22,150,8,248,22,64,23,199,2,2,4,11,
248,22,160,4,248,22,88,197,28,28,248,22,61,23,197,2,249,22,150,8,248,
22,64,23,199,2,66,112,108,97,110,101,116,11,87,94,28,207,12,20,14,159,
80,158,37,39,250,80,158,40,40,249,22,27,11,80,158,42,39,22,162,11,23,
80,158,37,39,250,80,158,40,40,249,22,27,11,80,158,42,39,22,170,11,23,
197,1,90,161,36,35,10,249,22,143,4,21,94,2,21,6,18,18,112,108,97,
110,101,116,47,114,101,115,111,108,118,101,114,46,115,115,1,27,112,108,97,110,
101,116,45,109,111,100,117,108,101,45,110,97,109,101,45,114,101,115,111,108,118,
101,114,12,251,211,199,200,201,202,87,94,23,193,1,27,89,162,8,44,36,45,
79,115,104,111,119,45,99,111,108,108,101,99,116,105,111,110,45,101,114,114,223,
6,33,44,27,28,248,22,51,23,199,2,27,250,22,133,2,80,158,43,43,249,
22,63,23,204,2,247,22,156,13,11,28,23,193,2,192,87,94,23,193,1,91,
22,63,23,204,2,247,22,164,13,11,28,23,193,2,192,87,94,23,193,1,91,
159,37,11,90,161,37,35,11,249,80,159,44,48,36,248,22,54,23,204,2,11,
27,251,80,158,47,50,2,20,23,202,1,28,248,22,71,23,199,2,23,199,2,
248,22,64,23,199,2,28,248,22,71,23,199,2,9,248,22,65,23,199,2,249,
22,133,13,23,195,1,28,248,22,71,23,197,1,87,94,23,197,1,6,7,7,
22,141,13,23,195,1,28,248,22,71,23,197,1,87,94,23,197,1,6,7,7,
109,97,105,110,46,115,115,249,22,168,6,23,199,1,6,3,3,46,115,115,28,
248,22,145,6,23,199,2,87,94,23,194,1,27,248,80,159,41,55,36,23,201,
2,27,250,22,133,2,80,158,44,43,249,22,63,23,205,2,23,199,2,11,28,
23,193,2,192,87,94,23,193,1,91,159,37,11,90,161,37,35,11,249,80,159,
45,48,36,23,204,2,11,250,22,1,22,133,13,23,199,1,249,22,77,249,22,
45,48,36,23,204,2,11,250,22,1,22,141,13,23,199,1,249,22,77,249,22,
2,32,0,89,162,8,44,36,43,9,222,33,45,23,200,1,248,22,73,23,200,
1,28,248,22,179,12,23,199,2,87,94,23,194,1,28,248,22,138,13,23,199,
1,28,248,22,187,12,23,199,2,87,94,23,194,1,28,248,22,146,13,23,199,
2,23,198,2,248,22,73,6,26,26,32,40,97,32,112,97,116,104,32,109,117,
115,116,32,98,101,32,97,98,115,111,108,117,116,101,41,28,249,22,150,8,248,
22,64,23,201,2,2,21,27,250,22,133,2,80,158,43,43,249,22,63,23,204,
2,247,22,156,13,11,28,23,193,2,192,87,94,23,193,1,91,159,38,11,90,
2,247,22,164,13,11,28,23,193,2,192,87,94,23,193,1,91,159,38,11,90,
161,37,35,11,249,80,159,45,48,36,248,22,88,23,205,2,11,90,161,36,37,
11,28,248,22,71,248,22,90,23,204,2,28,248,22,71,23,194,2,249,22,167,
11,28,248,22,71,248,22,90,23,204,2,28,248,22,71,23,194,2,249,22,175,
13,0,8,35,114,120,34,91,46,93,34,23,196,2,11,10,27,27,28,23,197,
2,249,22,77,28,248,22,71,248,22,90,23,208,2,21,93,6,5,5,109,122,
108,105,98,249,22,1,22,77,249,22,2,80,159,51,56,36,248,22,90,23,211,
2,23,197,2,28,248,22,71,23,196,2,248,22,73,23,197,2,23,195,2,251,
80,158,49,50,2,20,23,204,1,248,22,64,23,198,2,248,22,65,23,198,1,
249,22,133,13,23,195,1,28,23,198,1,87,94,23,196,1,23,197,1,28,248,
249,22,141,13,23,195,1,28,23,198,1,87,94,23,196,1,23,197,1,28,248,
22,71,23,197,1,87,94,23,197,1,6,7,7,109,97,105,110,46,115,115,28,
249,22,167,13,0,8,35,114,120,34,91,46,93,34,23,199,2,23,197,1,249,
249,22,175,13,0,8,35,114,120,34,91,46,93,34,23,199,2,23,197,1,249,
22,168,6,23,199,1,6,3,3,46,115,115,28,249,22,150,8,248,22,64,23,
201,2,64,102,105,108,101,249,22,140,13,248,22,144,13,248,22,88,23,202,2,
248,80,159,42,55,36,23,202,2,12,87,94,28,28,248,22,179,12,23,194,2,
201,2,64,102,105,108,101,249,22,148,13,248,22,152,13,248,22,88,23,202,2,
248,80,159,42,55,36,23,202,2,12,87,94,28,28,248,22,187,12,23,194,2,
10,248,22,167,7,23,194,2,87,94,23,200,1,12,28,23,200,2,250,22,179,
8,67,114,101,113,117,105,114,101,249,22,129,7,6,17,17,98,97,100,32,109,
111,100,117,108,101,32,112,97,116,104,126,97,28,23,198,2,248,22,64,23,199,
2,6,0,0,23,203,1,87,94,23,200,1,250,22,180,8,2,20,249,22,129,
7,6,13,13,109,111,100,117,108,101,32,112,97,116,104,126,97,28,23,198,2,
248,22,64,23,199,2,6,0,0,23,201,2,27,28,248,22,167,7,23,195,2,
249,22,172,7,23,196,2,35,249,22,142,13,248,22,143,13,23,197,2,11,27,
249,22,172,7,23,196,2,35,249,22,150,13,248,22,151,13,23,197,2,11,27,
28,248,22,167,7,23,196,2,249,22,172,7,23,197,2,36,248,80,158,42,51,
23,195,2,91,159,38,11,90,161,38,35,11,28,248,22,167,7,23,199,2,250,
22,7,2,22,249,22,172,7,23,203,2,37,2,22,248,22,136,13,23,198,2,
22,7,2,22,249,22,172,7,23,203,2,37,2,22,248,22,144,13,23,198,2,
87,95,23,195,1,23,193,1,27,28,248,22,167,7,23,200,2,249,22,172,7,
23,201,2,38,249,80,158,47,52,23,197,2,5,0,27,28,248,22,167,7,23,
201,2,249,22,172,7,23,202,2,39,248,22,160,4,23,200,2,27,27,250,22,
133,2,80,158,51,42,248,22,185,13,247,22,162,11,11,28,23,193,2,192,87,
94,23,193,1,27,247,22,121,87,94,250,22,131,2,80,158,52,42,248,22,185,
13,247,22,162,11,195,192,87,95,28,23,209,1,27,250,22,133,2,23,197,2,
133,2,80,158,51,42,248,22,129,14,247,22,170,11,11,28,23,193,2,192,87,
94,23,193,1,27,247,22,121,87,94,250,22,131,2,80,158,52,42,248,22,129,
14,247,22,170,11,195,192,87,95,28,23,209,1,27,250,22,133,2,23,197,2,
197,11,28,23,193,1,12,87,95,27,27,28,248,22,17,80,158,51,45,80,158,
50,45,247,22,19,250,22,25,248,22,23,23,197,2,80,158,53,44,23,196,1,
27,247,22,162,11,249,22,3,83,158,39,20,97,94,89,162,8,44,36,54,9,
27,247,22,170,11,249,22,3,83,158,39,20,97,94,89,162,8,44,36,54,9,
226,12,11,2,3,33,46,23,195,1,23,196,1,248,28,248,22,17,80,158,50,
45,32,0,89,162,43,36,41,9,222,33,47,80,159,49,57,36,89,162,43,35,
50,9,227,14,9,8,4,3,33,48,250,22,131,2,23,197,1,197,10,12,28,
@ -518,12 +518,12 @@
248,22,61,23,208,2,249,22,150,8,248,22,64,23,210,2,2,21,11,250,22,
131,2,80,158,50,43,28,248,22,145,6,23,210,2,249,22,63,23,211,1,248,
80,159,53,55,36,23,213,1,87,94,23,210,1,249,22,63,23,211,1,247,22,
156,13,252,22,169,7,23,208,1,23,207,1,23,205,1,23,203,1,201,12,193,
164,13,252,22,169,7,23,208,1,23,207,1,23,205,1,23,203,1,201,12,193,
91,159,37,10,90,161,36,35,10,11,90,161,36,36,10,83,158,38,20,96,96,
2,20,89,162,8,44,36,50,9,224,2,0,33,42,89,162,43,38,48,9,223,
1,33,43,89,162,43,39,8,30,9,225,2,3,0,33,49,208,87,95,248,22,
141,4,248,80,158,37,49,247,22,162,11,248,22,132,6,80,158,36,36,248,22,
153,12,80,159,36,41,36,159,35,20,103,159,35,16,1,65,98,101,103,105,110,
141,4,248,80,158,37,49,247,22,170,11,248,22,132,6,80,158,36,36,248,22,
161,12,80,159,36,41,36,159,35,20,103,159,35,16,1,65,98,101,103,105,110,
16,0,83,158,41,20,100,137,66,35,37,98,111,111,116,2,1,11,10,10,36,
80,158,35,35,20,103,159,39,16,19,30,2,1,2,2,193,30,2,1,2,3,
193,30,2,5,72,112,97,116,104,45,115,116,114,105,110,103,63,10,30,2,5,

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

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

@ -28,6 +28,10 @@
#ifdef DOS_FILE_SYSTEM
# include <windows.h>
#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 TMP_CMARK_VALUE scheme_parameterization_key
@ -40,6 +44,8 @@ void (*scheme_console_output)(char *str, long len);
Scheme_Exit_Proc scheme_exit;
void scheme_set_exit(Scheme_Exit_Proc p) { scheme_exit = p; }
Scheme_Logger *scheme_main_logger;
#ifdef MEMORY_COUNTING_ON
long scheme_misc_count;
#endif
@ -64,10 +70,23 @@ static Scheme_Object *emergency_error_display_proc(int, Scheme_Object *[]);
static Scheme_Object *def_error_value_string_proc(int, Scheme_Object *[]);
static Scheme_Object *def_exit_handler_proc(int, Scheme_Object *[]);
static Scheme_Object *log_message(int argc, Scheme_Object *argv[]);
static Scheme_Object *log_level_p(int argc, Scheme_Object *argv[]);
static Scheme_Object *make_logger(int argc, Scheme_Object *argv[]);
static Scheme_Object *logger_p(int argc, Scheme_Object *argv[]);
static Scheme_Object *current_logger(int argc, Scheme_Object *argv[]);
static Scheme_Object *logger_name(int argc, Scheme_Object *argv[]);
static Scheme_Object *make_log_reader(int argc, Scheme_Object *argv[]);
static Scheme_Object *log_reader_p(int argc, Scheme_Object *argv[]);
static int log_reader_get(Scheme_Object *ch, Scheme_Schedule_Info *sinfo);
static Scheme_Object *do_raise(Scheme_Object *arg, int need_debug, int barrier);
static Scheme_Object *nested_exn_handler(void *old_exn, int argc, Scheme_Object *argv[]);
static Scheme_Logger *make_a_logger(Scheme_Logger *parent, Scheme_Object *name);
static void update_want_level(Scheme_Logger *logger);
static Scheme_Object *def_err_val_proc;
static Scheme_Object *def_error_esc_proc;
static Scheme_Object *default_display_handler, *emergency_display_handler;
@ -82,6 +101,19 @@ static char *init_buf(long *len, long *blen);
static char *prepared_buf;
static long prepared_buf_len;
static Scheme_Object *fatal_symbol, *error_symbol, *warning_symbol, *info_symbol, *debug_symbol;
#ifndef INIT_SYSLOG_LEVEL
# define INIT_SYSLOG_LEVEL 0
#endif
static int init_syslog_level = INIT_SYSLOG_LEVEL, init_stderr_level = SCHEME_LOG_ERROR;
void scheme_set_logging(int syslog_level, int stderr_level)
{
if (syslog_level > -1)
init_syslog_level = syslog_level;
if (stderr_level > -1)
init_stderr_level = stderr_level;
}
typedef struct {
int args;
Scheme_Object *type;
@ -563,6 +595,49 @@ void scheme_init_error(Scheme_Env *env)
0, 1),
env);
scheme_add_global_constant("log-message",
scheme_make_prim_w_arity(log_message,
"log-message",
4, 4),
env);
scheme_add_global_constant("log-level?",
scheme_make_noncm_prim(log_level_p,
"log-level?",
2, 2),
env);
scheme_add_global_constant("make-logger",
scheme_make_noncm_prim(make_logger,
"make-logger",
1, 2),
env);
scheme_add_global_constant("logger?",
scheme_make_folding_prim(logger_p,
"logger?",
1, 1, 1),
env);
scheme_add_global_constant("logger-name",
scheme_make_folding_prim(logger_name,
"logger-name",
1, 1, 1),
env);
scheme_add_global_constant("make-log-receiver",
scheme_make_noncm_prim(make_log_reader,
"make-log-receiver",
2, 2),
env);
scheme_add_global_constant("log-receiver?",
scheme_make_folding_prim(log_reader_p,
"log-receiver?",
1, 1, 1),
env);
scheme_add_global_constant("current-logger",
scheme_register_parameter(current_logger,
"current-logger",
MZCONFIG_LOGGER),
env);
scheme_add_evt(scheme_log_reader_type, (Scheme_Ready_Fun)log_reader_get, NULL, NULL, 1);
REGISTER_SO(scheme_def_exit_proc);
scheme_def_exit_proc = scheme_make_prim_w_arity(def_exit_handler_proc,
"default-exit-handler",
@ -577,6 +652,25 @@ void scheme_init_error(Scheme_Env *env)
prepared_buf = "";
prepared_buf = init_buf(NULL, &prepared_buf_len);
REGISTER_SO(fatal_symbol);
REGISTER_SO(error_symbol);
REGISTER_SO(warning_symbol);
REGISTER_SO(info_symbol);
REGISTER_SO(debug_symbol);
fatal_symbol = scheme_intern_symbol("fatal");
error_symbol = scheme_intern_symbol("error");
warning_symbol = scheme_intern_symbol("warning");
info_symbol = scheme_intern_symbol("info");
debug_symbol = scheme_intern_symbol("debug");
{
REGISTER_SO(scheme_main_logger);
scheme_main_logger = make_a_logger(NULL, NULL);
scheme_main_logger->syslog_level = init_syslog_level;
scheme_main_logger->stderr_level = init_stderr_level;
scheme_set_root_param(MZCONFIG_LOGGER, (Scheme_Object *)scheme_main_logger);
}
REGISTER_SO(arity_property);
{
Scheme_Object *guard;
@ -631,8 +725,15 @@ scheme_inescapeable_error(const char *a, const char *b)
static void
call_error(char *buffer, int len, Scheme_Object *exn)
{
if (scheme_current_thread->skip_error) {
scheme_longjmp (scheme_error_buf, 1);
if (scheme_current_thread->constant_folding) {
if (SCHEME_TRUEP(scheme_current_thread->constant_folding))
scheme_log(NULL,
SCHEME_LOG_WARNING,
0,
"optimizer constant-fold attempt failed%s: %s",
scheme_optimize_context_to_string(scheme_current_thread->constant_folding),
buffer);
scheme_longjmp(scheme_error_buf, 1);
} else {
mz_jmp_buf savebuf;
Scheme_Object *p[2], *display_handler, *escape_handler, *v;
@ -803,6 +904,47 @@ void scheme_warning(char *msg, ...)
scheme_get_param(scheme_current_config(), MZCONFIG_ERROR_PORT));
}
void scheme_log(Scheme_Logger *logger, int level, int flags,
char *msg, ...)
{
GC_CAN_IGNORE va_list args;
char *buffer;
long len;
if (logger) {
if (logger->local_timestamp == *logger->timestamp)
if (logger->want_level < level)
return;
}
/* Precise GC: Don't allocate before getting hidden args off stack */
buffer = prepared_buf;
HIDE_FROM_XFORM(va_start(args, msg));
len = sch_vsprintf(buffer, prepared_buf_len, msg, args);
HIDE_FROM_XFORM(va_end(args));
prepared_buf = init_buf(NULL, &prepared_buf_len);
buffer[len] = 0;
scheme_log_message(logger, level, buffer, len, NULL);
}
int scheme_log_level_p(Scheme_Logger *logger, int level)
{
if (!logger) {
Scheme_Config *config;
config = scheme_current_config();
logger = (Scheme_Logger *)scheme_get_param(config, MZCONFIG_LOGGER);
}
if (logger->local_timestamp < *logger->timestamp)
update_want_level(logger);
return (logger->want_level >= level);
}
static char *error_write_to_string_w_max(Scheme_Object *v, int len, int *lenout)
{
Scheme_Object *o, *args[2];
@ -2203,6 +2345,36 @@ static Scheme_Object *error_print_srcloc(int argc, Scheme_Object *argv[])
-1, NULL, NULL, 1);
}
void scheme_write_proc_context(Scheme_Object *port, int print_width,
Scheme_Object *name,
Scheme_Object *src, Scheme_Object *line,
Scheme_Object *col, Scheme_Object *pos,
int generated)
{
if (src) {
scheme_display_w_max(src, port, print_width);
if (line && SCHEME_TRUEP(line)) {
/* Line + column */
scheme_write_byte_string(":", 1, port);
scheme_display_w_max(line, port, print_width);
scheme_write_byte_string(":", 1, port);
scheme_display_w_max(col, port, print_width);
} else {
/* Position */
scheme_write_byte_string("::", 2, port);
scheme_display_w_max(pos, port, print_width);
}
if (SCHEME_TRUEP(name)) {
scheme_write_byte_string(": ", 2, port);
}
}
if (SCHEME_TRUEP(name)) {
scheme_display_w_max(name, port, print_width);
}
}
static Scheme_Object *
def_error_display_proc(int argc, Scheme_Object *argv[])
{
@ -2262,27 +2434,18 @@ def_error_display_proc(int argc, Scheme_Object *argv[])
if (SCHEME_TRUEP(loc)) {
Scheme_Structure *sloc = (Scheme_Structure *)loc;
scheme_display_w_max(sloc->slots[0], port, print_width);
if (SCHEME_TRUEP(sloc->slots[1])) {
/* Line + column */
scheme_write_byte_string(":", 1, port);
scheme_display_w_max(sloc->slots[1], port, print_width);
scheme_write_byte_string(":", 1, port);
scheme_display_w_max(sloc->slots[2], port, print_width);
scheme_write_proc_context(port, print_width,
name,
sloc->slots[0], sloc->slots[1],
sloc->slots[2], sloc->slots[3],
0);
} else {
/* Position */
scheme_write_byte_string("::", 2, port);
scheme_display_w_max(sloc->slots[3], port, print_width);
scheme_write_proc_context(port, print_width,
name,
NULL, NULL, NULL, NULL,
0);
}
if (SCHEME_TRUEP(name)) {
scheme_write_byte_string(": ", 2, port);
}
}
if (SCHEME_TRUEP(name)) {
scheme_display_w_max(name, port, print_width);
}
scheme_write_byte_string("\n", 1, port);
l = SCHEME_CDR(l);
--max_cnt;
@ -2480,6 +2643,456 @@ void scheme_immediate_exit(int status)
/***********************************************************************/
void update_want_level(Scheme_Logger *logger)
{
Scheme_Log_Reader *lr;
Scheme_Object *stack = NULL, *queue, *b, *prev;
Scheme_Logger *parent = logger;
int want_level;
while (parent) {
stack = scheme_make_raw_pair((Scheme_Object *)parent, stack);
if (parent->local_timestamp < *parent->timestamp)
parent = parent->parent;
else
parent = NULL;
}
want_level = 0;
while (stack) {
parent = (Scheme_Logger *)SCHEME_CAR(stack);
if (parent->local_timestamp < *parent->timestamp) {
queue = parent->readers;
prev = NULL;
while (queue) {
b = SCHEME_CAR(queue);
lr = (Scheme_Log_Reader *)SCHEME_BOX_VAL(b);
if (lr) {
if (lr->want_level > want_level)
want_level = lr->want_level;
} else {
if (prev)
SCHEME_CDR(prev) = SCHEME_CDR(queue);
else
parent->readers = SCHEME_CDR(queue);
}
queue = SCHEME_CDR(queue);
}
if (parent->syslog_level > want_level)
want_level = parent->syslog_level;
if (parent->stderr_level > want_level)
want_level = parent->stderr_level;
parent->want_level = want_level;
parent->local_timestamp = *parent->timestamp;
} else {
want_level = parent->want_level;
}
stack = SCHEME_CDR(stack);
}
}
#ifdef USE_WINDOWS_EVENT_LOG
static int event_procs_ready;
typedef HANDLE (WINAPI *mzRegisterEventSourceProc)(LPCTSTR lpUNCServerName, LPCTSTR lpSourceName);
typedef BOOL (WINAPI *mzReportEventProc)(HANDLE hEventLog, WORD wType, WORD wCategory, DWORD dwEventID,
PSID lpUserSid, WORD wNumStrings, DWORD dwDataSize, LPCTSTR* lpStrings,
LPVOID lpRawData);
static mzRegisterEventSourceProc mzRegisterEventSource;
static mzReportEventProc mzReportEvent;
#endif
void scheme_log_message(Scheme_Logger *logger, int level, char *buffer, long len, Scheme_Object *data)
{
Scheme_Logger *orig_logger;
Scheme_Object *queue, *q, *msg = NULL, *b;
Scheme_Log_Reader *lr;
if (!logger) {
Scheme_Config *config;
config = scheme_current_config();
logger = (Scheme_Logger *)scheme_get_param(config, MZCONFIG_LOGGER);
}
if (logger->local_timestamp < *logger->timestamp)
update_want_level(logger);
orig_logger = logger;
while (logger) {
if (logger->want_level < level)
return;
if (logger->syslog_level >= level) {
#ifdef USE_C_SYSLOG
int pri;
switch (level) {
case SCHEME_LOG_FATAL:
pri = LOG_CRIT;
break;
case SCHEME_LOG_ERROR:
pri = LOG_ERR;
break;
case SCHEME_LOG_WARNING:
pri = LOG_WARNING;
break;
case SCHEME_LOG_INFO:
pri = LOG_INFO;
break;
case SCHEME_LOG_DEBUG:
default:
pri = LOG_DEBUG;
break;
}
if (orig_logger->name)
syslog(pri, "%s: %s", SCHEME_SYM_VAL(orig_logger->name), buffer);
else
syslog(pri, "%s", buffer);
#endif
#ifdef USE_WINDOWS_EVENT_LOG
if (!event_procs_ready) {
HMODULE hm;
hm = LoadLibrary("advapi32.dll");
if (hm) {
mzRegisterEventSource = (mzRegisterEventSourceProc)GetProcAddress(hm, "RegisterEventSourceA");
mzReportEvent = (mzReportEventProc)GetProcAddress(hm, "ReportEventA");
}
event_procs_ready = 1;
}
if (mzRegisterEventSource) {
static HANDLE hEventLog;
WORD ty;
unsigned long sev;
LPCTSTR a[1];
if (!hEventLog) {
Scheme_Object *cmd;
cmd = scheme_get_run_cmd();
hEventLog = mzRegisterEventSource(NULL, SCHEME_PATH_VAL(cmd));
}
switch (level) {
case SCHEME_LOG_FATAL:
ty = EVENTLOG_ERROR_TYPE;
sev = 3;
break;
case SCHEME_LOG_ERROR:
ty = EVENTLOG_ERROR_TYPE;
sev = 3;
break;
case SCHEME_LOG_WARNING:
ty = EVENTLOG_WARNING_TYPE;
sev = 2;
break;
case SCHEME_LOG_INFO:
ty = EVENTLOG_INFORMATION_TYPE;
sev = 1;
break;
case SCHEME_LOG_DEBUG:
default:
ty = EVENTLOG_AUDIT_SUCCESS;
sev = 0;
break;
}
if (orig_logger->name) {
char *naya;
long slen;
slen = SCHEME_SYM_LEN(orig_logger->name);
naya = (char *)scheme_malloc_atomic(slen + 2 + len + 1);
memcpy(naya, SCHEME_SYM_VAL(orig_logger->name), slen);
memcpy(naya + slen, ": ", 2);
memcpy(naya + slen + 2, buffer, len);
naya[slen + 2 + len] = 0;
buffer = naya;
len += slen + 2;
}
a[0] = buffer;
mzReportEvent(hEventLog, ty, 1 /* category */,
(sev << 30) | 2 /* message */,
NULL,
1, 0,
a, NULL);
}
#endif
}
if (logger->stderr_level >= level) {
if (orig_logger->name) {
long slen;
slen = SCHEME_SYM_LEN(orig_logger->name);
fwrite(SCHEME_SYM_VAL(orig_logger->name), slen, 1, stderr);
fwrite(": ", 2, 1, stderr);
}
fwrite(buffer, len, 1, stderr);
fwrite("\n", 1, 1, stderr);
}
queue = logger->readers;
while (queue) {
b = SCHEME_CAR(queue);
lr = (Scheme_Log_Reader *)SCHEME_BOX_VAL(b);
if (lr) {
if (lr->want_level >= level) {
if (!msg) {
Scheme_Object *v;
msg = scheme_make_vector(3, NULL);
switch (level) {
case SCHEME_LOG_FATAL:
v = fatal_symbol;
break;
case SCHEME_LOG_ERROR:
v = error_symbol;
break;
case SCHEME_LOG_WARNING:
v = warning_symbol;
break;
case SCHEME_LOG_INFO:
v = info_symbol;
break;
case SCHEME_LOG_DEBUG:
default:
v = debug_symbol;
break;
}
SCHEME_VEC_ELS(msg)[0] = v;
if (orig_logger->name) {
/* Add logger name prefix: */
long slen;
char *cp;
slen = SCHEME_SYM_LEN(orig_logger->name);
cp = scheme_malloc_atomic(slen + len + 2);
memcpy(cp, SCHEME_SYM_VAL(orig_logger->name), slen);
memcpy(cp + slen, ": ", 2);
memcpy(cp + slen + 2, buffer, len + 1);
len += slen + 2;
buffer = cp;
}
v = scheme_make_sized_utf8_string(buffer, len);
SCHEME_SET_CHAR_STRING_IMMUTABLE(v);
SCHEME_VEC_ELS(msg)[1] = v;
SCHEME_VEC_ELS(msg)[2] = (data ? data : scheme_false);
}
if (!lr->tail
&& scheme_try_channel_put(lr->ch, msg)) {
/* delivered immediately */
} else {
/* enqueue */
q = scheme_make_raw_pair(msg, NULL);
if (lr->tail)
SCHEME_CDR(lr->tail) = q;
else
lr->head = q;
lr->tail = q;
}
}
}
queue = SCHEME_CDR(queue);
}
logger = logger->parent;
}
}
static int extract_level(const char *who, int which, int argc, Scheme_Object **argv)
{
Scheme_Object *v;
int level;
v = argv[which];
if (SAME_OBJ(v, fatal_symbol))
level = SCHEME_LOG_FATAL;
else if (SAME_OBJ(v, error_symbol))
level = SCHEME_LOG_ERROR;
else if (SAME_OBJ(v, warning_symbol))
level = SCHEME_LOG_WARNING;
else if (SAME_OBJ(v, info_symbol))
level = SCHEME_LOG_INFO;
else if (SAME_OBJ(v, debug_symbol))
level = SCHEME_LOG_DEBUG;
else {
scheme_wrong_type(who, "'fatal, 'error, 'warning, 'info, or 'debug", which, argc, argv);
return 0;
}
return level;
}
static Scheme_Object *
log_message(int argc, Scheme_Object *argv[])
{
Scheme_Logger *logger;
Scheme_Object *bytes;
int level;
if (!SAME_TYPE(SCHEME_TYPE(argv[0]), scheme_logger_type))
scheme_wrong_type("log-message", "logger", 0, argc, argv);
logger = (Scheme_Logger *)argv[0];
level = extract_level("log-message", 1, argc, argv);
bytes = argv[2];
if (!SCHEME_CHAR_STRINGP(bytes))
scheme_wrong_type("log-message", "string", 2, argc, argv);
bytes = scheme_char_string_to_byte_string(bytes);
scheme_log_message(logger, level, SCHEME_BYTE_STR_VAL(bytes), SCHEME_BYTE_STRLEN_VAL(bytes), argv[3]);
return scheme_void;
}
static Scheme_Object *
log_level_p(int argc, Scheme_Object *argv[])
{
Scheme_Logger *logger;
int level;
if (!SAME_TYPE(SCHEME_TYPE(argv[0]), scheme_logger_type))
scheme_wrong_type("log-level?", "logger", 0, argc, argv);
logger = (Scheme_Logger *)argv[0];
level = extract_level("log-level?", 1, argc, argv);
if (logger->local_timestamp < *logger->timestamp)
update_want_level(logger);
return ((logger->want_level >= level) ? scheme_true : scheme_false);
}
static Scheme_Object *
make_logger(int argc, Scheme_Object *argv[])
{
Scheme_Logger *parent;
if (argc) {
if (!SCHEME_FALSEP(argv[0]) && !SCHEME_SYMBOLP(argv[0]))
scheme_wrong_type("make-logger", "symbol or #f", 0, argc, argv);
if (argc > 1) {
if (SCHEME_FALSEP(argv[1]))
parent = NULL;
else {
if (!SAME_TYPE(SCHEME_TYPE(argv[1]), scheme_logger_type))
scheme_wrong_type("make-logger", "logger or #f", 1, argc, argv);
parent = (Scheme_Logger *)argv[1];
}
} else
parent = NULL;
} else
parent = NULL;
return (Scheme_Object *)make_a_logger(parent,
(argc
? (SCHEME_FALSEP(argv[1]) ? NULL : argv[1])
: NULL));
}
static Scheme_Logger *make_a_logger(Scheme_Logger *parent, Scheme_Object *name)
{
Scheme_Logger *logger;
logger = MALLOC_ONE_TAGGED(Scheme_Logger);
logger->so.type = scheme_logger_type;
logger->parent = parent;
if (parent) {
logger->timestamp = parent->timestamp;
} else {
long *timestamp;
timestamp = MALLOC_ONE_ATOMIC(long);
*timestamp = 1;
logger->timestamp = timestamp;
}
logger->name = name;
return logger;
}
static Scheme_Object *
logger_p(int argc, Scheme_Object *argv[])
{
return (SAME_TYPE(SCHEME_TYPE(argv[0]), scheme_logger_type)
? scheme_true
: scheme_false);
}
static Scheme_Object *
current_logger(int argc, Scheme_Object *argv[])
{
return scheme_param_config("current-logger",
scheme_make_integer(MZCONFIG_LOGGER),
argc, argv,
-1, logger_p, "logger", 0);
}
static Scheme_Object *
logger_name(int argc, Scheme_Object *argv[])
{
if (!SAME_TYPE(SCHEME_TYPE(argv[0]), scheme_logger_type))
scheme_wrong_type("logger-name", "logger", 0, argc, argv);
return ((Scheme_Logger *)argv[0])->name;
}
static Scheme_Object *
make_log_reader(int argc, Scheme_Object *argv[])
{
Scheme_Logger *logger;
Scheme_Log_Reader *lr;
Scheme_Object *ch, *q;
int level;
if (!SAME_TYPE(SCHEME_TYPE(argv[0]), scheme_logger_type))
scheme_wrong_type("make-log-receiver", "logger", 0, argc, argv);
logger = (Scheme_Logger *)argv[0];
level = extract_level("make-log-receiver", 1, argc, argv);
lr = MALLOC_ONE_TAGGED(Scheme_Log_Reader);
lr->so.type = scheme_log_reader_type;
lr->want_level = level;
ch = scheme_make_channel();
lr->ch = ch;
q = scheme_make_raw_pair(scheme_make_weak_box((Scheme_Object *)lr), logger->readers);
logger->readers = q;
*logger->timestamp += 1;
return (Scheme_Object *)lr;
}
static Scheme_Object *
log_reader_p(int argc, Scheme_Object *argv[])
{
return (SAME_TYPE(SCHEME_TYPE(argv[0]), scheme_log_reader_type)
? scheme_true
: scheme_false);
}
static int log_reader_get(Scheme_Object *_lr, Scheme_Schedule_Info *sinfo)
{
Scheme_Log_Reader *lr = (Scheme_Log_Reader *)_lr;
if (lr->head) {
Scheme_Object *v;
v = SCHEME_CAR(lr->head);
lr->head = SCHEME_CDR(lr->head);
if (!lr->head)
lr->tail = NULL;
scheme_set_sync_target(sinfo, v, NULL, NULL, 0, 0);
return 1;
} else {
scheme_set_sync_target(sinfo, lr->ch, NULL, NULL, 0, 0);
return 0;
}
}
/***********************************************************************/
void
scheme_raise_exn(int id, ...)
{
@ -2700,7 +3313,20 @@ do_raise(Scheme_Object *arg, int need_debug, int eb)
{
Scheme_Thread *p = scheme_current_thread;
if (p->skip_error) {
if (p->constant_folding) {
if (SCHEME_TRUEP(p->constant_folding)) {
const char *msg;
if (need_debug) {
msg = scheme_display_to_string(((Scheme_Structure *)arg)->slots[0], NULL);
} else
msg = scheme_write_to_string(arg, NULL);
scheme_log(NULL,
SCHEME_LOG_WARNING,
0,
"warning%s: optimizer constant-fold attempt failed: %s",
scheme_optimize_context_to_string(p->constant_folding),
msg);
}
scheme_longjmp (scheme_error_buf, 1);
}

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

@ -818,12 +818,29 @@ static int is_proc_spec_proc(Scheme_Object *p)
return 0;
}
int scheme_omittable_expr(Scheme_Object *o, int vals, int fuel, int resolved)
static void note_match(int actual, int expected, Optimize_Info *warn_info)
{
if (!warn_info || (expected == -1))
return;
if (actual != expected) {
scheme_log(NULL,
SCHEME_LOG_WARNING,
0,
"warning%s: optimizer detects %d values produced when %d expected",
scheme_optimize_context_to_string(warn_info->context),
actual, expected);
}
}
int scheme_omittable_expr(Scheme_Object *o, int vals, int fuel, int resolved,
Optimize_Info *warn_info)
/* Checks whether the bytecode `o' returns `vals' values with no
side-effects and without pushing and using continuation marks.
-1 for vals means that any return count is ok.
Also used with fully resolved expression by `module' to check
for "functional" bodies. */
for "functional" bodies.
If warn_info is supplied, complain when a mismatch is detected. */
{
Scheme_Type vtype;
@ -842,10 +859,13 @@ int scheme_omittable_expr(Scheme_Object *o, int vals, int fuel, int resolved)
|| (vtype == scheme_compiled_unclosed_procedure_type)
|| (vtype == scheme_case_lambda_sequence_type)
|| (vtype == scheme_quote_syntax_type)
|| (vtype == scheme_compiled_quote_syntax_type))
|| (vtype == scheme_compiled_quote_syntax_type)) {
note_match(1, vals, warn_info);
return ((vals == 1) || (vals < 0));
}
if (vtype == scheme_toplevel_type) {
note_match(1, vals, warn_info);
if (resolved && ((vals == 1) || (vals < 0))) {
if (SCHEME_TOPLEVEL_FLAGS(o)
& (SCHEME_TOPLEVEL_CONST | SCHEME_TOPLEVEL_READY))
@ -856,19 +876,22 @@ int scheme_omittable_expr(Scheme_Object *o, int vals, int fuel, int resolved)
}
if ((vtype == scheme_syntax_type)
&& (SCHEME_PINT_VAL(o) == CASE_LAMBDA_EXPD))
&& (SCHEME_PINT_VAL(o) == CASE_LAMBDA_EXPD)) {
note_match(1, vals, warn_info);
return 1;
}
if ((vtype == scheme_compiled_quote_syntax_type)) {
note_match(1, vals, warn_info);
return ((vals == 1) || (vals < 0));
}
if ((vtype == scheme_branch_type)) {
Scheme_Branch_Rec *b;
b = (Scheme_Branch_Rec *)o;
return (scheme_omittable_expr(b->test, 1, fuel - 1, resolved)
&& scheme_omittable_expr(b->tbranch, vals, fuel - 1, resolved)
&& scheme_omittable_expr(b->fbranch, vals, fuel - 1, resolved));
return (scheme_omittable_expr(b->test, 1, fuel - 1, resolved, warn_info)
&& scheme_omittable_expr(b->tbranch, vals, fuel - 1, resolved, warn_info)
&& scheme_omittable_expr(b->fbranch, vals, fuel - 1, resolved, warn_info));
}
#if 0
@ -876,15 +899,15 @@ int scheme_omittable_expr(Scheme_Object *o, int vals, int fuel, int resolved)
a let_value_type! */
if ((vtype == scheme_let_value_type)) {
Scheme_Let_Value *lv = (Scheme_Let_Value *)o;
return (scheme_omittable_expr(lv->value, lv->count, fuel - 1, resolved)
&& scheme_omittable_expr(lv->body, vals, fuel - 1, resolved));
return (scheme_omittable_expr(lv->value, lv->count, fuel - 1, resolved, warn_info)
&& scheme_omittable_expr(lv->body, vals, fuel - 1, resolved, warn_info));
}
#endif
if ((vtype == scheme_let_one_type)) {
Scheme_Let_One *lo = (Scheme_Let_One *)o;
return (scheme_omittable_expr(lo->value, 1, fuel - 1, resolved)
&& scheme_omittable_expr(lo->body, vals, fuel - 1, resolved));
return (scheme_omittable_expr(lo->value, 1, fuel - 1, resolved, warn_info)
&& scheme_omittable_expr(lo->body, vals, fuel - 1, resolved, warn_info));
}
if ((vtype == scheme_let_void_type)) {
@ -894,7 +917,7 @@ int scheme_omittable_expr(Scheme_Object *o, int vals, int fuel, int resolved)
Scheme_Let_Value *lv2 = (Scheme_Let_Value *)lv->body;
if ((lv2->count == 1)
&& (lv2->position == 0)
&& scheme_omittable_expr(lv2->value, 1, fuel - 1, resolved))
&& scheme_omittable_expr(lv2->value, 1, fuel - 1, resolved, warn_info))
o = lv2->body;
else
o = lv->body;
@ -909,7 +932,7 @@ int scheme_omittable_expr(Scheme_Object *o, int vals, int fuel, int resolved)
if ((lh->count == 1) && (lh->num_clauses == 1)) {
if (SAME_TYPE(SCHEME_TYPE(lh->body), scheme_compiled_let_value_type)) {
Scheme_Compiled_Let_Value *lv = (Scheme_Compiled_Let_Value *)lh->body;
if (scheme_omittable_expr(lv->value, 1, fuel - 1, resolved)) {
if (scheme_omittable_expr(lv->value, 1, fuel - 1, resolved, warn_info)) {
o = lv->body;
goto try_again;
}
@ -926,9 +949,10 @@ int scheme_omittable_expr(Scheme_Object *o, int vals, int fuel, int resolved)
/* Look for multiple values, or for `make-struct-type'.
(The latter is especially useful to Honu.) */
Scheme_App_Rec *app = (Scheme_App_Rec *)o;
if (((vals == 5) || (vals < 0))
&& (app->num_args >= 4) && (app->num_args <= 10)
if ((app->num_args >= 4) && (app->num_args <= 10)
&& SAME_OBJ(scheme_make_struct_type_proc, app->args[0])) {
note_match(5, vals, warn_info);
if ((vals == 5) || (vals < 0)) {
/* Look for (make-struct-type sym #f non-neg-int non-neg-int [omitable null]) */
if (SCHEME_SYMBOLP(app->args[1])
&& SCHEME_FALSEP(app->args[2])
@ -937,7 +961,7 @@ int scheme_omittable_expr(Scheme_Object *o, int vals, int fuel, int resolved)
&& SCHEME_INTP(app->args[4])
&& (SCHEME_INT_VAL(app->args[4]) >= 0)
&& ((app->num_args < 5)
|| scheme_omittable_expr(app->args[5], 1, fuel - 1, resolved))
|| scheme_omittable_expr(app->args[5], 1, fuel - 1, resolved, warn_info))
&& ((app->num_args < 6)
|| SCHEME_NULLP(app->args[6]))
&& ((app->num_args < 7)
@ -951,23 +975,26 @@ int scheme_omittable_expr(Scheme_Object *o, int vals, int fuel, int resolved)
return 1;
}
}
}
/* (values <omittable> ...) */
if ((app->num_args == vals) || (vals < 0)) {
if (SAME_OBJ(scheme_values_func, app->args[0])) {
note_match(app->num_args, vals, warn_info);
if ((app->num_args == vals) || (vals < 0)) {
int i;
for (i = app->num_args; i--; ) {
if (!scheme_omittable_expr(app->args[i + 1], 1, fuel - 1, resolved))
if (!scheme_omittable_expr(app->args[i + 1], 1, fuel - 1, resolved, warn_info))
return 0;
}
return 1;
}
}
/* (void <omittable> ...) */
if ((vals == 1) || (vals < 0)) {
if (SAME_OBJ(scheme_void_proc, app->args[0])) {
note_match(1, vals, warn_info);
if ((vals == 1) || (vals < 0)) {
int i;
for (i = app->num_args; i--; ) {
if (!scheme_omittable_expr(app->args[i + 1], 1, fuel - 1, resolved))
if (!scheme_omittable_expr(app->args[i + 1], 1, fuel - 1, resolved, warn_info))
return 0;
}
return 1;
@ -978,11 +1005,12 @@ int scheme_omittable_expr(Scheme_Object *o, int vals, int fuel, int resolved)
if ((vtype == scheme_application2_type)) {
/* (values <omittable>) or (void <omittable>) */
if ((vals == 1) || (vals < 0)) {
Scheme_App2_Rec *app = (Scheme_App2_Rec *)o;
if (SAME_OBJ(scheme_values_func, app->rator)
|| SAME_OBJ(scheme_void_proc, app->rator)) {
if (scheme_omittable_expr(app->rand, 1, fuel - 1, resolved))
note_match(1, vals, warn_info);
if ((vals == 1) || (vals < 0)) {
if (scheme_omittable_expr(app->rand, 1, fuel - 1, resolved, warn_info))
return 1;
}
}
@ -990,20 +1018,21 @@ int scheme_omittable_expr(Scheme_Object *o, int vals, int fuel, int resolved)
if ((vtype == scheme_application3_type)) {
/* (values <omittable> <omittable>) */
if ((vals == 2) || (vals < 0)) {
Scheme_App3_Rec *app = (Scheme_App3_Rec *)o;
if (SAME_OBJ(scheme_values_func, app->rator)) {
if (scheme_omittable_expr(app->rand1, 1, fuel - 1, resolved)
&& scheme_omittable_expr(app->rand2, 1, fuel - 1, resolved))
note_match(2, vals, warn_info);
if ((vals == 2) || (vals < 0)) {
if (scheme_omittable_expr(app->rand1, 1, fuel - 1, resolved, warn_info)
&& scheme_omittable_expr(app->rand2, 1, fuel - 1, resolved, warn_info))
return 1;
}
}
/* (void <omittable> <omittable>) */
if ((vals == 1) || (vals < 0)) {
Scheme_App3_Rec *app = (Scheme_App3_Rec *)o;
if (SAME_OBJ(scheme_void_proc, app->rator)) {
if (scheme_omittable_expr(app->rand1, 1, fuel - 1, resolved)
&& scheme_omittable_expr(app->rand2, 1, fuel - 1, resolved))
note_match(1, vals, warn_info);
if ((vals == 1) || (vals < 0)) {
if (scheme_omittable_expr(app->rand1, 1, fuel - 1, resolved, warn_info)
&& scheme_omittable_expr(app->rand2, 1, fuel - 1, resolved, warn_info))
return 1;
}
}
@ -1049,14 +1078,14 @@ int scheme_get_eval_type(Scheme_Object *obj)
return SCHEME_EVAL_GENERAL;
}
static Scheme_Object *try_apply(Scheme_Object *f, Scheme_Object *args)
static Scheme_Object *try_apply(Scheme_Object *f, Scheme_Object *args, Scheme_Object *context)
/* Apply `f' to `args' and ignore failues --- used for constant
folding attempts */
{
Scheme_Object * volatile result;
mz_jmp_buf *savebuf, newbuf;
scheme_current_thread->skip_error = 5;
scheme_current_thread->constant_folding = context;
savebuf = scheme_current_thread->error_buf;
scheme_current_thread->error_buf = &newbuf;
@ -1066,7 +1095,7 @@ static Scheme_Object *try_apply(Scheme_Object *f, Scheme_Object *args)
result = _scheme_apply_to_list(f, args);
scheme_current_thread->error_buf = savebuf;
scheme_current_thread->skip_error = 0;
scheme_current_thread->constant_folding = NULL;
return result;
}
@ -1114,7 +1143,7 @@ static Scheme_Object *make_application(Scheme_Object *v)
== SCHEME_PRIM_OPT_FOLDING))
|| (SAME_TYPE(SCHEME_TYPE(f), scheme_closure_type)
&& (foldable_body(f)))) {
f = try_apply(f, SCHEME_CDR(v));
f = try_apply(f, SCHEME_CDR(v), scheme_false);
if (f)
return f;
@ -1605,7 +1634,7 @@ Scheme_Object *scheme_make_sequence_compilation(Scheme_Object *seq, int opt)
total++;
} else if (opt
&& (((opt > 0) && !last) || ((opt < 0) && !first))
&& scheme_omittable_expr(v, -1, -1, 0)) {
&& scheme_omittable_expr(v, -1, -1, 0, NULL)) {
/* A value that is not the result. We'll drop it. */
total++;
} else {
@ -1629,7 +1658,7 @@ Scheme_Object *scheme_make_sequence_compilation(Scheme_Object *seq, int opt)
return scheme_compiled_void();
if (count == 1) {
if ((opt < 0) && !scheme_omittable_expr(SCHEME_CAR(seq), 1, -1, 0)) {
if ((opt < 0) && !scheme_omittable_expr(SCHEME_CAR(seq), 1, -1, 0, NULL)) {
/* We can't optimize (begin0 expr cont) to expr because
exp is not in tail position in the original (so we'd mess
up continuation marks). */
@ -1661,7 +1690,7 @@ Scheme_Object *scheme_make_sequence_compilation(Scheme_Object *seq, int opt)
} else if (opt
&& (((opt > 0) && (k < total))
|| ((opt < 0) && k))
&& scheme_omittable_expr(v, -1, -1, 0)) {
&& scheme_omittable_expr(v, -1, -1, 0, NULL)) {
/* Value not the result. Do nothing. */
} else
o->array[i++] = v;
@ -1686,7 +1715,7 @@ static Scheme_Object *look_for_letv_change(Scheme_Sequence *s)
v = s->array[i];
if (SAME_TYPE(SCHEME_TYPE(v), scheme_let_value_type)) {
Scheme_Let_Value *lv = (Scheme_Let_Value *)v;
if (scheme_omittable_expr(lv->body, 1, -1, 0)) {
if (scheme_omittable_expr(lv->body, 1, -1, 0, NULL)) {
int esize = s->count - (i + 1);
int nsize = i + 1;
Scheme_Object *nv, *ev;
@ -2188,7 +2217,7 @@ static Scheme_Object *try_optimize_fold(Scheme_Object *f, Scheme_Object *o, Opti
break;
}
return try_apply(f, args);
return try_apply(f, args, info->context);
}
return NULL;
@ -2262,6 +2291,7 @@ Scheme_Object *optimize_for_inline(Optimize_Info *info, Scheme_Object *le, int a
/* If not app, app2, or app3, just return a known procedure, if any */
{
int offset = 0, single_use = 0;
Scheme_Object *bad_app = NULL;
if (SAME_TYPE(SCHEME_TYPE(le), scheme_local_type)) {
/* Check for inlining: */
@ -2308,6 +2338,12 @@ Scheme_Object *optimize_for_inline(Optimize_Info *info, Scheme_Object *le, int a
sz, info->inline_fuel * (argc + 2),
info->inline_fuel));
}
} else {
if (!(SCHEME_CLOSURE_DATA_FLAGS(data) & CLOS_HAS_REST)
|| (argc + 1 < data->num_params)) {
/* Issue warning below */
bad_app = (Scheme_Object *)data;
}
}
}
@ -2318,9 +2354,111 @@ Scheme_Object *optimize_for_inline(Optimize_Info *info, Scheme_Object *le, int a
*_flags = (CLOS_PRESERVES_MARKS | CLOS_SINGLE_RESULT);
}
if (le && SCHEME_PROCP(le)) {
Scheme_Object *a[1];
a[0] = le;
if (!scheme_check_proc_arity(NULL, argc, 0, 1, a)) {
bad_app = le;
}
}
if (bad_app) {
int len;
const char *pname, *context;
pname = scheme_get_proc_name(bad_app, &len, 0);
context = scheme_optimize_context_to_string(info->context);
scheme_log(NULL,
SCHEME_LOG_WARNING,
0,
"warning%s: optimizer detects procedure incorrectly applied to %d arguments%s%s",
context,
argc,
pname ? ": " : "",
pname ? pname : "");
}
return NULL;
}
char *scheme_optimize_context_to_string(Scheme_Object *context)
{
if (context) {
Scheme_Object *mod, *func;
const char *ctx, *prefix, *mctx, *mprefix;
char *all;
int clen, plen, mclen, mplen, len;
if (SCHEME_PAIRP(context)) {
func = SCHEME_CAR(context);
mod = SCHEME_CDR(context);
} else if (SAME_TYPE(SCHEME_TYPE(context), scheme_module_type)) {
func = scheme_false;
mod = context;
} else {
func = context;
mod = scheme_false;
}
if (SAME_TYPE(SCHEME_TYPE(func), scheme_compiled_unclosed_procedure_type)) {
Scheme_Object *name;
name = ((Scheme_Closure_Data *)func)->name;
if (name) {
if (SCHEME_VECTORP(name)) {
Scheme_Object *port;
int print_width = 1024;
long plen;
port = scheme_make_byte_string_output_port();
scheme_write_proc_context(port, print_width,
SCHEME_VEC_ELS(name)[0],
SCHEME_VEC_ELS(name)[1], SCHEME_VEC_ELS(name)[2],
SCHEME_VEC_ELS(name)[3], SCHEME_VEC_ELS(name)[4],
SCHEME_TRUEP(SCHEME_VEC_ELS(name)[6]));
ctx = scheme_get_sized_byte_string_output(port, &plen);
prefix = " in: ";
} else {
ctx = scheme_get_proc_name(func, &len, 0);
prefix = " in: ";
}
} else {
ctx = "";
prefix = "";
}
} else {
ctx = "";
prefix = "";
}
if (SAME_TYPE(SCHEME_TYPE(mod), scheme_module_type)) {
mctx = scheme_display_to_string(((Scheme_Module *)mod)->modname, NULL);
mprefix = " in module: ";
} else {
mctx = "";
mprefix = "";
}
clen = strlen(ctx);
plen = strlen(prefix);
mclen = strlen(mctx);
mplen = strlen(mprefix);
if (!clen && !mclen)
return "";
all = scheme_malloc_atomic(clen + plen + mclen + mplen + 1);
memcpy(all, prefix, plen);
memcpy(all + plen, ctx, clen);
memcpy(all + plen + clen, mprefix, mplen);
memcpy(all + plen + clen + mplen, mctx, mclen);
all[clen + plen + mclen + mplen] = 0;
return all;
} else
return "";
}
static void reset_rator(Scheme_Object *app, Scheme_Object *a)
{
switch (SCHEME_TYPE(app)) {
@ -2460,7 +2598,7 @@ static Scheme_Object *optimize_application2(Scheme_Object *o, Optimize_Info *inf
}
if (SAME_OBJ(scheme_values_func, app->rator)
&& scheme_omittable_expr(app->rand, 1, -1, 0)) {
&& scheme_omittable_expr(app->rand, 1, -1, 0, info)) {
info->preserves_marks = 1;
info->single_result = 1;
return app->rand;
@ -2647,7 +2785,7 @@ static Scheme_Object *optimize_sequence(Scheme_Object *o, Optimize_Info *info)
/* Inlining and constant propagation can expose
omittable expressions. */
if ((i + 1 != s->count)
&& scheme_omittable_expr(le, -1, -1, 0)) {
&& scheme_omittable_expr(le, -1, -1, 0, NULL)) {
drop++;
s->array[i] = NULL;
} else {
@ -3890,7 +4028,7 @@ static Scheme_Object *sfs_let_one(Scheme_Object *o, SFS_Info *info)
it might not because (1) it was introduced late by inlining,
or (2) the rhs expression doesn't always produce a single
value. */
if (scheme_omittable_expr(rhs, 1, -1, 1)) {
if (scheme_omittable_expr(rhs, 1, -1, 1, NULL)) {
rhs = scheme_false;
} else {
Scheme_Object *clr;

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

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

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_Closure_Data *data;
Scheme_Object *code;
Scheme_Object *code, *ctx;
Closure_Info *cl;
mzshort dcs, *dcm;
int i;
@ -956,6 +956,14 @@ scheme_optimize_closure_compilation(Scheme_Object *_data, Optimize_Info *info)
info = scheme_optimize_info_add_frame(info, data->num_params, data->num_params,
SCHEME_LAMBDA_FRAME);
if (info->context && SCHEME_PAIRP(info->context))
ctx = scheme_make_pair((Scheme_Object *)data,
SCHEME_CDR(info->context));
else if (info->context)
ctx = scheme_make_pair((Scheme_Object *)data, info->context);
else
ctx = (Scheme_Object *)data;
info->context = ctx;
cl = (Closure_Info *)data->closure_map;
for (i = 0; i < data->num_params; i++) {
@ -3197,7 +3205,9 @@ const char *scheme_get_proc_name(Scheme_Object *p, int *len, int for_error)
} else {
Scheme_Object *name;
if (type == scheme_closure_type) {
if (type == scheme_compiled_unclosed_procedure_type) {
name = ((Scheme_Closure_Data *)p)->name;
} else if (type == scheme_closure_type) {
name = SCHEME_COMPILED_CLOS_CODE(p)->name;
} else {
/* Native closure: */

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

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

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

@ -1637,6 +1637,8 @@ static int thread_val_MARK(void *p) {
gcMARK(pr->current_mt);
gcMARK(pr->constant_folding);
gcMARK(pr->overflow_reply);
gcMARK(pr->values_buffer);
@ -1738,6 +1740,8 @@ static int thread_val_FIXUP(void *p) {
gcFIXUP(pr->current_mt);
gcFIXUP(pr->constant_folding);
gcFIXUP(pr->overflow_reply);
gcFIXUP(pr->values_buffer);
@ -2637,6 +2641,62 @@ static int mark_pipe_FIXUP(void *p) {
#define mark_pipe_IS_CONST_SIZE 1
static int mark_logger_SIZE(void *p) {
return
gcBYTES_TO_WORDS(sizeof(Scheme_Logger));
}
static int mark_logger_MARK(void *p) {
Scheme_Logger *l = (Scheme_Logger *)p;
gcMARK(l->name);
gcMARK(l->parent);
gcMARK(l->readers);
gcMARK(l->timestamp);
return
gcBYTES_TO_WORDS(sizeof(Scheme_Logger));
}
static int mark_logger_FIXUP(void *p) {
Scheme_Logger *l = (Scheme_Logger *)p;
gcFIXUP(l->name);
gcFIXUP(l->parent);
gcFIXUP(l->readers);
gcFIXUP(l->timestamp);
return
gcBYTES_TO_WORDS(sizeof(Scheme_Logger));
}
#define mark_logger_IS_ATOMIC 0
#define mark_logger_IS_CONST_SIZE 1
static int mark_log_reader_SIZE(void *p) {
return
gcBYTES_TO_WORDS(sizeof(Scheme_Log_Reader));
}
static int mark_log_reader_MARK(void *p) {
Scheme_Log_Reader *lr = (Scheme_Log_Reader *)p;
gcMARK(lr->ch);
gcMARK(lr->head);
gcMARK(lr->tail);
return
gcBYTES_TO_WORDS(sizeof(Scheme_Log_Reader));
}
static int mark_log_reader_FIXUP(void *p) {
Scheme_Log_Reader *lr = (Scheme_Log_Reader *)p;
gcFIXUP(lr->ch);
gcFIXUP(lr->head);
gcFIXUP(lr->tail);
return
gcBYTES_TO_WORDS(sizeof(Scheme_Log_Reader));
}
#define mark_log_reader_IS_ATOMIC 0
#define mark_log_reader_IS_CONST_SIZE 1
#endif /* TYPE */
/**********************************************************************/
@ -2765,6 +2825,7 @@ static int mark_optimize_info_MARK(void *p) {
gcMARK(i->top_level_consts);
gcMARK(i->transitive_use);
gcMARK(i->transitive_use_len);
gcMARK(i->context);
return
gcBYTES_TO_WORDS(sizeof(Optimize_Info));
@ -2781,6 +2842,7 @@ static int mark_optimize_info_FIXUP(void *p) {
gcFIXUP(i->top_level_consts);
gcFIXUP(i->transitive_use);
gcFIXUP(i->transitive_use_len);
gcFIXUP(i->context);
return
gcBYTES_TO_WORDS(sizeof(Optimize_Info));

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

@ -652,6 +652,8 @@ thread_val {
gcMARK(pr->current_mt);
gcMARK(pr->constant_folding);
gcMARK(pr->overflow_reply);
gcMARK(pr->values_buffer);
@ -1047,6 +1049,27 @@ mark_pipe {
gcBYTES_TO_WORDS(sizeof(Scheme_Pipe));
}
mark_logger {
mark:
Scheme_Logger *l = (Scheme_Logger *)p;
gcMARK(l->name);
gcMARK(l->parent);
gcMARK(l->readers);
gcMARK(l->timestamp);
size:
gcBYTES_TO_WORDS(sizeof(Scheme_Logger));
}
mark_log_reader {
mark:
Scheme_Log_Reader *lr = (Scheme_Log_Reader *)p;
gcMARK(lr->ch);
gcMARK(lr->head);
gcMARK(lr->tail);
size:
gcBYTES_TO_WORDS(sizeof(Scheme_Log_Reader));
}
END type;
/**********************************************************************/
@ -1111,6 +1134,7 @@ mark_optimize_info {
gcMARK(i->top_level_consts);
gcMARK(i->transitive_use);
gcMARK(i->transitive_use_len);
gcMARK(i->context);
size:
gcBYTES_TO_WORDS(sizeof(Optimize_Info));

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 int scheme_log_level_p(Scheme_Logger *logger, int level);
MZ_EXTERN void scheme_log(Scheme_Logger *logger, int level, int flags,
char *msg, ...);
MZ_EXTERN void scheme_log_message(Scheme_Logger *logger, int level, char *buffer, long len, Scheme_Object *data);
MZ_EXTERN void scheme_wrong_count(const char *name, int minc, int maxc,
int argc, Scheme_Object **argv);
MZ_EXTERN void scheme_wrong_count_m(const char *name, int minc, int maxc,

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_warning)(char *msg, ...);
void (*scheme_raise)(Scheme_Object *exn);
int (*scheme_log_level_p)(Scheme_Logger *logger, int level);
void (*scheme_log)(Scheme_Logger *logger, int level, int flags,
char *msg, ...);
void (*scheme_log_message)(Scheme_Logger *logger, int level, char *buffer, long len, Scheme_Object *data);
void (*scheme_wrong_count)(const char *name, int minc, int maxc,
int argc, Scheme_Object **argv);
void (*scheme_wrong_count_m)(const char *name, int minc, int maxc,

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_warning = scheme_warning;
scheme_extension_table->scheme_raise = scheme_raise;
scheme_extension_table->scheme_log_level_p = scheme_log_level_p;
scheme_extension_table->scheme_log = scheme_log;
scheme_extension_table->scheme_log_message = scheme_log_message;
scheme_extension_table->scheme_wrong_count = scheme_wrong_count;
scheme_extension_table->scheme_wrong_count_m = scheme_wrong_count_m;
scheme_extension_table->scheme_case_lambda_wrong_count = scheme_case_lambda_wrong_count;

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

@ -83,6 +83,9 @@
#define scheme_raise_exn (scheme_extension_table->scheme_raise_exn)
#define scheme_warning (scheme_extension_table->scheme_warning)
#define scheme_raise (scheme_extension_table->scheme_raise)
#define scheme_log_level_p (scheme_extension_table->scheme_log_level_p)
#define scheme_log (scheme_extension_table->scheme_log)
#define scheme_log_message (scheme_extension_table->scheme_log_message)
#define scheme_wrong_count (scheme_extension_table->scheme_wrong_count)
#define scheme_wrong_count_m (scheme_extension_table->scheme_wrong_count_m)
#define scheme_case_lambda_wrong_count (scheme_extension_table->scheme_case_lambda_wrong_count)

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

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

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);
int scheme_try_channel_get(Scheme_Object *ch);
int scheme_try_channel_put(Scheme_Object *ch, Scheme_Object *v);
/*========================================================================*/
/* numbers */
@ -1843,6 +1844,8 @@ typedef struct Optimize_Info
int transitive_use_pos; /* set to pos + 1 when optimizing a letrec-bound procedure */
mzshort **transitive_use;
int *transitive_use_len;
Scheme_Object *context; /* for logging */
} Optimize_Info;
typedef struct Scheme_Object *(*Scheme_Syntax_Optimizer)(Scheme_Object *data, Optimize_Info *info);
@ -1872,7 +1875,7 @@ typedef struct Scheme_Closure_Data
mzshort closure_size;
mzshort *closure_map; /* actually a Closure_Info* until resolved; if CLOS_HAS_REF_ARGS, followed by bit array */
Scheme_Object *code;
Scheme_Object *name;
Scheme_Object *name; /* name or (vector name src line col pos span generated?) */
#ifdef MZ_USE_JIT
union {
struct Scheme_Closure_Data *jit_clone;
@ -2293,7 +2296,8 @@ void scheme_prepare_env_renames(Scheme_Env *env, int kind);
int scheme_used_app_only(Scheme_Comp_Env *env, int which);
int scheme_used_ever(Scheme_Comp_Env *env, int which);
int scheme_omittable_expr(Scheme_Object *o, int vals, int fuel, int resolved);
int scheme_omittable_expr(Scheme_Object *o, int vals, int fuel, int resolved,
Optimize_Info *warn_info);
int scheme_is_env_variable_boxed(Scheme_Comp_Env *env, int which);
@ -2721,6 +2725,33 @@ Scheme_Object *scheme_get_or_check_arity(Scheme_Object *p, long a);
int scheme_native_arity_check(Scheme_Object *closure, int argc);
Scheme_Object *scheme_get_native_arity(Scheme_Object *closure);
struct Scheme_Logger {
Scheme_Object so;
Scheme_Object *name;
Scheme_Logger *parent;
int want_level;
long *timestamp, local_timestamp; /* determines when want_level is up-to-date */
int syslog_level, stderr_level;
Scheme_Object *readers; /* list of weak boxes */
};
typedef struct Scheme_Log_Reader {
Scheme_Object so;
int want_level;
Scheme_Object *ch;
Scheme_Object *head, *tail;
} Scheme_Log_Reader;
extern Scheme_Logger *scheme_main_logger;
char *scheme_optimize_context_to_string(Scheme_Object *context);
void scheme_write_proc_context(Scheme_Object *port, int print_width,
Scheme_Object *name,
Scheme_Object *src, Scheme_Object *line,
Scheme_Object *col, Scheme_Object *pos,
int generated);
/*========================================================================*/
/* filesystem utilities */
/*========================================================================*/
@ -2773,6 +2804,7 @@ int scheme_is_special_filename(const char *_f, int not_nul);
#endif
char *scheme_get_exec_path(void);
Scheme_Object *scheme_get_run_cmd(void);
Scheme_Object *scheme_get_fd_identity(Scheme_Object *port, long fd);

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

@ -13,12 +13,12 @@
consistently.)
*/
#define MZSCHEME_VERSION "4.0.2.3"
#define MZSCHEME_VERSION "4.0.2.4"
#define MZSCHEME_VERSION_X 4
#define MZSCHEME_VERSION_Y 0
#define MZSCHEME_VERSION_Z 2
#define MZSCHEME_VERSION_W 3
#define MZSCHEME_VERSION_W 4
#define MZSCHEME_VERSION_MAJOR ((MZSCHEME_VERSION_X * 100) + MZSCHEME_VERSION_Y)
#define MZSCHEME_VERSION_MINOR ((MZSCHEME_VERSION_Z * 1000) + MZSCHEME_VERSION_W)

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;
}
int scheme_try_channel_put(Scheme_Object *ch, Scheme_Object *v)
{
if (((Scheme_Channel *)ch)->get_first) {
Scheme_Object *a[2];
v = scheme_make_channel_put_evt(ch, v);
a[0] = scheme_make_integer(0);
a[1] = v;
v = scheme_sync_timeout(2, a);
return SCHEME_TRUEP(v);
} else
return 0;
}
static Scheme_Object *make_channel_put(int argc, Scheme_Object **argv)
{
if (!SCHEME_CHANNELP(argv[0]))

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

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

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. */
if ((pre_body->count != 1)
&& is_values_apply(value)
&& scheme_omittable_expr(value, pre_body->count, -1, 0)) {
&& scheme_omittable_expr(value, pre_body->count, -1, 0, info)) {
if (!pre_body->count && !i) {
/* We want to drop the clause entirely, but doing it
here messes up the loop for letrec. So wait and
@ -3225,7 +3225,7 @@ scheme_optimize_lets(Scheme_Object *form, Optimize_Info *info, int for_inline)
}
}
if (!used
&& scheme_omittable_expr(pre_body->value, pre_body->count, -1, 0)) {
&& scheme_omittable_expr(pre_body->value, pre_body->count, -1, 0, info)) {
for (j = pre_body->count; j--; ) {
if (pre_body->flags[j] & SCHEME_WAS_USED) {
pre_body->flags[j] -= SCHEME_WAS_USED;
@ -3604,7 +3604,7 @@ scheme_resolve_lets(Scheme_Object *form, Resolve_Info *info)
}
if (j >= 0)
break;
if (!scheme_omittable_expr(clv->value, clv->count, -1, 0))
if (!scheme_omittable_expr(clv->value, clv->count, -1, 0, NULL))
break;
}
if (i < 0) {
@ -5478,7 +5478,7 @@ static Scheme_Object *eval_letmacro_rhs(Scheme_Object *a, Scheme_Comp_Env *rhs_e
save_runstack = scheme_push_prefix(NULL, rp, NULL, NULL, phase, phase);
if (scheme_omittable_expr(a, 1, -1, 0)) {
if (scheme_omittable_expr(a, 1, -1, 0, NULL)) {
/* short cut */
a = _scheme_eval_linked_expr_multi(a);
} else {

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

@ -206,11 +206,16 @@ Scheme_Object *scheme_exn_handler_key;
Scheme_Object *scheme_break_enabled_key;
long scheme_total_gc_time;
static long start_this_gc_time;
static long start_this_gc_time, end_this_gc_time;
#ifndef MZ_PRECISE_GC
extern MZ_DLLIMPORT void (*GC_collect_start_callback)(void);
extern MZ_DLLIMPORT void (*GC_collect_end_callback)(void);
#endif
static void get_ready_for_GC(void);
static void done_with_GC(void);
#ifdef MZ_PRECISE_GC
static void inform_GC(int major_gc, long pre_used, long post_used);
#endif
static volatile short delayed_break_ready = 0;
static Scheme_Thread *main_break_target_thread;
@ -2105,6 +2110,9 @@ static Scheme_Thread *make_thread(Scheme_Config *config,
GC_collect_start_callback = get_ready_for_GC;
GC_collect_end_callback = done_with_GC;
#ifdef MZ_PRECISE_GC
GC_collect_inform_callback = inform_GC;
#endif
#ifdef LINK_EXTENSIONS_BY_TABLE
scheme_current_thread_ptr = &scheme_current_thread;
@ -7184,9 +7192,24 @@ static void done_with_GC()
scheme_block_child_signals(0);
#endif
scheme_total_gc_time += (scheme_get_process_milliseconds() - start_this_gc_time);
end_this_gc_time = scheme_get_process_milliseconds();
scheme_total_gc_time += (end_this_gc_time - start_this_gc_time);
}
#ifdef MZ_PRECISE_GC
static void inform_GC(int major_gc, long pre_used, long post_used)
{
if (scheme_main_logger)
scheme_log(scheme_main_logger,
SCHEME_LOG_INFO, 0,
"GC [%s] at %ld bytes; %ld collected in %ld msec",
(major_gc ? "major" : "minor"),
pre_used, pre_used - post_used,
end_this_gc_time - start_this_gc_time);
}
#endif
#ifdef MZ_XFORM
END_XFORM_SKIP;
#endif

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_logger_type, "<logger>");
set_name(scheme_log_reader_type, "<log-receiver>");
set_name(_scheme_values_types_, "<resurrected>");
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_logger_type, mark_logger);
GC_REG_TRAV(scheme_log_reader_type, mark_log_reader);
GC_REG_TRAV(scheme_rt_runstack, runstack_val);
}

2
src/mzscheme/uconfig.h
View File

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