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

Merge branch 'master' into tmp-http-connect-proxy-merge

Browse Source 
Fixed conflict with Tony’s head? definition
This commit is contained in:
Tim Brown 2016-08-18 14:40:08 +01:00
commit c9f6f6aa31
44 changed files with 2395 additions and 1855 deletions
Show Stats Download Patch File Download Diff File Expand all files Collapse all files

2
pkgs/racket-doc/scribblings/foreign/alloc.scrbl
View File

@ -13,7 +13,7 @@ deallocated.}
Produces a procedure that behaves like @racket[alloc], but the result Produces a procedure that behaves like @racket[alloc], but the result
of @racket[alloc] is given a finalizer that calls @racket[dealloc] on of @racket[alloc] is given a finalizer that calls @racket[dealloc] on
the result if it is not otherwise freed through a deallocator (as a non-@racket[#f] result if it is not otherwise freed through a deallocator (as
designated with @racket[deallocator]). In addition, @racket[alloc] is designated with @racket[deallocator]). In addition, @racket[alloc] is
called in @tech{atomic mode} (see @racket[call-as-atomic]); its result is called in @tech{atomic mode} (see @racket[call-as-atomic]); its result is
received and registered in atomic mode, so that the result is reliably received and registered in atomic mode, so that the result is reliably

6
pkgs/racket-doc/scribblings/inside/values.scrbl
View File

@ -186,13 +186,15 @@ types:
extracts/sets the user data pointer; test for just this type with extracts/sets the user data pointer; test for just this type with
@cppdef{SCHEME_INPORTP}, but use @cppdef{SCHEME_INPUT_PORTP} to recognize @cppdef{SCHEME_INPORTP}, but use @cppdef{SCHEME_INPUT_PORTP} to recognize
all input ports (including structures with the all input ports (including structures with the
@racket[prop:input-port] property)} @racket[prop:input-port] property), and use @cppi{scheme_input_port_record}
to extract a @cppi{scheme_input_port_type} value from a general input port}
@item{@cppdef{scheme_output_port_type} --- @cppdef{SCHEME_OUTPORT_VAL} @item{@cppdef{scheme_output_port_type} --- @cppdef{SCHEME_OUTPORT_VAL}
extracts/sets the user data pointer; test for just this type with extracts/sets the user data pointer; test for just this type with
@cppdef{SCHEME_OUTPORTP}, but use @cppdef{SCHEME_OUTPUT_PORTP} to @cppdef{SCHEME_OUTPORTP}, but use @cppdef{SCHEME_OUTPUT_PORTP} to
recognize all output ports (including structures with the recognize all output ports (including structures with the
@racket[prop:output-port] property)} @racket[prop:output-port] property), and use @cppi{scheme_output_port_record}
to extract a @cppi{scheme_output_port_type} value from a general input port}
@item{@cppdef{scheme_thread_type} --- thread descriptors; test for @item{@cppdef{scheme_thread_type} --- thread descriptors; test for
this type with @cppdef{SCHEME_THREADP}} this type with @cppdef{SCHEME_THREADP}}

2
pkgs/racket-doc/scribblings/reference/contracts.scrbl
View File

@ -164,7 +164,7 @@ For example,
2)] 2)]
The generator argument adds a generator for the flat-named-contract. See The generator argument adds a generator for the flat-named-contract. See
@racket[contract-generate] for more information. @racket[contract-random-generate] for more information.
} }
@defthing[any/c flat-contract?]{ @defthing[any/c flat-contract?]{

7
pkgs/racket-doc/scribblings/reference/eval-model.scrbl
View File

@ -791,9 +791,10 @@ binding is not included in the @tech{lexical information} for the
module body. If a new variable definition has a counterpart in the old module body. If a new variable definition has a counterpart in the old
declaration, it effectively assigns to the old variable. declaration, it effectively assigns to the old variable.
If a module is @tech{instantiate}d in any @tech{phase}s before it is If a module is @tech{instantiate}d in the current namespace's
redeclared, each redeclaration of the module is immediately @tech{base phase} before the module is redeclared, the redeclaration
@tech{instantiate}d in the same @tech{phase}s. of the module is immediately @tech{instantiate}d in that
@tech{phase}.
If the current @tech{inspector} does not manage a module's declaration If the current @tech{inspector} does not manage a module's declaration
inspector (see @secref["modprotect"]), then the module cannot be inspector (see @secref["modprotect"]), then the module cannot be

46
pkgs/racket-doc/scribblings/reference/memory.scrbl
View File

@ -350,24 +350,42 @@ garbage-collection mode, depending on @racket[request]:
#:changed "6.3.0.2" @elem{Added @racket['incremental] mode.}]} #:changed "6.3.0.2" @elem{Added @racket['incremental] mode.}]}
@defproc[(current-memory-use [cust custodian? #f]) exact-nonnegative-integer?]{ @defproc[(current-memory-use [mode (or/c #f 'cumulative custodian?) #f])
exact-nonnegative-integer?]{
Returns an estimate of the number of bytes of memory occupied by Returns information about memory use:
reachable data from @racket[cust]. This estimate is calculated by the
last garbage collection, and can be 0 if none occurred (or if none occurred
since the given custodian was created). The @racket[current-memory-use]
function does @italic{not} perform a collection by itself; doing one
before the call will generally decrease the result (or increase it from
0 if no collections happened yet).
If @racket[cust] is not provided, the estimate is a total reachable from @itemlist[
any custodians.
When Racket is compiled without support for memory accounting, the @item{If @racket[mode] is @racket[#f] (the default), the result is an
estimate is the same (i.e., all memory) for any individual custodian; estimate of the number of bytes reachable from any custodian.}
see also @racket[custodian-memory-accounting-available?].
@item{If @racket[mode] is @racket['cumulative], returns an estimate
of the total number of bytes allocated since start up,
including bytes that have since been reclaimed by garbage
collection.}
@item{If @racket[mode] is a custodian, returns an estimate of the
number of bytes of memory occupied by reachable data from
@racket[mode]. This estimate is calculated by the last garbage
collection, and can be 0 if none occurred (or if none occurred
since the given custodian was created). The
@racket[current-memory-use] function does @italic{not} perform
a collection by itself; doing one before the call will
generally decrease the result (or increase it from 0 if no
collections happened yet).
When Racket is compiled without support for memory accounting,
the estimate is the same as when @racket[mode] is @racket[#f]
(i.e., all memory) for any individual custodian. See also
@racket[custodian-memory-accounting-available?].}
]
See also @racket[vector-set-performance-stats!].
@history[#:changed "6.6.0.3" @elem{Added @racket['cumulative] mode.}]}
See also @racket[vector-set-performance-stats!].}
@defproc[(dump-memory-stats [v any/c] ...) any]{ @defproc[(dump-memory-stats [v any/c] ...) any]{

11
pkgs/racket-doc/scribblings/reference/namespaces.scrbl
View File

@ -22,7 +22,8 @@ otherwise.}
@defproc[(make-empty-namespace) namespace?]{ @defproc[(make-empty-namespace) namespace?]{
Creates a new @tech{namespace} that is empty, and whose @tech{module Creates a new @tech{namespace} that is empty, and whose @tech{module
registry} contains no mappings. The namespace's @tech{base phase} is registry} contains only mappings for some internal, predefined modules,
such as @racket['#%kernel]. The namespace's @tech{base phase} is
the same as the @tech{base phase} of the @tech{current the same as the @tech{base phase} of the @tech{current
namespace}. Attach modules from an existing namespace to the new one namespace}. Attach modules from an existing namespace to the new one
with @racket[namespace-attach-module]. with @racket[namespace-attach-module].
@ -207,9 +208,9 @@ corresponding to the @tech{namespace}'s @tech{base phase}.}
Performs the import corresponding to @racket[quoted-raw-require-spec] Performs the import corresponding to @racket[quoted-raw-require-spec]
in the top-level environment of the current namespace, like a in the top-level environment of the current namespace, like a
top-level @racket[#%require]. The @racket[quoted-raw-require-spec] top-level @racket[#%require]. The @racket[quoted-raw-require-spec]
argument must be a datum that corresponds to a quoted argument must be either a datum that corresponds to a quoted
@racket[_raw-require-spec] for @racket[#%require], which includes @racket[_raw-require-spec] for @racket[#%require], which includes
module paths. module paths, or it can be a @tech{resolved module path}.
Module paths in @racket[quoted-raw-require-spec] are resolved with respect Module paths in @racket[quoted-raw-require-spec] are resolved with respect
to @racket[current-load-relative-directory] or to @racket[current-load-relative-directory] or
@ -249,7 +250,7 @@ undefined.}
@defproc[(namespace-attach-module [src-namespace namespace?] @defproc[(namespace-attach-module [src-namespace namespace?]
[modname module-path?] [modname (or module-path? resolved-module-path?)]
[dest-namespace namespace? (current-namespace)]) [dest-namespace namespace? (current-namespace)])
void?]{ void?]{
@ -330,7 +331,7 @@ Changes the inspector for the instance of the module referenced by
that it is controlled by the current code inspector. The given that it is controlled by the current code inspector. The given
@racket[inspector] must currently control the invocation of the module @racket[inspector] must currently control the invocation of the module
in @racket[namespace]'s @tech{module registry}, otherwise the in @racket[namespace]'s @tech{module registry}, otherwise the
@exnraise[exn:fail:contract]. See also @secref["modprotect"].} inspector is not changed. See also @secref["modprotect"].}
@defproc[(namespace-module-registry [namespace namespace?]) @defproc[(namespace-module-registry [namespace namespace?])

48
pkgs/racket-doc/scribblings/reference/pretty-print.scrbl
View File

@ -6,14 +6,16 @@
@note-lib[racket/pretty] @note-lib[racket/pretty]
@defproc[(pretty-print [v any/c] [port output-port? (current-output-port)] @defproc[(pretty-print [v any/c] [port output-port? (current-output-port)]
[quote-depth (or/c 0 1) 0]) [quote-depth (or/c 0 1) 0]
[#:newline? newline? boolean? #t])
void?]{ void?]{
Pretty-prints the value @racket[v] using the same printed form as the Pretty-prints the value @racket[v] using the same printed form as the
default @racket[print] mode, but with newlines and whitespace inserted default @racket[print] mode, but with newlines and whitespace inserted
to avoid lines longer than @racket[(pretty-print-columns)], as to avoid lines longer than @racket[(pretty-print-columns)], as
controlled by @racket[(pretty-print-current-style-table)]. The printed controlled by @racket[(pretty-print-current-style-table)]. The printed
form ends in a newline, unless the @racket[pretty-print-columns] form ends in a newline by default, unless the @racket[newline?]
argument is supplied with false or the @racket[pretty-print-columns]
parameter is set to @racket['infinity]. When @racket[port] has line parameter is set to @racket['infinity]. When @racket[port] has line
counting enabled (see @secref["linecol"]), then printing is sensitive counting enabled (see @secref["linecol"]), then printing is sensitive
to the column when printing starts---both for determining an initial to the column when printing starts---both for determining an initial
@ -39,19 +41,36 @@ to determine the target printing width, and use
function in the @racket[pretty-print-print-line] parameter can be function in the @racket[pretty-print-print-line] parameter can be
called appropriately). Use called appropriately). Use
@racket[make-tentative-pretty-print-output-port] to obtain a port for @racket[make-tentative-pretty-print-output-port] to obtain a port for
tentative recursive prints (e.g., to check the length of the output).} tentative recursive prints (e.g., to check the length of the output).
@defproc[(pretty-write [v any/c] [port output-port? (current-output-port)]) If the @racket[newline?] argument is ommitted or supplied with true,
the @racket[pretty-print-print-line] callback is called with false as
the first argument to print the last newline after the printed value.
If it is supplied with false, the @racket[pretty-print-print-line]
callback is not called after the printed value.
@history[#:changed "6.6.0.3" @elem{Added @racket[newline?] argument.}]
}
@defproc[(pretty-write [v any/c] [port output-port? (current-output-port)]
[#:newline? newline? boolean? #t])
void?]{ void?]{
Same as @racket[pretty-print], but @racket[v] is printed like Same as @racket[pretty-print], but @racket[v] is printed like
@racket[write] instead of like @racket[print].} @racket[write] instead of like @racket[print].
@defproc[(pretty-display [v any/c] [port output-port? (current-output-port)]) @history[#:changed "6.6.0.3" @elem{Added @racket[newline?] argument.}]
}
@defproc[(pretty-display [v any/c] [port output-port? (current-output-port)]
[#:newline? newline? boolean? #t])
void?]{ void?]{
Same as @racket[pretty-print], but @racket[v] is printed like Same as @racket[pretty-print], but @racket[v] is printed like
@racket[display] instead of like @racket[print].} @racket[display] instead of like @racket[print].
@history[#:changed "6.6.0.3" @elem{Added @racket[newline?] argument.}]
}
@defproc[(pretty-format [v any/c] [columns exact-nonnegative-integer? (pretty-print-columns)] @defproc[(pretty-format [v any/c] [columns exact-nonnegative-integer? (pretty-print-columns)]
@ -243,15 +262,18 @@ beginning of the new line.
The @racket[proc] procedure is called before any characters are The @racket[proc] procedure is called before any characters are
printed with @racket[0] as the line number and @racket[0] as the old printed with @racket[0] as the line number and @racket[0] as the old
line length; @racket[proc] is called after the last character of a line length. Whenever the pretty-printer starts a new line,
value has been printed with @racket[#f] as the line number and with the @racket[proc] is called with the new line's number (where the first
length of the last line. Whenever the pretty-printer starts a new new line is numbered @racket[1]) and the just-finished line's length.
line, @racket[proc] is called with the new line's number (where the The destination-columns argument to @racket[proc] is always
first new line is numbered @racket[1]) and the just-finished line's
length. The destination-columns argument to @racket[proc] is always
the total width of the destination printing area, or the total width of the destination printing area, or
@racket['infinity] if pretty-printed values are not broken into lines. @racket['infinity] if pretty-printed values are not broken into lines.
If the @racket[#:newline?] argument was omitted or supplied with
a true value, @racket[proc] is also called after the last character of the
value has been printed, with @racket[#f] as the line number and with
the length of the last line.
The default @racket[proc] procedure prints a newline whenever the line The default @racket[proc] procedure prints a newline whenever the line
number is not @racket[0] and the column count is not number is not @racket[0] and the column count is not
@racket['infinity], always returning @racket[0]. A custom @racket['infinity], always returning @racket[0]. A custom

2
pkgs/racket-doc/scribblings/reference/stx-taints.scrbl
View File

@ -88,7 +88,7 @@ the transformer's input. The @tech{rearm}ing process
@item{If the result has no @racket['taint-mode] property value, but @item{If the result has no @racket['taint-mode] property value, but
its datum is a pair, and if the syntax object corresponding its datum is a pair, and if the syntax object corresponding
to the @racket[car] of the pair is an identifier bound to to the @racket[car] of the pair is an identifier bound to
@racket[begin], @racket[module], or @racket[begin], @racket[begin-for-syntax], or
@racket[#%plain-module-begin], then dye packs are propagated @racket[#%plain-module-begin], then dye packs are propagated
as if the syntax object had the @racket['transparent] as if the syntax object had the @racket['transparent]
property value.} property value.}

32
pkgs/racket-doc/scribblings/reference/stx-trans.scrbl
View File

@ -968,9 +968,26 @@ and different result procedures use distinct scopes.
((syntax?) ((or/c 'flip 'add 'remove)) . ->* . syntax?)]{ ((syntax?) ((or/c 'flip 'add 'remove)) . ->* . syntax?)]{
Produces a procedure that behaves like the result of Produces a procedure that behaves like the result of
@racket[make-syntax-introducer], but using the @tech{scopes} of @racket[make-syntax-introducer], but using a set of @tech{scopes} from
@racket[ext-stx] that are not shared with @racket[base-stx], and with @racket[ext-stx] and with a default action of @racket['add].
a default action of @racket['remove].
@itemlist[
@item{If the scopes of @racket[base-stx] are a subset of the scopes
of @racket[ext-stx], then the result of
@racket[make-syntax-delta-introducer] adds, removes, or flips
scopes that are in the set for @racket[ext-stx] and not in the
set for @racket[base-stx].}
@item{If the scopes of @racket[base-stx] are not a subset of the
scopes of @racket[ext-stx], but if it has a binding, then the
set of scopes associated with the binding id subtracted from
the set of scopes for @racket[ext-stx], and the result of
@racket[make-syntax-delta-introducer] adds, removes, or flips
that difference.}
]
A @racket[#f] value for @racket[base-stx] is equivalent to a syntax A @racket[#f] value for @racket[base-stx] is equivalent to a syntax
object with no @tech{scopes}. object with no @tech{scopes}.
@ -1012,8 +1029,9 @@ level as reported by @racket[syntax-local-phase-level].}
@defproc[(syntax-local-module-required-identifiers @defproc[(syntax-local-module-required-identifiers
[mod-path (or/c module-path? #f)] [mod-path (or/c module-path? #f)]
[phase-level (or/c exact-integer? #f #t)]) [phase-level (or/c exact-integer? #f #t)])
(listof (cons/c (or/c exact-integer? #f) (or/c (listof (cons/c (or/c exact-integer? #f)
(listof identifier?)))]{ (listof identifier?)))
#f)]{
Can be called only while Can be called only while
@racket[syntax-local-transforming-module-provides?] returns @racket[syntax-local-transforming-module-provides?] returns
@ -1025,7 +1043,9 @@ identifiers. Each list of identifiers includes all bindings imported
@racket[mod-path], or all modules if @racket[mod-path] is @racket[mod-path], or all modules if @racket[mod-path] is
@racket[#f]. The association list includes all identifiers imported @racket[#f]. The association list includes all identifiers imported
with a @racket[phase-level] shift, or all shifts if with a @racket[phase-level] shift, or all shifts if
@racket[phase-level] is @racket[#t]. @racket[phase-level] is @racket[#t]. If @racket[phase-level] is
not @racket[#t], the result can be @racket[#f] if no identifiers
are exported at that phase.
When an identifier is renamed on import, the result association list When an identifier is renamed on import, the result association list
includes the identifier by its internal name. Use includes the identifier by its internal name. Use

8
pkgs/racket-doc/scribblings/reference/syntax.scrbl
View File

@ -236,7 +236,8 @@ A @racket[module*] form in which the enclosing module's bindings are visible
can define or import bindings that @tech{shadow} the enclosing module's bindings. can define or import bindings that @tech{shadow} the enclosing module's bindings.
The evaluation of a @racket[module] form does not evaluate the The evaluation of a @racket[module] form does not evaluate the
expressions in the body of the module. Evaluation merely declares a expressions in the body of the module (except sometimes for redeclarations;
see @secref["module-redeclare"]). Evaluation merely declares a
module, whose full name depends both on @racket[id] or module, whose full name depends both on @racket[id] or
@racket[(current-module-declare-name)]. @racket[(current-module-declare-name)].
@ -682,7 +683,7 @@ corresponds to the default @tech{module name resolver}.
@racket[current-directory]). Regardless of the current platform, @racket[current-directory]). Regardless of the current platform,
@racket[rel-string] is always parsed as a Unix-format relative path: @racket[rel-string] is always parsed as a Unix-format relative path:
@litchar{/} is the path delimiter (multiple adjacent @litchar{/}s are @litchar{/} is the path delimiter (multiple adjacent @litchar{/}s are
treated as a single delimiter), @litchar{..} accesses the parent not allowed), @litchar{..} accesses the parent
directory, and @litchar{.} accesses the current directory. The path directory, and @litchar{.} accesses the current directory. The path
cannot be empty or contain a leading or trailing slash, path elements cannot be empty or contain a leading or trailing slash, path elements
before than the last one cannot include a file suffix (i.e., a before than the last one cannot include a file suffix (i.e., a
@ -1215,7 +1216,8 @@ composable, and not extensible. Also, sub-form names like
@racketidfont{for-syntax} and @racketidfont{lib} are recognized @racketidfont{for-syntax} and @racketidfont{lib} are recognized
symbolically, instead of via bindings. Although not formalized in the symbolically, instead of via bindings. Although not formalized in the
grammar above, a @racketidfont{just-meta} form cannot appear within a grammar above, a @racketidfont{just-meta} form cannot appear within a
@racketidfont{just-meta} form. @racketidfont{just-meta} form, but it can appear under @racketidfont{for-meta},
@racketidfont{for-syntax}, @racketidfont{for-template}, or @racketidfont{for-label}.
Each @racket[raw-require-spec] corresponds to the obvious Each @racket[raw-require-spec] corresponds to the obvious
@racket[_require-spec], but the @racketidfont{rename} sub-form has the @racket[_require-spec], but the @racketidfont{rename} sub-form has the

26
pkgs/racket-test-core/tests/racket/optimize.rktl
View File

@ -904,6 +904,32 @@
)) ))
;; Check JIT handling of structure-reference sequencese
(parameterize ([current-namespace (make-base-namespace)]
[eval-jit-enabled #t])
(eval '(module paper racket/base
(provide (all-defined-out))
(struct paper (width height folds) #:transparent)
(define (fold-letter l)
(for/fold ([l l]) ([i (in-range 100)])
(and (paper? l)
(struct-copy paper l [folds i]))))
(define (refine-letter l)
(for/fold ([l l]) ([i (in-range 100)])
(and (paper? l)
(struct-copy paper l [width i]))))))
(eval '(require 'paper))
(eval '(define letter (paper 8.5 11 0)))
(eval '(define formal-letter (chaperone-struct letter paper-height
(lambda (s v)
(unless (equal? v 11)
(error "wrong"))
v))))
(test #t eval '(equal? (fold-letter letter) (paper 8.5 11 99)))
(test #t eval '(equal? (fold-letter formal-letter) (paper 8.5 11 99)))
(test #t eval '(equal? (refine-letter letter) (paper 99 11 0)))
(test #t eval '(equal? (refine-letter formal-letter) (paper 99 11 0))))
(define (comp=? c1 c2 want-same?) (define (comp=? c1 c2 want-same?)
(let ([s1 (open-output-bytes)] (let ([s1 (open-output-bytes)]
[s2 (open-output-bytes)]) [s2 (open-output-bytes)])

36
pkgs/racket-test-core/tests/racket/pretty.rktl
View File

@ -475,6 +475,42 @@
(test "#true" pretty-format #t) (test "#true" pretty-format #t)
(test "#false" pretty-format #f)) (test "#false" pretty-format #f))
;; ----------------------------------------
;; check that pretty-print follows the
;; #:newline? argument
;; no #:newline? argument, tests the default
(let ([p (open-output-string)])
(parameterize ([current-output-port p]
[pretty-print-columns 40])
(pretty-print '(define (f xs)
(for/list ([x (in-list xs)])
(+ x 1)))))
(test "'(define (f xs)\n (for/list\n ((x (in-list xs)))\n (+ x 1)))\n"
get-output-string p))
;; #:newline? #t, same as the default
(let ([p (open-output-string)])
(parameterize ([current-output-port p]
[pretty-print-columns 40])
(pretty-print '(define (f xs)
(for/list ([x (in-list xs)])
(+ x 1)))
#:newline? #t))
(test "'(define (f xs)\n (for/list\n ((x (in-list xs)))\n (+ x 1)))\n"
get-output-string p))
;; #:newline? #f
(let ([p (open-output-string)])
(parameterize ([current-output-port p]
[pretty-print-columns 40])
(pretty-print '(define (f xs)
(for/list ([x (in-list xs)])
(+ x 1)))
#:newline? #f))
(test "'(define (f xs)\n (for/list\n ((x (in-list xs)))\n (+ x 1)))"
get-output-string p))
;; ---------------------------------------- ;; ----------------------------------------
;; check that an all-powerful inspector doesn't break the pretty printer internally ;; check that an all-powerful inspector doesn't break the pretty printer internally

10
pkgs/zo-lib/compiler/zo-marshal.rkt
View File

@ -654,17 +654,17 @@
(if (function-shape-preserves-marks? constantness) 1 0))]))] (if (function-shape-preserves-marks? constantness) 1 0))]))]
[(struct-type-shape? constantness) [(struct-type-shape? constantness)
(to-sym (arithmetic-shift (struct-type-shape-field-count constantness) (to-sym (arithmetic-shift (struct-type-shape-field-count constantness)
4))] 3))]
[(constructor-shape? constantness) [(constructor-shape? constantness)
(to-sym (bitwise-ior 1 (arithmetic-shift (constructor-shape-arity constantness) (to-sym (bitwise-ior 1 (arithmetic-shift (constructor-shape-arity constantness)
4)))] 3)))]
[(predicate-shape? constantness) (to-sym 2)] [(predicate-shape? constantness) (to-sym 2)]
[(accessor-shape? constantness) [(accessor-shape? constantness)
(to-sym (bitwise-ior 3 (arithmetic-shift (accessor-shape-field-count constantness) (to-sym (bitwise-ior 3 (arithmetic-shift (accessor-shape-field-count constantness)
4)))] 3)))]
[(mutator-shape? constantness) [(mutator-shape? constantness)
(to-sym (bitwise-ior 4 (arithmetic-shift (mutator-shape-field-count constantness) (to-sym (bitwise-ior 4 (arithmetic-shift (mutator-shape-field-count constantness)
4)))] 3)))]
[(struct-type-property-shape? constantness) [(struct-type-property-shape? constantness)
(to-sym #:prefix "prop" (to-sym #:prefix "prop"
(if (struct-type-property-shape-has-guard? constantness) (if (struct-type-property-shape-has-guard? constantness)
@ -1197,7 +1197,7 @@
(append (append
(vector->list closure-map) (vector->list closure-map)
(let* ([v (make-vector (ceiling (let* ([v (make-vector (ceiling
(/ (* BITS_PER_ARG (+ num-params (vector-length closure-map))) (/ (* BITS_PER_ARG (+ num-all-params (vector-length closure-map)))
BITS_PER_MZSHORT)))] BITS_PER_MZSHORT)))]
[set-bit! (lambda (i bit) [set-bit! (lambda (i bit)
(let ([pos (quotient (* BITS_PER_ARG i) BITS_PER_MZSHORT)]) (let ([pos (quotient (* BITS_PER_ARG i) BITS_PER_MZSHORT)])

2
pkgs/zo-lib/compiler/zo-parse.rkt
View File

@ -801,7 +801,7 @@
(define n (string->number (substring (symbol->string shape) 4))) (define n (string->number (substring (symbol->string shape) 4)))
(case n (case n
[(0 1) (make-struct-type-property-shape (= n 1))] [(0 1) (make-struct-type-property-shape (= n 1))]
[(3) (make-property-predicate-shape)] [(2) (make-property-predicate-shape)]
[else (make-property-accessor-shape)])] [else (make-property-accessor-shape)])]
[else [else
;; parse symbol as ":"-separated sequence of arities ;; parse symbol as ":"-separated sequence of arities

29
racket/collects/net/http-client.rkt
View File

@ -291,6 +291,11 @@
(define abandon-p ssl-abndn-p) (define abandon-p ssl-abndn-p)
(values clt-ctx r:from r:to abandon-p)])) (values clt-ctx r:from r:to abandon-p)]))
(define (head? method-bss)
(or (equal? method-bss #"HEAD")
(equal? method-bss "HEAD")
(equal? method-bss 'HEAD)))
(define (http-conn-recv! hc (define (http-conn-recv! hc
#:method [method-bss #"GET"] #:method [method-bss #"GET"]
#:content-decode [decodes '(gzip)] #:content-decode [decodes '(gzip)]
@ -302,13 +307,9 @@
(regexp-member #rx#"^(?i:Connection: +close)$" headers))) (regexp-member #rx#"^(?i:Connection: +close)$" headers)))
(when close? (when close?
(http-conn-abandon! hc)) (http-conn-abandon! hc))
(define head?
(or (equal? method-bss #"HEAD")
(equal? method-bss "HEAD")
(equal? method-bss 'HEAD)))
(define-values (raw-response-port wait-for-close?) (define-values (raw-response-port wait-for-close?)
(cond (cond
[head? (values (open-input-bytes #"") #f)] [(head? method-bss) (values (open-input-bytes #"") #f)]
[(regexp-member #rx#"^(?i:Transfer-Encoding: +chunked)$" headers) [(regexp-member #rx#"^(?i:Transfer-Encoding: +chunked)$" headers)
(values (http-conn-response-port/chunked! hc #:close? #t) (values (http-conn-response-port/chunked! hc #:close? #t)
#t)] #t)]
@ -327,7 +328,7 @@
(values (http-conn-response-port/rest! hc) #t)])) (values (http-conn-response-port/rest! hc) #t)]))
(define decoded-response-port (define decoded-response-port
(cond (cond
[head? raw-response-port] [(head? method-bss) raw-response-port]
[(and (memq 'gzip decodes) [(and (memq 'gzip decodes)
(regexp-member #rx#"^(?i:Content-Encoding: +gzip)$" headers) (regexp-member #rx#"^(?i:Content-Encoding: +gzip)$" headers)
(not (eof-object? (peek-byte raw-response-port)))) (not (eof-object? (peek-byte raw-response-port))))
@ -377,13 +378,15 @@
#:data [data #f] #:data [data #f]
#:content-decode [decodes '(gzip)]) #:content-decode [decodes '(gzip)])
(define hc (http-conn-open host-bs #:ssl? ssl? #:port port)) (define hc (http-conn-open host-bs #:ssl? ssl? #:port port))
(http-conn-sendrecv! hc url-bs (begin0 (http-conn-sendrecv! hc url-bs
#:version version-bs #:version version-bs
#:method method-bss #:method method-bss
#:headers headers-bs #:headers headers-bs
#:data data #:data data
#:content-decode decodes #:content-decode decodes
#:close? #t)) #:close? #t)
(when (head? method-bss)
(http-conn-close! hc))))
(define data-procedure/c (define data-procedure/c
(-> (-> (or/c bytes? string?) void?) any)) (-> (-> (or/c bytes? string?) void?) any))

2
racket/collects/openssl/mzssl.rkt
View File

@ -266,7 +266,7 @@ TO DO:
(define-ssl SSL_CTX_free (_fun _SSL_CTX* -> _void) (define-ssl SSL_CTX_free (_fun _SSL_CTX* -> _void)
#:wrap (deallocator)) #:wrap (deallocator))
(define-ssl SSL_CTX_new (_fun _SSL_METHOD* -> _SSL_CTX*) (define-ssl SSL_CTX_new (_fun _SSL_METHOD* -> _SSL_CTX*/null)
#:wrap (allocator SSL_CTX_free)) #:wrap (allocator SSL_CTX_free))
(define-ssl SSL_CTX_callback_ctrl (define-ssl SSL_CTX_callback_ctrl
(_fun _SSL_CTX* _int (_fun _SSL_CTX* _int

3209
racket/collects/racket/pretty.rkt
View File

File diff suppressed because it is too large Load Diff

6
racket/collects/syntax/parse/experimental/template.rkt
View File

@ -42,6 +42,7 @@ A HeadTemplate (H) is one of:
(begin-for-syntax (begin-for-syntax
(define (do-template ctx tstx quasi? loc-id) (define (do-template ctx tstx quasi? loc-id)
(with-disappeared-uses
(parameterize ((current-syntax-context ctx) (parameterize ((current-syntax-context ctx)
(quasi (and quasi? (box null)))) (quasi (and quasi? (box null))))
(let*-values ([(guide deps props-guide) (parse-template tstx loc-id)] (let*-values ([(guide deps props-guide) (parse-template tstx loc-id)]
@ -74,7 +75,7 @@ A HeadTemplate (H) is one of:
(substitute (quote-syntax t) (substitute (quote-syntax t)
'props-guide 'props-guide
'guide 'guide
vars-vector)))]))))))) vars-vector)))]))))))))
(define-syntax (template stx) (define-syntax (template stx)
(syntax-case stx () (syntax-case stx ()
@ -599,7 +600,8 @@ instead of integers and integer vectors.
(values drivers #f guide props-guide))])) (values drivers #f guide props-guide))]))
(define (lookup id depth) (define (lookup id depth)
(let ([v (syntax-local-value id (lambda () #f))]) (let ([v (syntax-local-value/record id (lambda (v) (or (syntax-pattern-variable? v)
(template-metafunction? v))))])
(cond [(syntax-pattern-variable? v) (cond [(syntax-pattern-variable? v)
(let* ([pvar-depth (syntax-mapping-depth v)] (let* ([pvar-depth (syntax-mapping-depth v)]
[attr (syntax-local-value (syntax-mapping-valvar v) (lambda () #f))] [attr (syntax-local-value (syntax-mapping-valvar v) (lambda () #f))]

5
racket/src/racket/gc2/gc2.h
View File

@ -145,6 +145,11 @@ GC2_EXTERN intptr_t GC_get_memory_use(void *c);
Returns the number of currently-allocated bytes (speficilly for Returns the number of currently-allocated bytes (speficilly for
custodian c, as much as the GC's accounting makes possible). */ custodian c, as much as the GC's accounting makes possible). */
GC2_EXTERN intptr_t GC_get_memory_ever_allocated();
/*
Returns the number of total number of allocated bytes, including
bytes that have since been reclaimed. */
GC2_EXTERN int GC_accouting_enabled(); GC2_EXTERN int GC_accouting_enabled();
/* /*
Reports whether memory accounting is enabled. */ Reports whether memory accounting is enabled. */

21
racket/src/racket/gc2/newgc.c
View File

@ -41,6 +41,9 @@
/* Avoid incremental GC if the heap seems to be getting too fragmented: */ /* Avoid incremental GC if the heap seems to be getting too fragmented: */
#define HIGH_FRAGMENTATION_RATIO 2 #define HIGH_FRAGMENTATION_RATIO 2
/* Initial and minimum value to treat as previous use after a full GC: */
#define INITIAL_FULL_MEMORY_USE (20 * 1024 * 1024)
/* Whether to use a little aging, moving gen-0 objects to a /* Whether to use a little aging, moving gen-0 objects to a
gen-1/2 space: */ gen-1/2 space: */
#define AGE_GEN_0_TO_GEN_HALF(gc) ((gc)->started_incremental) #define AGE_GEN_0_TO_GEN_HALF(gc) ((gc)->started_incremental)
@ -745,7 +748,7 @@ static void NewGC_initialize(NewGC *newgc, NewGC *inheritgc, NewGC *parentgc) {
newgc->mmu = mmu_create(newgc); newgc->mmu = mmu_create(newgc);
newgc->generations_available = 1; newgc->generations_available = 1;
newgc->last_full_mem_use = (20 * 1024 * 1024); newgc->last_full_mem_use = INITIAL_FULL_MEMORY_USE;
newgc->new_btc_mark = 1; newgc->new_btc_mark = 1;
newgc->place_memory_limit = (uintptr_t)(intptr_t)-1; newgc->place_memory_limit = (uintptr_t)(intptr_t)-1;
@ -973,6 +976,16 @@ intptr_t GC_get_memory_use(void *o)
return (intptr_t)amt; return (intptr_t)amt;
} }
intptr_t GC_get_memory_ever_allocated()
{
NewGC *gc = GC_get_GC();
uintptr_t amt;
amt = add_no_overflow(gen0_size_in_use(gc), gc->total_memory_allocated);
return (intptr_t)amt;
}
/*****************************************************************************/ /*****************************************************************************/
/* Write barrier */ /* Write barrier */
/* */ /* */
@ -5314,6 +5327,8 @@ static void garbage_collect(NewGC *gc, int force_full, int no_full,
old_gen0 = gen0_size_in_use(gc) + gc->gen0_phantom_count; old_gen0 = gen0_size_in_use(gc) + gc->gen0_phantom_count;
old_mem_allocated = mmu_memory_allocated(gc->mmu) + gc->phantom_count + gc->gen0_phantom_count; old_mem_allocated = mmu_memory_allocated(gc->mmu) + gc->phantom_count + gc->gen0_phantom_count;
gc->total_memory_allocated += old_gen0;
TIME_DECLS(); TIME_DECLS();
dump_page_map(gc, "pre"); dump_page_map(gc, "pre");
@ -5334,7 +5349,9 @@ static void garbage_collect(NewGC *gc, int force_full, int no_full,
This approach makes total memory use roughly a constant This approach makes total memory use roughly a constant
fraction of the actual use by live data: */ fraction of the actual use by live data: */
|| (gc->memory_in_use > (FULL_COLLECTION_SIZE_RATIO || (gc->memory_in_use > (FULL_COLLECTION_SIZE_RATIO
* gc->last_full_mem_use * ((gc->last_full_mem_use < INITIAL_FULL_MEMORY_USE)
? INITIAL_FULL_MEMORY_USE
: gc->last_full_mem_use)
* (gc->incremental_requested * (gc->incremental_requested
? INCREMENTAL_EXTRA_SIZE_RATIO ? INCREMENTAL_EXTRA_SIZE_RATIO
: 1))) : 1)))

2
racket/src/racket/gc2/newgc.h
View File

@ -312,6 +312,8 @@ typedef struct NewGC {
uintptr_t minor_old_skipped; uintptr_t minor_old_skipped;
uintptr_t modified_unprotects; uintptr_t modified_unprotects;
uintptr_t total_memory_allocated; /* doesn't include current gen0 */
/* THREAD_LOCAL variables that need to be saved off */ /* THREAD_LOCAL variables that need to be saved off */
void *saved_GC_variable_stack; void *saved_GC_variable_stack;
uintptr_t saved_GC_gen0_alloc_page_ptr; uintptr_t saved_GC_gen0_alloc_page_ptr;

4
racket/src/racket/include/scheme.h
View File

@ -1543,6 +1543,8 @@ struct Scheme_Input_Port
#endif #endif
}; };
#define SCHEME_INPORT_VAL(i) (((Scheme_Input_Port *)i)->port_data)
struct Scheme_Output_Port struct Scheme_Output_Port
{ {
struct Scheme_Port p; struct Scheme_Port p;
@ -1566,6 +1568,8 @@ struct Scheme_Output_Port
struct Scheme_Input_Port *input_half; struct Scheme_Input_Port *input_half;
}; };
#define SCHEME_OUTPORT_VAL(o) (((Scheme_Output_Port *)o)->port_data)
#define SCHEME_SPECIAL (-2) #define SCHEME_SPECIAL (-2)
#define SCHEME_UNLESS_READY (-3) #define SCHEME_UNLESS_READY (-3)

4
racket/src/racket/include/schthread.h
View File

@ -337,6 +337,8 @@ typedef struct Thread_Local_Variables {
struct Scheme_Thread *main_break_target_thread_; struct Scheme_Thread *main_break_target_thread_;
intptr_t scheme_code_page_total_; intptr_t scheme_code_page_total_;
intptr_t max_gc_pre_used_bytes_; intptr_t max_gc_pre_used_bytes_;
int num_major_garbage_collections_;
int num_minor_garbage_collections_;
int locale_on_; int locale_on_;
void *current_locale_name_ptr_; void *current_locale_name_ptr_;
int gensym_counter_; int gensym_counter_;
@ -736,6 +738,8 @@ XFORM_GC_VARIABLE_STACK_THROUGH_THREAD_LOCAL;
#define main_break_target_thread XOA (scheme_get_thread_local_variables()->main_break_target_thread_) #define main_break_target_thread XOA (scheme_get_thread_local_variables()->main_break_target_thread_)
#define scheme_code_page_total XOA (scheme_get_thread_local_variables()->scheme_code_page_total_) #define scheme_code_page_total XOA (scheme_get_thread_local_variables()->scheme_code_page_total_)
#define max_gc_pre_used_bytes XOA (scheme_get_thread_local_variables()->max_gc_pre_used_bytes_) #define max_gc_pre_used_bytes XOA (scheme_get_thread_local_variables()->max_gc_pre_used_bytes_)
#define num_major_garbage_collections XOA (scheme_get_thread_local_variables()->num_major_garbage_collections_)
#define num_minor_garbage_collections XOA (scheme_get_thread_local_variables()->num_minor_garbage_collections_)
#define locale_on XOA (scheme_get_thread_local_variables()->locale_on_) #define locale_on XOA (scheme_get_thread_local_variables()->locale_on_)
#define current_locale_name_ptr XOA (scheme_get_thread_local_variables()->current_locale_name_ptr_) #define current_locale_name_ptr XOA (scheme_get_thread_local_variables()->current_locale_name_ptr_)
#define gensym_counter XOA (scheme_get_thread_local_variables()->gensym_counter_) #define gensym_counter XOA (scheme_get_thread_local_variables()->gensym_counter_)

16
racket/src/racket/sgc/sgc.c
View File

@ -799,7 +799,7 @@ static intptr_t mem_use, mem_limit = FIRST_GC_LIMIT;
int GC_free_space_divisor = 4; int GC_free_space_divisor = 4;
#endif #endif
static intptr_t mem_real_use, mem_uncollectable_use; static intptr_t mem_real_use, mem_uncollectable_use, mem_cumulative_use;
static intptr_t sector_mem_use, sector_admin_mem_use, sector_free_mem_use; static intptr_t sector_mem_use, sector_admin_mem_use, sector_free_mem_use;
static intptr_t manage_mem_use, manage_real_mem_use; static intptr_t manage_mem_use, manage_real_mem_use;
@ -2230,11 +2230,14 @@ void GC_dump(void)
FPRINTF(STDERR, "End Map\n"); FPRINTF(STDERR, "End Map\n");
} }
long GC_get_memory_use() size_t GC_get_memory_use()
{ {
/* returns a `long' instead of `intptr_t' for compatibility return (size_t)mem_real_use;
with the Boehm GC */ }
return (long)mem_real_use;
size_t GC_get_total_bytes()
{
return (size_t)mem_cumulative_use;
} }
void GC_end_stubborn_change(void *p) void GC_end_stubborn_change(void *p)
@ -2504,6 +2507,7 @@ static void *do_malloc(SET_NO_BACKINFO
else else
mem_use += size; mem_use += size;
mem_real_use += (size + sizeof(MemoryChunk)); mem_real_use += (size + sizeof(MemoryChunk));
mem_cumulative_use += (size + sizeof(MemoryChunk));
num_chunks++; num_chunks++;
if (!low_plausible || (c->start < low_plausible)) if (!low_plausible || (c->start < low_plausible))
@ -2642,6 +2646,7 @@ static void *do_malloc(SET_NO_BACKINFO
high_plausible = block->end; high_plausible = block->end;
mem_real_use += SECTOR_SEGMENT_SIZE; mem_real_use += SECTOR_SEGMENT_SIZE;
mem_cumulative_use += SECTOR_SEGMENT_SIZE;
block_top: block_top:
@ -2950,6 +2955,7 @@ static void register_finalizer(void *p, void (*f)(void *p, void *data),
if (!fn) { if (!fn) {
fn = (Finalizer *)malloc_managed(sizeof(Finalizer)); fn = (Finalizer *)malloc_managed(sizeof(Finalizer));
mem_real_use += sizeof(Finalizer); mem_real_use += sizeof(Finalizer);
mem_cumulative_use += sizeof(Finalizer);
GC_fo_entries++; GC_fo_entries++;
} }

3
racket/src/racket/sgc/sgc.h
View File

@ -35,7 +35,8 @@ SGC_EXTERN void *GC_base(void *);
SGC_EXTERN void GC_dump(void); SGC_EXTERN void GC_dump(void);
SGC_EXTERN long GC_get_memory_use(); SGC_EXTERN size_t GC_get_memory_use();
SGC_EXTERN size_t GC_get_total_bytes();
SGC_EXTERN void GC_end_stubborn_change(void *); SGC_EXTERN void GC_end_stubborn_change(void *);

4
racket/src/racket/src/eval.c
View File

@ -2251,6 +2251,8 @@ scheme_case_lambda_execute(Scheme_Object *expr)
int i, cnt; int i, cnt;
Scheme_Thread *p = scheme_current_thread; Scheme_Thread *p = scheme_current_thread;
DEBUG_COUNT_ALLOCATION(expr);
seqin = (Scheme_Case_Lambda *)expr; seqin = (Scheme_Case_Lambda *)expr;
#ifdef MZ_USE_JIT #ifdef MZ_USE_JIT
@ -2502,6 +2504,8 @@ scheme_make_closure(Scheme_Thread *p, Scheme_Object *code, int close)
GC_CAN_IGNORE mzshort *map; GC_CAN_IGNORE mzshort *map;
int i; int i;
DEBUG_COUNT_ALLOCATION(code);
data = (Scheme_Lambda *)code; data = (Scheme_Lambda *)code;
#ifdef MZ_USE_JIT #ifdef MZ_USE_JIT

1
racket/src/racket/src/gen-jit-ts.rkt
View File

@ -191,6 +191,7 @@
s_v s_v
iSi_s iSi_s
siS_v siS_v
Sii_s
z_p z_p
si_s si_s
sis_v sis_v

9
racket/src/racket/src/hash.c
View File

@ -246,6 +246,8 @@ Scheme_Hash_Table *scheme_make_hash_table(int type)
{ {
Scheme_Hash_Table *table; Scheme_Hash_Table *table;
DEBUG_COUNT_ALLOCATION(scheme_make_integer(scheme_hash_table_type));
table = MALLOC_ONE_TAGGED(Scheme_Hash_Table); table = MALLOC_ONE_TAGGED(Scheme_Hash_Table);
table->size = 0; table->size = 0;
@ -640,6 +642,8 @@ Scheme_Hash_Table *scheme_clone_hash_table(Scheme_Hash_Table *ht)
Scheme_Hash_Table *table; Scheme_Hash_Table *table;
Scheme_Object **ba; Scheme_Object **ba;
DEBUG_COUNT_ALLOCATION(scheme_make_integer(scheme_hash_table_type));
table = MALLOC_ONE_TAGGED(Scheme_Hash_Table); table = MALLOC_ONE_TAGGED(Scheme_Hash_Table);
memcpy(table, ht, sizeof(Scheme_Hash_Table)); memcpy(table, ht, sizeof(Scheme_Hash_Table));
MZ_OPT_HASH_KEY(&(table->iso)) = 0; MZ_OPT_HASH_KEY(&(table->iso)) = 0;
@ -723,6 +727,8 @@ scheme_make_bucket_table (intptr_t size, int type)
Scheme_Bucket_Table *table; Scheme_Bucket_Table *table;
size_t asize; size_t asize;
DEBUG_COUNT_ALLOCATION(scheme_make_integer(scheme_bucket_table_type));
table = MALLOC_ONE_TAGGED(Scheme_Bucket_Table); table = MALLOC_ONE_TAGGED(Scheme_Bucket_Table);
table->size = 4; table->size = 4;
@ -1119,6 +1125,8 @@ Scheme_Bucket_Table *scheme_clone_bucket_table(Scheme_Bucket_Table *bt)
Scheme_Bucket_Table *table; Scheme_Bucket_Table *table;
size_t asize; size_t asize;
DEBUG_COUNT_ALLOCATION(scheme_make_integer(scheme_bucket_table_type));
table = MALLOC_ONE_TAGGED(Scheme_Bucket_Table); table = MALLOC_ONE_TAGGED(Scheme_Bucket_Table);
table->so.type = scheme_bucket_table_type; table->so.type = scheme_bucket_table_type;
table->size = bt->size; table->size = bt->size;
@ -2562,6 +2570,7 @@ XFORM_NONGCING static Scheme_Hash_Tree *hamt_assoc(Scheme_Hash_Tree *ht, uintptr
static Scheme_Hash_Tree *hamt_alloc(int kind, int popcount) static Scheme_Hash_Tree *hamt_alloc(int kind, int popcount)
/* be sure to set `bitmap` field before a GC becomes possible */ /* be sure to set `bitmap` field before a GC becomes possible */
{ {
DEBUG_COUNT_ALLOCATION(scheme_make_integer(scheme_hash_tree_type));
return (Scheme_Hash_Tree *)scheme_malloc_small_tagged(HASH_TREE_RECORD_SIZE(kind, popcount)); return (Scheme_Hash_Tree *)scheme_malloc_small_tagged(HASH_TREE_RECORD_SIZE(kind, popcount));
} }

2
racket/src/racket/src/jit.h
View File

@ -319,7 +319,7 @@ struct scheme_jit_common_record {
void *flvector_ref_check_index_code[JIT_NUM_FL_KINDS]; void *flvector_ref_check_index_code[JIT_NUM_FL_KINDS];
void *flvector_set_check_index_code[JIT_NUM_FL_KINDS], *flvector_set_flonum_check_index_code[JIT_NUM_FL_KINDS]; void *flvector_set_check_index_code[JIT_NUM_FL_KINDS], *flvector_set_flonum_check_index_code[JIT_NUM_FL_KINDS];
void *fxvector_ref_code, *fxvector_ref_check_index_code, *fxvector_set_code, *fxvector_set_check_index_code; void *fxvector_ref_code, *fxvector_ref_check_index_code, *fxvector_set_code, *fxvector_set_check_index_code;
void *struct_raw_ref_code, *struct_raw_set_code; void *struct_raw_ref_code, *struct_raw_set_code, *struct_raw_refs_code;
void *syntax_e_code; void *syntax_e_code;
void *on_demand_jit_arity_code, *in_progress_on_demand_jit_arity_code; void *on_demand_jit_arity_code, *in_progress_on_demand_jit_arity_code;
void *get_stack_pointer_code; void *get_stack_pointer_code;

2
racket/src/racket/src/jit_ts.c
View File

@ -96,6 +96,7 @@ define_ts_ss_s(scheme_byte_string_eq_2, FSRC_MARKS)
define_ts_s_s(scheme_unbox, FSRC_MARKS) define_ts_s_s(scheme_unbox, FSRC_MARKS)
define_ts_si_s(scheme_struct_ref, FSRC_MARKS) define_ts_si_s(scheme_struct_ref, FSRC_MARKS)
define_ts_sis_v(scheme_struct_set, FSRC_MARKS) define_ts_sis_v(scheme_struct_set, FSRC_MARKS)
define_ts_Sii_s(unsafe_struct_refs, FSRC_MARKS)
define_ts_iS_s(scheme_extract_checked_procedure, FSRC_MARKS) define_ts_iS_s(scheme_extract_checked_procedure, FSRC_MARKS)
define_ts_iS_s(scheme_procedure_arity_includes, FSRC_MARKS) define_ts_iS_s(scheme_procedure_arity_includes, FSRC_MARKS)
define_ts_ssi_s(vector_check_chaperone_of, FSRC_MARKS) define_ts_ssi_s(vector_check_chaperone_of, FSRC_MARKS)
@ -219,6 +220,7 @@ define_ts_s_s(scheme_box, FSRC_OTHER)
# define ts_scheme_byte_string_length scheme_byte_string_length # define ts_scheme_byte_string_length scheme_byte_string_length
# define ts_scheme_struct_ref scheme_struct_ref # define ts_scheme_struct_ref scheme_struct_ref
# define ts_scheme_struct_set scheme_struct_set # define ts_scheme_struct_set scheme_struct_set
# define ts_unsafe_struct_refs unsafe_struct_refs
# define ts_equal_as_bool equal_as_bool # define ts_equal_as_bool equal_as_bool
# define ts_scheme_string_eq_2 scheme_string_eq_2 # define ts_scheme_string_eq_2 scheme_string_eq_2
# define ts_scheme_byte_string_eq_2 scheme_byte_string_eq_2 # define ts_scheme_byte_string_eq_2 scheme_byte_string_eq_2

53
racket/src/racket/src/jit_ts_def.c
View File

@ -187,59 +187,68 @@ static void ts_ ## id(Scheme_Object* g216, int g217, Scheme_Object** g218) \
else \ else \
id(g216, g217, g218); \ id(g216, g217, g218); \
} }
#define define_ts_z_p(id, src_type) \ #define define_ts_Sii_s(id, src_type) \
static void* ts_ ## id(size_t g219) \ static Scheme_Object* ts_ ## id(Scheme_Object** g219, int g220, int g221) \
XFORM_SKIP_PROC \ XFORM_SKIP_PROC \
{ \ { \
if (scheme_use_rtcall) \ if (scheme_use_rtcall) \
return scheme_rtcall_z_p("[" #id "]", src_type, id, g219); \ return scheme_rtcall_Sii_s("[" #id "]", src_type, id, g219, g220, g221); \
else \ else \
return id(g219); \ return id(g219, g220, g221); \
}
#define define_ts_z_p(id, src_type) \
static void* ts_ ## id(size_t g222) \
XFORM_SKIP_PROC \
{ \
if (scheme_use_rtcall) \
return scheme_rtcall_z_p("[" #id "]", src_type, id, g222); \
else \
return id(g222); \
} }
#define define_ts_si_s(id, src_type) \ #define define_ts_si_s(id, src_type) \
static Scheme_Object* ts_ ## id(Scheme_Object* g220, int g221) \ static Scheme_Object* ts_ ## id(Scheme_Object* g223, int g224) \
XFORM_SKIP_PROC \ XFORM_SKIP_PROC \
{ \ { \
if (scheme_use_rtcall) \ if (scheme_use_rtcall) \
return scheme_rtcall_si_s("[" #id "]", src_type, id, g220, g221); \ return scheme_rtcall_si_s("[" #id "]", src_type, id, g223, g224); \
else \ else \
return id(g220, g221); \ return id(g223, g224); \
} }
#define define_ts_sis_v(id, src_type) \ #define define_ts_sis_v(id, src_type) \
static void ts_ ## id(Scheme_Object* g222, int g223, Scheme_Object* g224) \ static void ts_ ## id(Scheme_Object* g225, int g226, Scheme_Object* g227) \
XFORM_SKIP_PROC \ XFORM_SKIP_PROC \
{ \ { \
if (scheme_use_rtcall) \ if (scheme_use_rtcall) \
scheme_rtcall_sis_v("[" #id "]", src_type, id, g222, g223, g224); \ scheme_rtcall_sis_v("[" #id "]", src_type, id, g225, g226, g227); \
else \ else \
id(g222, g223, g224); \ id(g225, g226, g227); \
} }
#define define_ts_ss_i(id, src_type) \ #define define_ts_ss_i(id, src_type) \
static int ts_ ## id(Scheme_Object* g225, Scheme_Object* g226) \ static int ts_ ## id(Scheme_Object* g228, Scheme_Object* g229) \
XFORM_SKIP_PROC \ XFORM_SKIP_PROC \
{ \ { \
if (scheme_use_rtcall) \ if (scheme_use_rtcall) \
return scheme_rtcall_ss_i("[" #id "]", src_type, id, g225, g226); \ return scheme_rtcall_ss_i("[" #id "]", src_type, id, g228, g229); \
else \ else \
return id(g225, g226); \ return id(g228, g229); \
} }
#define define_ts_iSp_v(id, src_type) \ #define define_ts_iSp_v(id, src_type) \
static void ts_ ## id(int g227, Scheme_Object** g228, void* g229) \ static void ts_ ## id(int g230, Scheme_Object** g231, void* g232) \
XFORM_SKIP_PROC \ XFORM_SKIP_PROC \
{ \ { \
if (scheme_use_rtcall) \ if (scheme_use_rtcall) \
scheme_rtcall_iSp_v("[" #id "]", src_type, id, g227, g228, g229); \ scheme_rtcall_iSp_v("[" #id "]", src_type, id, g230, g231, g232); \
else \ else \
id(g227, g228, g229); \ id(g230, g231, g232); \
} }
#define define_ts_sss_s(id, src_type) \ #define define_ts_sss_s(id, src_type) \
static Scheme_Object* ts_ ## id(Scheme_Object* g230, Scheme_Object* g231, Scheme_Object* g232) \ static Scheme_Object* ts_ ## id(Scheme_Object* g233, Scheme_Object* g234, Scheme_Object* g235) \
XFORM_SKIP_PROC \ XFORM_SKIP_PROC \
{ \ { \
if (scheme_use_rtcall) \ if (scheme_use_rtcall) \
return scheme_rtcall_sss_s("[" #id "]", src_type, id, g230, g231, g232); \ return scheme_rtcall_sss_s("[" #id "]", src_type, id, g233, g234, g235); \
else \ else \
return id(g230, g231, g232); \ return id(g233, g234, g235); \
} }
#define define_ts__v(id, src_type) \ #define define_ts__v(id, src_type) \
static void ts_ ## id() \ static void ts_ ## id() \
@ -251,11 +260,11 @@ static void ts_ ## id() \
id(); \ id(); \
} }
#define define_ts_iS_v(id, src_type) \ #define define_ts_iS_v(id, src_type) \
static void ts_ ## id(int g233, Scheme_Object** g234) \ static void ts_ ## id(int g236, Scheme_Object** g237) \
XFORM_SKIP_PROC \ XFORM_SKIP_PROC \
{ \ { \
if (scheme_use_rtcall) \ if (scheme_use_rtcall) \
scheme_rtcall_iS_v("[" #id "]", src_type, id, g233, g234); \ scheme_rtcall_iS_v("[" #id "]", src_type, id, g236, g237); \
else \ else \
id(g233, g234); \ id(g236, g237); \
} }

199
racket/src/racket/src/jit_ts_future_glue.c
View File

@ -1,4 +1,4 @@
Scheme_Object* scheme_rtcall_siS_s(const char *who, int src_type, prim_siS_s f, Scheme_Object* g235, int g236, Scheme_Object** g237) Scheme_Object* scheme_rtcall_siS_s(const char *who, int src_type, prim_siS_s f, Scheme_Object* g238, int g239, Scheme_Object** g240)
XFORM_SKIP_PROC XFORM_SKIP_PROC
{ {
Scheme_Future_Thread_State *fts = scheme_future_thread_state; Scheme_Future_Thread_State *fts = scheme_future_thread_state;
@ -13,9 +13,9 @@
future->time_of_request = tm; future->time_of_request = tm;
future->source_of_request = who; future->source_of_request = who;
future->source_type = src_type; future->source_type = src_type;
future->arg_s0 = g235; future->arg_s0 = g238;
future->arg_i1 = g236; future->arg_i1 = g239;
future->arg_S2 = g237; future->arg_S2 = g240;
future_do_runtimecall(fts, (void*)f, 0, 1, 0); future_do_runtimecall(fts, (void*)f, 0, 1, 0);
fts->thread = scheme_current_thread; fts->thread = scheme_current_thread;
@ -25,7 +25,7 @@
receive_special_result(future, retval, 1); receive_special_result(future, retval, 1);
return retval; return retval;
} }
Scheme_Object* scheme_rtcall_iSs_s(const char *who, int src_type, prim_iSs_s f, int g238, Scheme_Object** g239, Scheme_Object* g240) Scheme_Object* scheme_rtcall_iSs_s(const char *who, int src_type, prim_iSs_s f, int g241, Scheme_Object** g242, Scheme_Object* g243)
XFORM_SKIP_PROC XFORM_SKIP_PROC
{ {
Scheme_Future_Thread_State *fts = scheme_future_thread_state; Scheme_Future_Thread_State *fts = scheme_future_thread_state;
@ -40,9 +40,9 @@
future->time_of_request = tm; future->time_of_request = tm;
future->source_of_request = who; future->source_of_request = who;
future->source_type = src_type; future->source_type = src_type;
future->arg_i0 = g238; future->arg_i0 = g241;
future->arg_S1 = g239; future->arg_S1 = g242;
future->arg_s2 = g240; future->arg_s2 = g243;
future_do_runtimecall(fts, (void*)f, 0, 1, 0); future_do_runtimecall(fts, (void*)f, 0, 1, 0);
fts->thread = scheme_current_thread; fts->thread = scheme_current_thread;
@ -52,7 +52,7 @@
receive_special_result(future, retval, 1); receive_special_result(future, retval, 1);
return retval; return retval;
} }
Scheme_Object* scheme_rtcall_s_s(const char *who, int src_type, prim_s_s f, Scheme_Object* g241) Scheme_Object* scheme_rtcall_s_s(const char *who, int src_type, prim_s_s f, Scheme_Object* g244)
XFORM_SKIP_PROC XFORM_SKIP_PROC
{ {
Scheme_Future_Thread_State *fts = scheme_future_thread_state; Scheme_Future_Thread_State *fts = scheme_future_thread_state;
@ -67,8 +67,8 @@
future->time_of_request = tm; future->time_of_request = tm;
future->source_of_request = who; future->source_of_request = who;
future->source_type = src_type; future->source_type = src_type;
future->arg_s0 = g241; future->arg_s0 = g244;
send_special_result(future, g241); send_special_result(future, g244);
future_do_runtimecall(fts, (void*)f, 0, 1, 0); future_do_runtimecall(fts, (void*)f, 0, 1, 0);
fts->thread = scheme_current_thread; fts->thread = scheme_current_thread;
future = fts->thread->current_ft; future = fts->thread->current_ft;
@ -77,7 +77,7 @@
receive_special_result(future, retval, 1); receive_special_result(future, retval, 1);
return retval; return retval;
} }
Scheme_Object* scheme_rtcall_n_s(const char *who, int src_type, prim_n_s f, Scheme_Native_Lambda* g242) Scheme_Object* scheme_rtcall_n_s(const char *who, int src_type, prim_n_s f, Scheme_Native_Lambda* g245)
XFORM_SKIP_PROC XFORM_SKIP_PROC
{ {
Scheme_Future_Thread_State *fts = scheme_future_thread_state; Scheme_Future_Thread_State *fts = scheme_future_thread_state;
@ -92,7 +92,7 @@
future->time_of_request = tm; future->time_of_request = tm;
future->source_of_request = who; future->source_of_request = who;
future->source_type = src_type; future->source_type = src_type;
future->arg_n0 = g242; future->arg_n0 = g245;
future_do_runtimecall(fts, (void*)f, 0, 1, 0); future_do_runtimecall(fts, (void*)f, 0, 1, 0);
fts->thread = scheme_current_thread; fts->thread = scheme_current_thread;
@ -127,7 +127,7 @@
receive_special_result(future, retval, 1); receive_special_result(future, retval, 1);
return retval; return retval;
} }
Scheme_Object* scheme_rtcall_ss_s(const char *who, int src_type, prim_ss_s f, Scheme_Object* g243, Scheme_Object* g244) Scheme_Object* scheme_rtcall_ss_s(const char *who, int src_type, prim_ss_s f, Scheme_Object* g246, Scheme_Object* g247)
XFORM_SKIP_PROC XFORM_SKIP_PROC
{ {
Scheme_Future_Thread_State *fts = scheme_future_thread_state; Scheme_Future_Thread_State *fts = scheme_future_thread_state;
@ -142,8 +142,8 @@
future->time_of_request = tm; future->time_of_request = tm;
future->source_of_request = who; future->source_of_request = who;
future->source_type = src_type; future->source_type = src_type;
future->arg_s0 = g243; future->arg_s0 = g246;
future->arg_s1 = g244; future->arg_s1 = g247;
future_do_runtimecall(fts, (void*)f, 0, 1, 0); future_do_runtimecall(fts, (void*)f, 0, 1, 0);
fts->thread = scheme_current_thread; fts->thread = scheme_current_thread;
@ -153,7 +153,7 @@
receive_special_result(future, retval, 1); receive_special_result(future, retval, 1);
return retval; return retval;
} }
Scheme_Object* scheme_rtcall_ssi_s(const char *who, int src_type, prim_ssi_s f, Scheme_Object* g245, Scheme_Object* g246, int g247) Scheme_Object* scheme_rtcall_ssi_s(const char *who, int src_type, prim_ssi_s f, Scheme_Object* g248, Scheme_Object* g249, int g250)
XFORM_SKIP_PROC XFORM_SKIP_PROC
{ {
Scheme_Future_Thread_State *fts = scheme_future_thread_state; Scheme_Future_Thread_State *fts = scheme_future_thread_state;
@ -168,9 +168,9 @@
future->time_of_request = tm; future->time_of_request = tm;
future->source_of_request = who; future->source_of_request = who;
future->source_type = src_type; future->source_type = src_type;
future->arg_s0 = g245; future->arg_s0 = g248;
future->arg_s1 = g246; future->arg_s1 = g249;
future->arg_i2 = g247; future->arg_i2 = g250;
future_do_runtimecall(fts, (void*)f, 0, 1, 0); future_do_runtimecall(fts, (void*)f, 0, 1, 0);
fts->thread = scheme_current_thread; fts->thread = scheme_current_thread;
@ -180,7 +180,7 @@
receive_special_result(future, retval, 1); receive_special_result(future, retval, 1);
return retval; return retval;
} }
Scheme_Object* scheme_rtcall_tt_s(const char *who, int src_type, prim_tt_s f, const Scheme_Object* g248, const Scheme_Object* g249) Scheme_Object* scheme_rtcall_tt_s(const char *who, int src_type, prim_tt_s f, const Scheme_Object* g251, const Scheme_Object* g252)
XFORM_SKIP_PROC XFORM_SKIP_PROC
{ {
Scheme_Future_Thread_State *fts = scheme_future_thread_state; Scheme_Future_Thread_State *fts = scheme_future_thread_state;
@ -195,8 +195,8 @@
future->time_of_request = tm; future->time_of_request = tm;
future->source_of_request = who; future->source_of_request = who;
future->source_type = src_type; future->source_type = src_type;
future->arg_t0 = g248; future->arg_t0 = g251;
future->arg_t1 = g249; future->arg_t1 = g252;
future_do_runtimecall(fts, (void*)f, 0, 1, 0); future_do_runtimecall(fts, (void*)f, 0, 1, 0);
fts->thread = scheme_current_thread; fts->thread = scheme_current_thread;
@ -206,7 +206,7 @@
receive_special_result(future, retval, 1); receive_special_result(future, retval, 1);
return retval; return retval;
} }
MZ_MARK_STACK_TYPE scheme_rtcall_ss_m(const char *who, int src_type, prim_ss_m f, Scheme_Object* g250, Scheme_Object* g251) MZ_MARK_STACK_TYPE scheme_rtcall_ss_m(const char *who, int src_type, prim_ss_m f, Scheme_Object* g253, Scheme_Object* g254)
XFORM_SKIP_PROC XFORM_SKIP_PROC
{ {
Scheme_Future_Thread_State *fts = scheme_future_thread_state; Scheme_Future_Thread_State *fts = scheme_future_thread_state;
@ -221,8 +221,8 @@
future->time_of_request = tm; future->time_of_request = tm;
future->source_of_request = who; future->source_of_request = who;
future->source_type = src_type; future->source_type = src_type;
future->arg_s0 = g250; future->arg_s0 = g253;
future->arg_s1 = g251; future->arg_s1 = g254;
future_do_runtimecall(fts, (void*)f, 0, 1, 0); future_do_runtimecall(fts, (void*)f, 0, 1, 0);
fts->thread = scheme_current_thread; fts->thread = scheme_current_thread;
@ -232,7 +232,7 @@
return retval; return retval;
} }
Scheme_Object* scheme_rtcall_Sl_s(const char *who, int src_type, prim_Sl_s f, Scheme_Object** g252, intptr_t g253) Scheme_Object* scheme_rtcall_Sl_s(const char *who, int src_type, prim_Sl_s f, Scheme_Object** g255, intptr_t g256)
XFORM_SKIP_PROC XFORM_SKIP_PROC
{ {
Scheme_Future_Thread_State *fts = scheme_future_thread_state; Scheme_Future_Thread_State *fts = scheme_future_thread_state;
@ -247,8 +247,8 @@
future->time_of_request = tm; future->time_of_request = tm;
future->source_of_request = who; future->source_of_request = who;
future->source_type = src_type; future->source_type = src_type;
future->arg_S0 = g252; future->arg_S0 = g255;
future->arg_l1 = g253; future->arg_l1 = g256;
future_do_runtimecall(fts, (void*)f, 0, 1, 0); future_do_runtimecall(fts, (void*)f, 0, 1, 0);
fts->thread = scheme_current_thread; fts->thread = scheme_current_thread;
@ -258,7 +258,7 @@
receive_special_result(future, retval, 1); receive_special_result(future, retval, 1);
return retval; return retval;
} }
Scheme_Object* scheme_rtcall_l_s(const char *who, int src_type, prim_l_s f, intptr_t g254) Scheme_Object* scheme_rtcall_l_s(const char *who, int src_type, prim_l_s f, intptr_t g257)
XFORM_SKIP_PROC XFORM_SKIP_PROC
{ {
Scheme_Future_Thread_State *fts = scheme_future_thread_state; Scheme_Future_Thread_State *fts = scheme_future_thread_state;
@ -273,7 +273,7 @@
future->time_of_request = tm; future->time_of_request = tm;
future->source_of_request = who; future->source_of_request = who;
future->source_type = src_type; future->source_type = src_type;
future->arg_l0 = g254; future->arg_l0 = g257;
future_do_runtimecall(fts, (void*)f, 0, 1, 0); future_do_runtimecall(fts, (void*)f, 0, 1, 0);
fts->thread = scheme_current_thread; fts->thread = scheme_current_thread;
@ -283,7 +283,7 @@
receive_special_result(future, retval, 1); receive_special_result(future, retval, 1);
return retval; return retval;
} }
void scheme_rtcall_bsi_v(const char *who, int src_type, prim_bsi_v f, Scheme_Bucket* g255, Scheme_Object* g256, int g257) void scheme_rtcall_bsi_v(const char *who, int src_type, prim_bsi_v f, Scheme_Bucket* g258, Scheme_Object* g259, int g260)
XFORM_SKIP_PROC XFORM_SKIP_PROC
{ {
Scheme_Future_Thread_State *fts = scheme_future_thread_state; Scheme_Future_Thread_State *fts = scheme_future_thread_state;
@ -298,9 +298,9 @@
future->time_of_request = tm; future->time_of_request = tm;
future->source_of_request = who; future->source_of_request = who;
future->source_type = src_type; future->source_type = src_type;
future->arg_b0 = g255; future->arg_b0 = g258;
future->arg_s1 = g256; future->arg_s1 = g259;
future->arg_i2 = g257; future->arg_i2 = g260;
future_do_runtimecall(fts, (void*)f, 0, 1, 0); future_do_runtimecall(fts, (void*)f, 0, 1, 0);
fts->thread = scheme_current_thread; fts->thread = scheme_current_thread;
@ -310,7 +310,7 @@
} }
void scheme_rtcall_iiS_v(const char *who, int src_type, prim_iiS_v f, int g258, int g259, Scheme_Object** g260) void scheme_rtcall_iiS_v(const char *who, int src_type, prim_iiS_v f, int g261, int g262, Scheme_Object** g263)
XFORM_SKIP_PROC XFORM_SKIP_PROC
{ {
Scheme_Future_Thread_State *fts = scheme_future_thread_state; Scheme_Future_Thread_State *fts = scheme_future_thread_state;
@ -325,9 +325,9 @@
future->time_of_request = tm; future->time_of_request = tm;
future->source_of_request = who; future->source_of_request = who;
future->source_type = src_type; future->source_type = src_type;
future->arg_i0 = g258; future->arg_i0 = g261;
future->arg_i1 = g259; future->arg_i1 = g262;
future->arg_S2 = g260; future->arg_S2 = g263;
future_do_runtimecall(fts, (void*)f, 0, 1, 0); future_do_runtimecall(fts, (void*)f, 0, 1, 0);
fts->thread = scheme_current_thread; fts->thread = scheme_current_thread;
@ -337,7 +337,7 @@
} }
void scheme_rtcall_ss_v(const char *who, int src_type, prim_ss_v f, Scheme_Object* g261, Scheme_Object* g262) void scheme_rtcall_ss_v(const char *who, int src_type, prim_ss_v f, Scheme_Object* g264, Scheme_Object* g265)
XFORM_SKIP_PROC XFORM_SKIP_PROC
{ {
Scheme_Future_Thread_State *fts = scheme_future_thread_state; Scheme_Future_Thread_State *fts = scheme_future_thread_state;
@ -352,8 +352,8 @@
future->time_of_request = tm; future->time_of_request = tm;
future->source_of_request = who; future->source_of_request = who;
future->source_type = src_type; future->source_type = src_type;
future->arg_s0 = g261; future->arg_s0 = g264;
future->arg_s1 = g262; future->arg_s1 = g265;
future_do_runtimecall(fts, (void*)f, 0, 1, 0); future_do_runtimecall(fts, (void*)f, 0, 1, 0);
fts->thread = scheme_current_thread; fts->thread = scheme_current_thread;
@ -363,7 +363,7 @@
} }
void scheme_rtcall_b_v(const char *who, int src_type, prim_b_v f, Scheme_Bucket* g263) void scheme_rtcall_b_v(const char *who, int src_type, prim_b_v f, Scheme_Bucket* g266)
XFORM_SKIP_PROC XFORM_SKIP_PROC
{ {
Scheme_Future_Thread_State *fts = scheme_future_thread_state; Scheme_Future_Thread_State *fts = scheme_future_thread_state;
@ -378,7 +378,7 @@
future->time_of_request = tm; future->time_of_request = tm;
future->source_of_request = who; future->source_of_request = who;
future->source_type = src_type; future->source_type = src_type;
future->arg_b0 = g263; future->arg_b0 = g266;
future_do_runtimecall(fts, (void*)f, 0, 1, 0); future_do_runtimecall(fts, (void*)f, 0, 1, 0);
fts->thread = scheme_current_thread; fts->thread = scheme_current_thread;
@ -388,7 +388,7 @@
} }
Scheme_Object* scheme_rtcall_sl_s(const char *who, int src_type, prim_sl_s f, Scheme_Object* g264, intptr_t g265) Scheme_Object* scheme_rtcall_sl_s(const char *who, int src_type, prim_sl_s f, Scheme_Object* g267, intptr_t g268)
XFORM_SKIP_PROC XFORM_SKIP_PROC
{ {
Scheme_Future_Thread_State *fts = scheme_future_thread_state; Scheme_Future_Thread_State *fts = scheme_future_thread_state;
@ -403,8 +403,8 @@
future->time_of_request = tm; future->time_of_request = tm;
future->source_of_request = who; future->source_of_request = who;
future->source_type = src_type; future->source_type = src_type;
future->arg_s0 = g264; future->arg_s0 = g267;
future->arg_l1 = g265; future->arg_l1 = g268;
future_do_runtimecall(fts, (void*)f, 0, 1, 0); future_do_runtimecall(fts, (void*)f, 0, 1, 0);
fts->thread = scheme_current_thread; fts->thread = scheme_current_thread;
@ -414,7 +414,7 @@
receive_special_result(future, retval, 1); receive_special_result(future, retval, 1);
return retval; return retval;
} }
Scheme_Object* scheme_rtcall_iS_s(const char *who, int src_type, prim_iS_s f, int g266, Scheme_Object** g267) Scheme_Object* scheme_rtcall_iS_s(const char *who, int src_type, prim_iS_s f, int g269, Scheme_Object** g270)
XFORM_SKIP_PROC XFORM_SKIP_PROC
{ {
Scheme_Future_Thread_State *fts = scheme_future_thread_state; Scheme_Future_Thread_State *fts = scheme_future_thread_state;
@ -429,8 +429,8 @@
future->time_of_request = tm; future->time_of_request = tm;
future->source_of_request = who; future->source_of_request = who;
future->source_type = src_type; future->source_type = src_type;
future->arg_i0 = g266; future->arg_i0 = g269;
future->arg_S1 = g267; future->arg_S1 = g270;
future_do_runtimecall(fts, (void*)f, 0, 1, 0); future_do_runtimecall(fts, (void*)f, 0, 1, 0);
fts->thread = scheme_current_thread; fts->thread = scheme_current_thread;
@ -440,7 +440,7 @@
receive_special_result(future, retval, 1); receive_special_result(future, retval, 1);
return retval; return retval;
} }
Scheme_Object* scheme_rtcall_S_s(const char *who, int src_type, prim_S_s f, Scheme_Object** g268) Scheme_Object* scheme_rtcall_S_s(const char *who, int src_type, prim_S_s f, Scheme_Object** g271)
XFORM_SKIP_PROC XFORM_SKIP_PROC
{ {
Scheme_Future_Thread_State *fts = scheme_future_thread_state; Scheme_Future_Thread_State *fts = scheme_future_thread_state;
@ -455,7 +455,7 @@
future->time_of_request = tm; future->time_of_request = tm;
future->source_of_request = who; future->source_of_request = who;
future->source_type = src_type; future->source_type = src_type;
future->arg_S0 = g268; future->arg_S0 = g271;
future_do_runtimecall(fts, (void*)f, 0, 1, 0); future_do_runtimecall(fts, (void*)f, 0, 1, 0);
fts->thread = scheme_current_thread; fts->thread = scheme_current_thread;
@ -465,7 +465,7 @@
receive_special_result(future, retval, 1); receive_special_result(future, retval, 1);
return retval; return retval;
} }
void scheme_rtcall_s_v(const char *who, int src_type, prim_s_v f, Scheme_Object* g269) void scheme_rtcall_s_v(const char *who, int src_type, prim_s_v f, Scheme_Object* g272)
XFORM_SKIP_PROC XFORM_SKIP_PROC
{ {
Scheme_Future_Thread_State *fts = scheme_future_thread_state; Scheme_Future_Thread_State *fts = scheme_future_thread_state;
@ -480,8 +480,8 @@
future->time_of_request = tm; future->time_of_request = tm;
future->source_of_request = who; future->source_of_request = who;
future->source_type = src_type; future->source_type = src_type;
future->arg_s0 = g269; future->arg_s0 = g272;
send_special_result(future, g269); send_special_result(future, g272);
future_do_runtimecall(fts, (void*)f, 0, 1, 0); future_do_runtimecall(fts, (void*)f, 0, 1, 0);
fts->thread = scheme_current_thread; fts->thread = scheme_current_thread;
future = fts->thread->current_ft; future = fts->thread->current_ft;
@ -490,7 +490,7 @@
} }
Scheme_Object* scheme_rtcall_iSi_s(const char *who, int src_type, prim_iSi_s f, int g270, Scheme_Object** g271, int g272) Scheme_Object* scheme_rtcall_iSi_s(const char *who, int src_type, prim_iSi_s f, int g273, Scheme_Object** g274, int g275)
XFORM_SKIP_PROC XFORM_SKIP_PROC
{ {
Scheme_Future_Thread_State *fts = scheme_future_thread_state; Scheme_Future_Thread_State *fts = scheme_future_thread_state;
@ -505,9 +505,9 @@
future->time_of_request = tm; future->time_of_request = tm;
future->source_of_request = who; future->source_of_request = who;
future->source_type = src_type; future->source_type = src_type;
future->arg_i0 = g270; future->arg_i0 = g273;
future->arg_S1 = g271; future->arg_S1 = g274;
future->arg_i2 = g272; future->arg_i2 = g275;
future_do_runtimecall(fts, (void*)f, 0, 1, 0); future_do_runtimecall(fts, (void*)f, 0, 1, 0);
fts->thread = scheme_current_thread; fts->thread = scheme_current_thread;
@ -517,7 +517,7 @@
receive_special_result(future, retval, 1); receive_special_result(future, retval, 1);
return retval; return retval;
} }
void scheme_rtcall_siS_v(const char *who, int src_type, prim_siS_v f, Scheme_Object* g273, int g274, Scheme_Object** g275) void scheme_rtcall_siS_v(const char *who, int src_type, prim_siS_v f, Scheme_Object* g276, int g277, Scheme_Object** g278)
XFORM_SKIP_PROC XFORM_SKIP_PROC
{ {
Scheme_Future_Thread_State *fts = scheme_future_thread_state; Scheme_Future_Thread_State *fts = scheme_future_thread_state;
@ -532,9 +532,9 @@
future->time_of_request = tm; future->time_of_request = tm;
future->source_of_request = who; future->source_of_request = who;
future->source_type = src_type; future->source_type = src_type;
future->arg_s0 = g273; future->arg_s0 = g276;
future->arg_i1 = g274; future->arg_i1 = g277;
future->arg_S2 = g275; future->arg_S2 = g278;
future_do_runtimecall(fts, (void*)f, 0, 1, 0); future_do_runtimecall(fts, (void*)f, 0, 1, 0);
fts->thread = scheme_current_thread; fts->thread = scheme_current_thread;
@ -544,7 +544,34 @@
} }
void* scheme_rtcall_z_p(const char *who, int src_type, prim_z_p f, size_t g276) Scheme_Object* scheme_rtcall_Sii_s(const char *who, int src_type, prim_Sii_s f, Scheme_Object** g279, int g280, int g281)
XFORM_SKIP_PROC
{
Scheme_Future_Thread_State *fts = scheme_future_thread_state;
future_t *future;
double tm;
Scheme_Object* retval;
future = fts->thread->current_ft;
future->prim_protocol = SIG_Sii_s;
future->prim_func = f;
tm = get_future_timestamp();
future->time_of_request = tm;
future->source_of_request = who;
future->source_type = src_type;
future->arg_S0 = g279;
future->arg_i1 = g280;
future->arg_i2 = g281;
future_do_runtimecall(fts, (void*)f, 0, 1, 0);
fts->thread = scheme_current_thread;
future = fts->thread->current_ft;
retval = future->retval_s;
future->retval_s = 0;
receive_special_result(future, retval, 1);
return retval;
}
void* scheme_rtcall_z_p(const char *who, int src_type, prim_z_p f, size_t g282)
XFORM_SKIP_PROC XFORM_SKIP_PROC
{ {
Scheme_Future_Thread_State *fts = scheme_future_thread_state; Scheme_Future_Thread_State *fts = scheme_future_thread_state;
@ -559,7 +586,7 @@
future->time_of_request = tm; future->time_of_request = tm;
future->source_of_request = who; future->source_of_request = who;
future->source_type = src_type; future->source_type = src_type;
future->arg_z0 = g276; future->arg_z0 = g282;
future_do_runtimecall(fts, (void*)f, 0, 1, 0); future_do_runtimecall(fts, (void*)f, 0, 1, 0);
fts->thread = scheme_current_thread; fts->thread = scheme_current_thread;
@ -569,7 +596,7 @@
return retval; return retval;
} }
Scheme_Object* scheme_rtcall_si_s(const char *who, int src_type, prim_si_s f, Scheme_Object* g277, int g278) Scheme_Object* scheme_rtcall_si_s(const char *who, int src_type, prim_si_s f, Scheme_Object* g283, int g284)
XFORM_SKIP_PROC XFORM_SKIP_PROC
{ {
Scheme_Future_Thread_State *fts = scheme_future_thread_state; Scheme_Future_Thread_State *fts = scheme_future_thread_state;
@ -584,8 +611,8 @@
future->time_of_request = tm; future->time_of_request = tm;
future->source_of_request = who; future->source_of_request = who;
future->source_type = src_type; future->source_type = src_type;
future->arg_s0 = g277; future->arg_s0 = g283;
future->arg_i1 = g278; future->arg_i1 = g284;
future_do_runtimecall(fts, (void*)f, 0, 1, 0); future_do_runtimecall(fts, (void*)f, 0, 1, 0);
fts->thread = scheme_current_thread; fts->thread = scheme_current_thread;
@ -595,7 +622,7 @@
receive_special_result(future, retval, 1); receive_special_result(future, retval, 1);
return retval; return retval;
} }
void scheme_rtcall_sis_v(const char *who, int src_type, prim_sis_v f, Scheme_Object* g279, int g280, Scheme_Object* g281) void scheme_rtcall_sis_v(const char *who, int src_type, prim_sis_v f, Scheme_Object* g285, int g286, Scheme_Object* g287)
XFORM_SKIP_PROC XFORM_SKIP_PROC
{ {
Scheme_Future_Thread_State *fts = scheme_future_thread_state; Scheme_Future_Thread_State *fts = scheme_future_thread_state;
@ -610,9 +637,9 @@
future->time_of_request = tm; future->time_of_request = tm;
future->source_of_request = who; future->source_of_request = who;
future->source_type = src_type; future->source_type = src_type;
future->arg_s0 = g279; future->arg_s0 = g285;
future->arg_i1 = g280; future->arg_i1 = g286;
future->arg_s2 = g281; future->arg_s2 = g287;
future_do_runtimecall(fts, (void*)f, 0, 1, 0); future_do_runtimecall(fts, (void*)f, 0, 1, 0);
fts->thread = scheme_current_thread; fts->thread = scheme_current_thread;
@ -622,7 +649,7 @@
} }
int scheme_rtcall_ss_i(const char *who, int src_type, prim_ss_i f, Scheme_Object* g282, Scheme_Object* g283) int scheme_rtcall_ss_i(const char *who, int src_type, prim_ss_i f, Scheme_Object* g288, Scheme_Object* g289)
XFORM_SKIP_PROC XFORM_SKIP_PROC
{ {
Scheme_Future_Thread_State *fts = scheme_future_thread_state; Scheme_Future_Thread_State *fts = scheme_future_thread_state;
@ -637,8 +664,8 @@
future->time_of_request = tm; future->time_of_request = tm;
future->source_of_request = who; future->source_of_request = who;
future->source_type = src_type; future->source_type = src_type;
future->arg_s0 = g282; future->arg_s0 = g288;
future->arg_s1 = g283; future->arg_s1 = g289;
future_do_runtimecall(fts, (void*)f, 0, 1, 0); future_do_runtimecall(fts, (void*)f, 0, 1, 0);
fts->thread = scheme_current_thread; fts->thread = scheme_current_thread;
@ -648,7 +675,7 @@
return retval; return retval;
} }
void scheme_rtcall_iSp_v(const char *who, int src_type, prim_iSp_v f, int g284, Scheme_Object** g285, void* g286) void scheme_rtcall_iSp_v(const char *who, int src_type, prim_iSp_v f, int g290, Scheme_Object** g291, void* g292)
XFORM_SKIP_PROC XFORM_SKIP_PROC
{ {
Scheme_Future_Thread_State *fts = scheme_future_thread_state; Scheme_Future_Thread_State *fts = scheme_future_thread_state;
@ -663,9 +690,9 @@
future->time_of_request = tm; future->time_of_request = tm;
future->source_of_request = who; future->source_of_request = who;
future->source_type = src_type; future->source_type = src_type;
future->arg_i0 = g284; future->arg_i0 = g290;
future->arg_S1 = g285; future->arg_S1 = g291;
future->arg_p2 = g286; future->arg_p2 = g292;
future_do_runtimecall(fts, (void*)f, 0, 1, 0); future_do_runtimecall(fts, (void*)f, 0, 1, 0);
fts->thread = scheme_current_thread; fts->thread = scheme_current_thread;
@ -675,7 +702,7 @@
} }
Scheme_Object* scheme_rtcall_sss_s(const char *who, int src_type, prim_sss_s f, Scheme_Object* g287, Scheme_Object* g288, Scheme_Object* g289) Scheme_Object* scheme_rtcall_sss_s(const char *who, int src_type, prim_sss_s f, Scheme_Object* g293, Scheme_Object* g294, Scheme_Object* g295)
XFORM_SKIP_PROC XFORM_SKIP_PROC
{ {
Scheme_Future_Thread_State *fts = scheme_future_thread_state; Scheme_Future_Thread_State *fts = scheme_future_thread_state;
@ -690,9 +717,9 @@
future->time_of_request = tm; future->time_of_request = tm;
future->source_of_request = who; future->source_of_request = who;
future->source_type = src_type; future->source_type = src_type;
future->arg_s0 = g287; future->arg_s0 = g293;
future->arg_s1 = g288; future->arg_s1 = g294;
future->arg_s2 = g289; future->arg_s2 = g295;
future_do_runtimecall(fts, (void*)f, 0, 1, 0); future_do_runtimecall(fts, (void*)f, 0, 1, 0);
fts->thread = scheme_current_thread; fts->thread = scheme_current_thread;
@ -727,7 +754,7 @@
} }
void scheme_rtcall_iS_v(const char *who, int src_type, prim_iS_v f, int g290, Scheme_Object** g291) void scheme_rtcall_iS_v(const char *who, int src_type, prim_iS_v f, int g296, Scheme_Object** g297)
XFORM_SKIP_PROC XFORM_SKIP_PROC
{ {
Scheme_Future_Thread_State *fts = scheme_future_thread_state; Scheme_Future_Thread_State *fts = scheme_future_thread_state;
@ -742,8 +769,8 @@
future->time_of_request = tm; future->time_of_request = tm;
future->source_of_request = who; future->source_of_request = who;
future->source_type = src_type; future->source_type = src_type;
future->arg_i0 = g290; future->arg_i0 = g296;
future->arg_S1 = g291; future->arg_S1 = g297;
future_do_runtimecall(fts, (void*)f, 0, 1, 0); future_do_runtimecall(fts, (void*)f, 0, 1, 0);
fts->thread = scheme_current_thread; fts->thread = scheme_current_thread;

73
racket/src/racket/src/jit_ts_protos.h
View File

@ -1,87 +1,90 @@
#define SIG_siS_s 11 #define SIG_siS_s 11
typedef Scheme_Object* (*prim_siS_s)(Scheme_Object*, int, Scheme_Object**); typedef Scheme_Object* (*prim_siS_s)(Scheme_Object*, int, Scheme_Object**);
Scheme_Object* scheme_rtcall_siS_s(const char *who, int src_type, prim_siS_s f, Scheme_Object* g349, int g350, Scheme_Object** g351); Scheme_Object* scheme_rtcall_siS_s(const char *who, int src_type, prim_siS_s f, Scheme_Object* g358, int g359, Scheme_Object** g360);
#define SIG_iSs_s 12 #define SIG_iSs_s 12
typedef Scheme_Object* (*prim_iSs_s)(int, Scheme_Object**, Scheme_Object*); typedef Scheme_Object* (*prim_iSs_s)(int, Scheme_Object**, Scheme_Object*);
Scheme_Object* scheme_rtcall_iSs_s(const char *who, int src_type, prim_iSs_s f, int g352, Scheme_Object** g353, Scheme_Object* g354); Scheme_Object* scheme_rtcall_iSs_s(const char *who, int src_type, prim_iSs_s f, int g361, Scheme_Object** g362, Scheme_Object* g363);
#define SIG_s_s 13 #define SIG_s_s 13
typedef Scheme_Object* (*prim_s_s)(Scheme_Object*); typedef Scheme_Object* (*prim_s_s)(Scheme_Object*);
Scheme_Object* scheme_rtcall_s_s(const char *who, int src_type, prim_s_s f, Scheme_Object* g355); Scheme_Object* scheme_rtcall_s_s(const char *who, int src_type, prim_s_s f, Scheme_Object* g364);
#define SIG_n_s 14 #define SIG_n_s 14
typedef Scheme_Object* (*prim_n_s)(Scheme_Native_Lambda*); typedef Scheme_Object* (*prim_n_s)(Scheme_Native_Lambda*);
Scheme_Object* scheme_rtcall_n_s(const char *who, int src_type, prim_n_s f, Scheme_Native_Lambda* g356); Scheme_Object* scheme_rtcall_n_s(const char *who, int src_type, prim_n_s f, Scheme_Native_Lambda* g365);
#define SIG__s 15 #define SIG__s 15
typedef Scheme_Object* (*prim__s)(); typedef Scheme_Object* (*prim__s)();
Scheme_Object* scheme_rtcall__s(const char *who, int src_type, prim__s f ); Scheme_Object* scheme_rtcall__s(const char *who, int src_type, prim__s f );
#define SIG_ss_s 16 #define SIG_ss_s 16
typedef Scheme_Object* (*prim_ss_s)(Scheme_Object*, Scheme_Object*); typedef Scheme_Object* (*prim_ss_s)(Scheme_Object*, Scheme_Object*);
Scheme_Object* scheme_rtcall_ss_s(const char *who, int src_type, prim_ss_s f, Scheme_Object* g357, Scheme_Object* g358); Scheme_Object* scheme_rtcall_ss_s(const char *who, int src_type, prim_ss_s f, Scheme_Object* g366, Scheme_Object* g367);
#define SIG_ssi_s 17 #define SIG_ssi_s 17
typedef Scheme_Object* (*prim_ssi_s)(Scheme_Object*, Scheme_Object*, int); typedef Scheme_Object* (*prim_ssi_s)(Scheme_Object*, Scheme_Object*, int);
Scheme_Object* scheme_rtcall_ssi_s(const char *who, int src_type, prim_ssi_s f, Scheme_Object* g359, Scheme_Object* g360, int g361); Scheme_Object* scheme_rtcall_ssi_s(const char *who, int src_type, prim_ssi_s f, Scheme_Object* g368, Scheme_Object* g369, int g370);
#define SIG_tt_s 18 #define SIG_tt_s 18
typedef Scheme_Object* (*prim_tt_s)(const Scheme_Object*, const Scheme_Object*); typedef Scheme_Object* (*prim_tt_s)(const Scheme_Object*, const Scheme_Object*);
Scheme_Object* scheme_rtcall_tt_s(const char *who, int src_type, prim_tt_s f, const Scheme_Object* g362, const Scheme_Object* g363); Scheme_Object* scheme_rtcall_tt_s(const char *who, int src_type, prim_tt_s f, const Scheme_Object* g371, const Scheme_Object* g372);
#define SIG_ss_m 19 #define SIG_ss_m 19
typedef MZ_MARK_STACK_TYPE (*prim_ss_m)(Scheme_Object*, Scheme_Object*); typedef MZ_MARK_STACK_TYPE (*prim_ss_m)(Scheme_Object*, Scheme_Object*);
MZ_MARK_STACK_TYPE scheme_rtcall_ss_m(const char *who, int src_type, prim_ss_m f, Scheme_Object* g364, Scheme_Object* g365); MZ_MARK_STACK_TYPE scheme_rtcall_ss_m(const char *who, int src_type, prim_ss_m f, Scheme_Object* g373, Scheme_Object* g374);
#define SIG_Sl_s 20 #define SIG_Sl_s 20
typedef Scheme_Object* (*prim_Sl_s)(Scheme_Object**, intptr_t); typedef Scheme_Object* (*prim_Sl_s)(Scheme_Object**, intptr_t);
Scheme_Object* scheme_rtcall_Sl_s(const char *who, int src_type, prim_Sl_s f, Scheme_Object** g366, intptr_t g367); Scheme_Object* scheme_rtcall_Sl_s(const char *who, int src_type, prim_Sl_s f, Scheme_Object** g375, intptr_t g376);
#define SIG_l_s 21 #define SIG_l_s 21
typedef Scheme_Object* (*prim_l_s)(intptr_t); typedef Scheme_Object* (*prim_l_s)(intptr_t);
Scheme_Object* scheme_rtcall_l_s(const char *who, int src_type, prim_l_s f, intptr_t g368); Scheme_Object* scheme_rtcall_l_s(const char *who, int src_type, prim_l_s f, intptr_t g377);
#define SIG_bsi_v 22 #define SIG_bsi_v 22
typedef void (*prim_bsi_v)(Scheme_Bucket*, Scheme_Object*, int); typedef void (*prim_bsi_v)(Scheme_Bucket*, Scheme_Object*, int);
void scheme_rtcall_bsi_v(const char *who, int src_type, prim_bsi_v f, Scheme_Bucket* g369, Scheme_Object* g370, int g371); void scheme_rtcall_bsi_v(const char *who, int src_type, prim_bsi_v f, Scheme_Bucket* g378, Scheme_Object* g379, int g380);
#define SIG_iiS_v 23 #define SIG_iiS_v 23
typedef void (*prim_iiS_v)(int, int, Scheme_Object**); typedef void (*prim_iiS_v)(int, int, Scheme_Object**);
void scheme_rtcall_iiS_v(const char *who, int src_type, prim_iiS_v f, int g372, int g373, Scheme_Object** g374); void scheme_rtcall_iiS_v(const char *who, int src_type, prim_iiS_v f, int g381, int g382, Scheme_Object** g383);
#define SIG_ss_v 24 #define SIG_ss_v 24
typedef void (*prim_ss_v)(Scheme_Object*, Scheme_Object*); typedef void (*prim_ss_v)(Scheme_Object*, Scheme_Object*);
void scheme_rtcall_ss_v(const char *who, int src_type, prim_ss_v f, Scheme_Object* g375, Scheme_Object* g376); void scheme_rtcall_ss_v(const char *who, int src_type, prim_ss_v f, Scheme_Object* g384, Scheme_Object* g385);
#define SIG_b_v 25 #define SIG_b_v 25
typedef void (*prim_b_v)(Scheme_Bucket*); typedef void (*prim_b_v)(Scheme_Bucket*);
void scheme_rtcall_b_v(const char *who, int src_type, prim_b_v f, Scheme_Bucket* g377); void scheme_rtcall_b_v(const char *who, int src_type, prim_b_v f, Scheme_Bucket* g386);
#define SIG_sl_s 26 #define SIG_sl_s 26
typedef Scheme_Object* (*prim_sl_s)(Scheme_Object*, intptr_t); typedef Scheme_Object* (*prim_sl_s)(Scheme_Object*, intptr_t);
Scheme_Object* scheme_rtcall_sl_s(const char *who, int src_type, prim_sl_s f, Scheme_Object* g378, intptr_t g379); Scheme_Object* scheme_rtcall_sl_s(const char *who, int src_type, prim_sl_s f, Scheme_Object* g387, intptr_t g388);
#define SIG_iS_s 27 #define SIG_iS_s 27
typedef Scheme_Object* (*prim_iS_s)(int, Scheme_Object**); typedef Scheme_Object* (*prim_iS_s)(int, Scheme_Object**);
Scheme_Object* scheme_rtcall_iS_s(const char *who, int src_type, prim_iS_s f, int g380, Scheme_Object** g381); Scheme_Object* scheme_rtcall_iS_s(const char *who, int src_type, prim_iS_s f, int g389, Scheme_Object** g390);
#define SIG_S_s 28 #define SIG_S_s 28
typedef Scheme_Object* (*prim_S_s)(Scheme_Object**); typedef Scheme_Object* (*prim_S_s)(Scheme_Object**);
Scheme_Object* scheme_rtcall_S_s(const char *who, int src_type, prim_S_s f, Scheme_Object** g382); Scheme_Object* scheme_rtcall_S_s(const char *who, int src_type, prim_S_s f, Scheme_Object** g391);
#define SIG_s_v 29 #define SIG_s_v 29
typedef void (*prim_s_v)(Scheme_Object*); typedef void (*prim_s_v)(Scheme_Object*);
void scheme_rtcall_s_v(const char *who, int src_type, prim_s_v f, Scheme_Object* g383); void scheme_rtcall_s_v(const char *who, int src_type, prim_s_v f, Scheme_Object* g392);
#define SIG_iSi_s 30 #define SIG_iSi_s 30
typedef Scheme_Object* (*prim_iSi_s)(int, Scheme_Object**, int); typedef Scheme_Object* (*prim_iSi_s)(int, Scheme_Object**, int);
Scheme_Object* scheme_rtcall_iSi_s(const char *who, int src_type, prim_iSi_s f, int g384, Scheme_Object** g385, int g386); Scheme_Object* scheme_rtcall_iSi_s(const char *who, int src_type, prim_iSi_s f, int g393, Scheme_Object** g394, int g395);
#define SIG_siS_v 31 #define SIG_siS_v 31
typedef void (*prim_siS_v)(Scheme_Object*, int, Scheme_Object**); typedef void (*prim_siS_v)(Scheme_Object*, int, Scheme_Object**);
void scheme_rtcall_siS_v(const char *who, int src_type, prim_siS_v f, Scheme_Object* g387, int g388, Scheme_Object** g389); void scheme_rtcall_siS_v(const char *who, int src_type, prim_siS_v f, Scheme_Object* g396, int g397, Scheme_Object** g398);
#define SIG_z_p 32 #define SIG_Sii_s 32
typedef Scheme_Object* (*prim_Sii_s)(Scheme_Object**, int, int);
Scheme_Object* scheme_rtcall_Sii_s(const char *who, int src_type, prim_Sii_s f, Scheme_Object** g399, int g400, int g401);
#define SIG_z_p 33
typedef void* (*prim_z_p)(size_t); typedef void* (*prim_z_p)(size_t);
void* scheme_rtcall_z_p(const char *who, int src_type, prim_z_p f, size_t g390); void* scheme_rtcall_z_p(const char *who, int src_type, prim_z_p f, size_t g402);
#define SIG_si_s 33 #define SIG_si_s 34
typedef Scheme_Object* (*prim_si_s)(Scheme_Object*, int); typedef Scheme_Object* (*prim_si_s)(Scheme_Object*, int);
Scheme_Object* scheme_rtcall_si_s(const char *who, int src_type, prim_si_s f, Scheme_Object* g391, int g392); Scheme_Object* scheme_rtcall_si_s(const char *who, int src_type, prim_si_s f, Scheme_Object* g403, int g404);
#define SIG_sis_v 34 #define SIG_sis_v 35
typedef void (*prim_sis_v)(Scheme_Object*, int, Scheme_Object*); typedef void (*prim_sis_v)(Scheme_Object*, int, Scheme_Object*);
void scheme_rtcall_sis_v(const char *who, int src_type, prim_sis_v f, Scheme_Object* g393, int g394, Scheme_Object* g395); void scheme_rtcall_sis_v(const char *who, int src_type, prim_sis_v f, Scheme_Object* g405, int g406, Scheme_Object* g407);
#define SIG_ss_i 35 #define SIG_ss_i 36
typedef int (*prim_ss_i)(Scheme_Object*, Scheme_Object*); typedef int (*prim_ss_i)(Scheme_Object*, Scheme_Object*);
int scheme_rtcall_ss_i(const char *who, int src_type, prim_ss_i f, Scheme_Object* g396, Scheme_Object* g397); int scheme_rtcall_ss_i(const char *who, int src_type, prim_ss_i f, Scheme_Object* g408, Scheme_Object* g409);
#define SIG_iSp_v 36 #define SIG_iSp_v 37
typedef void (*prim_iSp_v)(int, Scheme_Object**, void*); typedef void (*prim_iSp_v)(int, Scheme_Object**, void*);
void scheme_rtcall_iSp_v(const char *who, int src_type, prim_iSp_v f, int g398, Scheme_Object** g399, void* g400); void scheme_rtcall_iSp_v(const char *who, int src_type, prim_iSp_v f, int g410, Scheme_Object** g411, void* g412);
#define SIG_sss_s 37 #define SIG_sss_s 38
typedef Scheme_Object* (*prim_sss_s)(Scheme_Object*, Scheme_Object*, Scheme_Object*); typedef Scheme_Object* (*prim_sss_s)(Scheme_Object*, Scheme_Object*, Scheme_Object*);
Scheme_Object* scheme_rtcall_sss_s(const char *who, int src_type, prim_sss_s f, Scheme_Object* g401, Scheme_Object* g402, Scheme_Object* g403); Scheme_Object* scheme_rtcall_sss_s(const char *who, int src_type, prim_sss_s f, Scheme_Object* g413, Scheme_Object* g414, Scheme_Object* g415);
#define SIG__v 38 #define SIG__v 39
typedef void (*prim__v)(); typedef void (*prim__v)();
void scheme_rtcall__v(const char *who, int src_type, prim__v f ); void scheme_rtcall__v(const char *who, int src_type, prim__v f );
#define SIG_iS_v 39 #define SIG_iS_v 40
typedef void (*prim_iS_v)(int, Scheme_Object**); typedef void (*prim_iS_v)(int, Scheme_Object**);
void scheme_rtcall_iS_v(const char *who, int src_type, prim_iS_v f, int g404, Scheme_Object** g405); void scheme_rtcall_iS_v(const char *who, int src_type, prim_iS_v f, int g416, Scheme_Object** g417);

14
racket/src/racket/src/jit_ts_runtime_glue.c
View File

@ -290,6 +290,20 @@ case SIG_siS_v:
f(arg_s0, arg_i1, arg_S2); f(arg_s0, arg_i1, arg_S2);
break;
}
case SIG_Sii_s:
{
prim_Sii_s f = (prim_Sii_s)future->prim_func;
GC_CAN_IGNORE Scheme_Object* retval;
JIT_TS_LOCALIZE(Scheme_Object**, arg_S0); JIT_TS_LOCALIZE(int, arg_i1); JIT_TS_LOCALIZE(int, arg_i2);
future->arg_S0 = NULL;
ADJUST_RS_ARG(future, arg_S0);
retval =
f(arg_S0, arg_i1, arg_i2);
future->retval_s = retval;
send_special_result(future, retval);
break; break;
} }
case SIG_z_p: case SIG_z_p:

127
racket/src/racket/src/jitcall.c
View File

@ -36,6 +36,11 @@ static int generate_argument_boxing(mz_jit_state *jitter, Scheme_Lambda *lam,
Scheme_App_Rec *app, Scheme_Object **alt_rands); Scheme_App_Rec *app, Scheme_Object **alt_rands);
#endif #endif
static int detect_unsafe_struct_refs(Scheme_Object *arg, Scheme_Object **alt_rands, Scheme_App_Rec *app,
int i, int num_rands, int shift);
static int generate_unsafe_struct_ref_sequence(mz_jit_state *jitter, Scheme_Object *arg, Scheme_Object *last_arg,
int count, int stack_pos);
int scheme_direct_call_count, scheme_indirect_call_count; int scheme_direct_call_count, scheme_indirect_call_count;
struct jit_direct_arg { struct jit_direct_arg {
@ -1783,7 +1788,7 @@ int scheme_generate_app(Scheme_App_Rec *app, Scheme_Object **alt_rands, int num_
If no_call is 2, then rator is not necssarily evaluated. If no_call is 2, then rator is not necssarily evaluated.
If no_call is 1, then rator is left in V1 and arguments are on runstack. */ If no_call is 1, then rator is left in V1 and arguments are on runstack. */
{ {
int i, offset, need_safety = 0, apply_to_list = 0; int i, offset, need_safety = 0, apply_to_list = 0, num_unsafe_struct_refs;
int direct_prim = 0, need_non_tail = 0, direct_native = 0, direct_self = 0, nontail_self = 0; int direct_prim = 0, need_non_tail = 0, direct_native = 0, direct_self = 0, nontail_self = 0;
Scheme_Native_Closure *inline_direct_native = NULL; Scheme_Native_Closure *inline_direct_native = NULL;
int almost_inline_direct_native = 0; int almost_inline_direct_native = 0;
@ -2113,10 +2118,26 @@ int scheme_generate_app(Scheme_App_Rec *app, Scheme_Object **alt_rands, int num_
need_safety = 0; need_safety = 0;
} }
#ifdef USE_FLONUM_UNBOXING #ifdef USE_FLONUM_UNBOXING
if (direct_lam if (direct_lam)
&& (SCHEME_LAMBDA_FLAGS(direct_lam) & LAMBDA_HAS_TYPED_ARGS) num_unsafe_struct_refs = 0;
&& (CLOSURE_ARGUMENT_IS_FLONUM(direct_lam, i+args_already_in_place) else
|| CLOSURE_ARGUMENT_IS_EXTFLONUM(direct_lam, i+args_already_in_place))) { #endif
num_unsafe_struct_refs = detect_unsafe_struct_refs(arg, alt_rands, app, i, num_rands, 1+args_already_in_place);
if (num_unsafe_struct_refs > 1) {
/* Found a sequence of `(unsafed-struct-ref id 'number)` with
sequential `number`s, so extract the whole group at once */
v = (alt_rands
? alt_rands[i+1+args_already_in_place+num_unsafe_struct_refs-1]
: app->args[i+1+args_already_in_place+num_unsafe_struct_refs-1]);
mz_rs_sync();
generate_unsafe_struct_ref_sequence(jitter, arg, v, num_unsafe_struct_refs, i + offset);
CHECK_LIMIT();
i += (num_unsafe_struct_refs - 1);
#ifdef USE_FLONUM_UNBOXING
} else if (direct_lam
&& (SCHEME_LAMBDA_FLAGS(direct_lam) & LAMBDA_HAS_TYPED_ARGS)
&& (CLOSURE_ARGUMENT_IS_FLONUM(direct_lam, i+args_already_in_place)
|| CLOSURE_ARGUMENT_IS_EXTFLONUM(direct_lam, i+args_already_in_place))) {
int directly; int directly;
int extfl; int extfl;
extfl = CLOSURE_ARGUMENT_IS_EXTFLONUM(direct_lam, i+args_already_in_place); extfl = CLOSURE_ARGUMENT_IS_EXTFLONUM(direct_lam, i+args_already_in_place);
@ -2149,13 +2170,12 @@ int scheme_generate_app(Scheme_App_Rec *app, Scheme_Object **alt_rands, int num_
} else { } else {
(void)jit_movi_p(JIT_R0, NULL); (void)jit_movi_p(JIT_R0, NULL);
} }
} else
#endif #endif
if (inline_direct_args) { } else if (inline_direct_args) {
if (inline_direct_args[i].gen) if (inline_direct_args[i].gen)
scheme_generate(arg, jitter, 0, 0, 0, inline_direct_args[i].reg, NULL, NULL); scheme_generate(arg, jitter, 0, 0, 0, inline_direct_args[i].reg, NULL, NULL);
} else } else
scheme_generate_non_tail(arg, jitter, 0, !need_non_tail, 0); /* sync'd below */ scheme_generate_non_tail(arg, jitter, 0, !need_non_tail, 0); /* sync'd below */
RESUME_JIT_DATA(); RESUME_JIT_DATA();
CHECK_LIMIT(); CHECK_LIMIT();
@ -2397,4 +2417,91 @@ int scheme_generate_app(Scheme_App_Rec *app, Scheme_Object **alt_rands, int num_
return is_tail ? 2 : 1; return is_tail ? 2 : 1;
} }
static int detect_unsafe_struct_refs(Scheme_Object *arg, Scheme_Object **alt_rands, Scheme_App_Rec *app,
int i, int num_rands, int shift)
/* Look for `(unsafe-struct-ref id 'num)` ... as a sequence of
arguments, which shows up as a result of `struct-copy`, and return
the length of the sequence. Instead of performing each
`unsafe-struct-ref` separately, which involves a chaperone test
each time, we'll test once and extract all. */
{
Scheme_App3_Rec *app3, *next_app3;
Scheme_Object *next_arg;
if (SAME_TYPE(SCHEME_TYPE(arg), scheme_application3_type)) {
app3 = (Scheme_App3_Rec *)arg;
if (SAME_OBJ(app3->rator, scheme_unsafe_struct_ref_proc)
&& SAME_TYPE(SCHEME_TYPE(app3->rand1), scheme_local_type)
&& SCHEME_INTP(app3->rand2)) {
int seq = 1, delta = SCHEME_INT_VAL(app3->rand2) - i;
i++;
while (i < num_rands) {
next_arg = (alt_rands ? alt_rands[i+shift] : app->args[i+shift]);
if (SAME_TYPE(SCHEME_TYPE(next_arg), scheme_application3_type)) {
next_app3 = (Scheme_App3_Rec *)next_arg;
if (SAME_OBJ(next_app3->rator, scheme_unsafe_struct_ref_proc)
&& SAME_TYPE(SCHEME_TYPE(next_app3->rand1), scheme_local_type)
&& SCHEME_INTP(next_app3->rand2)
&& (SCHEME_INT_VAL(next_app3->rand2) == i + delta)
&& (SCHEME_LOCAL_POS(next_app3->rand1) == SCHEME_LOCAL_POS(app3->rand1))) {
seq++;
i++;
} else
break;
} else
break;
}
return seq;
}
}
return 0;
}
static int generate_unsafe_struct_ref_sequence(mz_jit_state *jitter, Scheme_Object *arg, Scheme_Object *last_arg,
int count, int stack_pos)
/* Implement a sequence discovered by `detect_unsafe_struct_refs()`. */
{
Scheme_App3_Rec *app3 = (Scheme_App3_Rec *)arg;
int i, base = SCHEME_INT_VAL(app3->rand2);
GC_CAN_IGNORE jit_insn *ref, *refslow, *ref2;
/* Using `last_arg` ensures that we clear the local, if needed */
mz_runstack_skipped(jitter, 2);
scheme_generate(((Scheme_App3_Rec *)last_arg)->rand1, jitter, 0, 0, 0, JIT_R0, NULL, NULL);
CHECK_LIMIT();
mz_runstack_unskipped(jitter, 2);
/* Check for chaperones, and take slow path if found */
__START_SHORT_JUMPS__(1);
jit_ldxi_s(JIT_R2, JIT_R0, &((Scheme_Object *)0x0)->type);
ref = jit_bnei_i(jit_forward(), JIT_R2, scheme_chaperone_type);
refslow = jit_get_ip();
jit_addi_p(JIT_R1, JIT_RUNSTACK, WORDS_TO_BYTES(stack_pos));
jit_str_p(JIT_R1, JIT_R0);
jit_movi_i(JIT_V1, base);
jit_movi_p(JIT_R0, count);
(void)jit_calli(sjc.struct_raw_refs_code);
ref2 = jit_jmpi(jit_forward());
mz_patch_branch(ref);
(void)jit_beqi_i(refslow, JIT_R2, scheme_proc_chaperone_type);
CHECK_LIMIT();
/* This is the fast path: */
for (i = 0; i < count; i++) {
jit_ldxi_p(JIT_R1, JIT_R0, (intptr_t)&(((Scheme_Structure *)0x0)->slots[i+base]));
if (i != count - 1)
mz_rs_stxi(stack_pos+i, JIT_R1);
else
jit_movr_p(JIT_R0, JIT_R1);
CHECK_LIMIT();
}
mz_patch_branch(ref2);
__END_SHORT_JUMPS__(1);
return 1;
}
#endif #endif

38
racket/src/racket/src/jitcommon.c
View File

@ -182,6 +182,21 @@ static void chaperone_set_mark()
MZ_RUNSTACK[1] = SCHEME_CHAPERONE_VAL(MZ_RUNSTACK[1]); MZ_RUNSTACK[1] = SCHEME_CHAPERONE_VAL(MZ_RUNSTACK[1]);
} }
static Scheme_Object *unsafe_struct_refs(Scheme_Object **rs, int offset, int count)
{
int i;
Scheme_Object *v, *s = rs[0];
for (i = 0; i < count; i++) {
v = scheme_struct_ref(s, offset + i);
if (i == count-1)
return v;
rs[i] = v;
}
return NULL;
}
#define JITCOMMON_TS_PROCS #define JITCOMMON_TS_PROCS
#include "jit_ts.c" #include "jit_ts.c"
@ -1824,6 +1839,29 @@ static int common4(mz_jit_state *jitter, void *_data)
scheme_jit_register_sub_func(jitter, code, scheme_false); scheme_jit_register_sub_func(jitter, code, scheme_false);
} }
/* *** struct_raw_refs_code *** */
/* R1 points into the runstack, *R1 is struct, R0 is
count >= 2, and V1 is a starting slot in the structure */
{
void *code;
code = jit_get_ip();
sjc.struct_raw_refs_code = code;
mz_prolog(JIT_R2);
JIT_UPDATE_THREAD_RSPTR();
jit_prepare(3);
jit_pusharg_p(JIT_R0);
jit_pusharg_p(JIT_V1);
jit_pusharg_p(JIT_R1);
(void)mz_finish_lwe(ts_unsafe_struct_refs, ref);
jit_retval(JIT_R0);
mz_epilog(JIT_R2);
scheme_jit_register_sub_func(jitter, code, scheme_false);
}
/* *** syntax_e_code *** */ /* *** syntax_e_code *** */
/* R0 is (potential) syntax object */ /* R0 is (potential) syntax object */
{ {

8
racket/src/racket/src/list.c
View File

@ -1050,9 +1050,11 @@ scheme_init_unsafe_hash (Scheme_Env *env)
Scheme_Object *scheme_make_pair(Scheme_Object *car, Scheme_Object *cdr) Scheme_Object *scheme_make_pair(Scheme_Object *car, Scheme_Object *cdr)
{ {
#ifdef MZ_PRECISE_GC #ifdef MZ_PRECISE_GC
DEBUG_COUNT_ALLOCATION(scheme_make_integer(scheme_pair_type));
return GC_malloc_pair(car, cdr); return GC_malloc_pair(car, cdr);
#else #else
Scheme_Object *cons; Scheme_Object *cons;
DEBUG_COUNT_ALLOCATION(scheme_make_integer(scheme_pair_type));
cons = scheme_alloc_object(); cons = scheme_alloc_object();
cons->type = scheme_pair_type; cons->type = scheme_pair_type;
SCHEME_CAR(cons) = car; SCHEME_CAR(cons) = car;
@ -1793,6 +1795,8 @@ Scheme_Object *scheme_box(Scheme_Object *v)
{ {
Scheme_Object *obj; Scheme_Object *obj;
DEBUG_COUNT_ALLOCATION(scheme_make_integer(scheme_box_type));
obj = scheme_alloc_small_object(); obj = scheme_alloc_small_object();
obj->type = scheme_box_type; obj->type = scheme_box_type;
SCHEME_BOX_VAL(obj) = v; SCHEME_BOX_VAL(obj) = v;
@ -3646,12 +3650,14 @@ static Scheme_Object *eqv_hash_code(int argc, Scheme_Object *argv[])
Scheme_Object *scheme_make_weak_box(Scheme_Object *v) Scheme_Object *scheme_make_weak_box(Scheme_Object *v)
{ {
#ifdef MZ_PRECISE_GC #ifdef MZ_PRECISE_GC
DEBUG_COUNT_ALLOCATION(scheme_make_integer(scheme_weak_box_type));
return (Scheme_Object *)GC_malloc_weak_box(v, NULL, 0, 0); return (Scheme_Object *)GC_malloc_weak_box(v, NULL, 0, 0);
#else #else
Scheme_Small_Object *obj; Scheme_Small_Object *obj;
DEBUG_COUNT_ALLOCATION(scheme_make_integer(scheme_weak_box_type));
obj = MALLOC_ONE_TAGGED_WEAK(Scheme_Small_Object); obj = MALLOC_ONE_TAGGED_WEAK(Scheme_Small_Object);
obj->iso.so.type = scheme_weak_box_type; obj->iso.so.type = scheme_weak_box_type;
obj->u.ptr_val = v; obj->u.ptr_val = v;

20
racket/src/racket/src/print.c
View File

@ -2808,9 +2808,13 @@ print(Scheme_Object *obj, int notdisplay, int compact, Scheme_Hash_Table *ht,
cannot_print(pp, notdisplay, obj, ht, compact); cannot_print(pp, notdisplay, obj, ht, compact);
} else { } else {
print_utf8_string(pp, "#<", 0, 2); print_utf8_string(pp, "#<", 0, 2);
print_string_in_angle(pp, scheme_symbol_val(((Scheme_Struct_Type *)obj)->name), if (((Scheme_Struct_Type *)obj)->name) {
"struct-type:", print_string_in_angle(pp, scheme_symbol_val(((Scheme_Struct_Type *)obj)->name),
SCHEME_SYM_LEN(((Scheme_Struct_Type *)obj)->name)); "struct-type:",
SCHEME_SYM_LEN(((Scheme_Struct_Type *)obj)->name));
} else {
print_utf8_string(pp, "struct-type", 0, 11);
}
PRINTADDRESS(pp, obj); PRINTADDRESS(pp, obj);
print_utf8_string(pp, ">", 0, 1); print_utf8_string(pp, ">", 0, 1);
} }
@ -2821,9 +2825,13 @@ print(Scheme_Object *obj, int notdisplay, int compact, Scheme_Hash_Table *ht,
cannot_print(pp, notdisplay, obj, ht, compact); cannot_print(pp, notdisplay, obj, ht, compact);
} else { } else {
print_utf8_string(pp, "#<", 0, 2); print_utf8_string(pp, "#<", 0, 2);
print_string_in_angle(pp, scheme_symbol_val(((Scheme_Struct_Property *)obj)->name), if (((Scheme_Struct_Property *)obj)->name) {
"struct-type-property:", print_string_in_angle(pp, scheme_symbol_val(((Scheme_Struct_Property *)obj)->name),
SCHEME_SYM_LEN(((Scheme_Struct_Property *)obj)->name)); "struct-type-property:",
SCHEME_SYM_LEN(((Scheme_Struct_Property *)obj)->name));
} else {
print_utf8_string(pp, "struct-type-property", 0, 21);
}
PRINTADDRESS(pp, obj); PRINTADDRESS(pp, obj);
print_utf8_string(pp, ">", 0, 1); print_utf8_string(pp, ">", 0, 1);
} }

89
racket/src/racket/src/salloc.c
View File

@ -3288,3 +3288,92 @@ intptr_t scheme_count_envbox(Scheme_Object *root, Scheme_Hash_Table *ht)
} }
#endif #endif
/**********************************************************************/
#if RECORD_ALLOCATION_COUNTS
/* Allocation profiling --- prints allocated counts (not necessarily
still live) after every `NUM_ALLOCS_BEFORE_REPORT` structure and
closure allocations. Adjust that constant to match a test program.
Also, run with `racket -j` so that structure allocation is not
inlined, and don't use places. */
#define NUM_ALLOCS_BEFORE_REPORT 100000
static Scheme_Hash_Table *allocs;
static int alloc_count;
static int reporting;
#include "../gc2/my_qsort.c"
typedef struct alloc_count_result { int pos; int count; } alloc_count_result;
static int smaller_alloc_count(const void *a, const void *b) {
return ((alloc_count_result*)a)->count - ((alloc_count_result*)b)->count;
}
void scheme_record_allocation(Scheme_Object *tag)
{
Scheme_Object *c;
if (reporting)
return;
alloc_count++;
if (!allocs) {
REGISTER_SO(allocs);
reporting++;
allocs = scheme_make_hash_table(SCHEME_hash_ptr);
--reporting;
}
c = scheme_hash_get(allocs, tag);
if (!c) c = scheme_make_integer(0);
scheme_hash_set(allocs, tag, scheme_make_integer(SCHEME_INT_VAL(c)+1));
if (alloc_count == NUM_ALLOCS_BEFORE_REPORT) {
alloc_count_result *a;
int count = allocs->count;
int k = 0;
int i;
char *s;
reporting++;
a = MALLOC_N_ATOMIC(alloc_count_result, count);
printf("\n");
for (i = allocs->size; i--; ) {
if (allocs->vals[i]) {
a[k].pos = i;
a[k].count = SCHEME_INT_VAL(allocs->vals[i]);
k++;
}
}
my_qsort(a, allocs->count, sizeof(alloc_count_result), smaller_alloc_count);
for (i = 0; i < count; i++) {
tag = allocs->keys[a[i].pos];
if (SCHEME_INTP(tag)) {
s = scheme_get_type_name(SCHEME_INT_VAL(tag));
} else {
if (SAME_TYPE(SCHEME_TYPE(tag), scheme_lambda_type)
&& ((Scheme_Lambda *)tag)->name)
tag = ((Scheme_Lambda*)tag)->name;
else if (SAME_TYPE(SCHEME_TYPE(tag), scheme_case_lambda_sequence_type)
&& ((Scheme_Case_Lambda *)tag)->name)
tag = ((Scheme_Case_Lambda*)tag)->name;
s = scheme_write_to_string(tag, NULL);
}
printf("%d %s\n", a[i].count, s);
}
alloc_count = 0;
--reporting;
}
}
#endif

12
racket/src/racket/src/schpriv.h
View File

@ -4414,6 +4414,18 @@ void scheme_count_generic(Scheme_Object *o, intptr_t *s, intptr_t *e, Scheme_Has
#endif #endif
#endif #endif
/* See "salloc.c": */
#ifndef RECORD_ALLOCATION_COUNTS
# define RECORD_ALLOCATION_COUNTS 0
#endif
#if RECORD_ALLOCATION_COUNTS
extern void scheme_record_allocation(Scheme_Object *key);
# define DEBUG_COUNT_ALLOCATION(x) scheme_record_allocation(x);
#else
# define DEBUG_COUNT_ALLOCATION(x) /* empty */
#endif
/*========================================================================*/ /*========================================================================*/
/* miscellaneous */ /* miscellaneous */
/*========================================================================*/ /*========================================================================*/

8
racket/src/racket/src/struct.c
View File

@ -2543,6 +2543,8 @@ scheme_make_struct_instance(Scheme_Object *_stype, int argc, Scheme_Object **arg
stype = (Scheme_Struct_Type *)_stype; stype = (Scheme_Struct_Type *)_stype;
DEBUG_COUNT_ALLOCATION((Scheme_Object *)stype);
c = stype->num_slots; c = stype->num_slots;
inst = (Scheme_Structure *) inst = (Scheme_Structure *)
scheme_malloc_tagged(sizeof(Scheme_Structure) scheme_malloc_tagged(sizeof(Scheme_Structure)
@ -2591,6 +2593,8 @@ Scheme_Object *scheme_make_blank_prefab_struct_instance(Scheme_Struct_Type *styp
Scheme_Structure *inst; Scheme_Structure *inst;
int c; int c;
DEBUG_COUNT_ALLOCATION((Scheme_Object *)stype);
c = stype->num_slots; c = stype->num_slots;
inst = (Scheme_Structure *) inst = (Scheme_Structure *)
scheme_malloc_tagged(sizeof(Scheme_Structure) scheme_malloc_tagged(sizeof(Scheme_Structure)
@ -2625,6 +2629,8 @@ Scheme_Object *scheme_make_prefab_struct_instance(Scheme_Struct_Type *stype,
Scheme_Structure *inst; Scheme_Structure *inst;
int i, c; int i, c;
DEBUG_COUNT_ALLOCATION((Scheme_Object *)stype);
c = stype->num_slots; c = stype->num_slots;
inst = (Scheme_Structure *) inst = (Scheme_Structure *)
scheme_malloc_tagged(sizeof(Scheme_Structure) scheme_malloc_tagged(sizeof(Scheme_Structure)
@ -2682,6 +2688,8 @@ make_simple_struct_instance(int argc, Scheme_Object **args, Scheme_Object *prim)
Scheme_Struct_Type *stype = (Scheme_Struct_Type *)SCHEME_PRIM_CLOSURE_ELS(prim)[0]; Scheme_Struct_Type *stype = (Scheme_Struct_Type *)SCHEME_PRIM_CLOSURE_ELS(prim)[0];
int i, c; int i, c;
DEBUG_COUNT_ALLOCATION((Scheme_Object *)stype);
c = stype->num_slots; c = stype->num_slots;
inst = (Scheme_Structure *) inst = (Scheme_Structure *)
scheme_malloc_tagged(sizeof(Scheme_Structure) scheme_malloc_tagged(sizeof(Scheme_Structure)

2
racket/src/racket/src/syntax.c
View File

@ -465,6 +465,8 @@ Scheme_Object *scheme_make_stx(Scheme_Object *val,
{ {
Scheme_Stx *stx; Scheme_Stx *stx;
DEBUG_COUNT_ALLOCATION(scheme_make_integer(scheme_stx_type));
stx = MALLOC_ONE_TAGGED(Scheme_Stx); stx = MALLOC_ONE_TAGGED(Scheme_Stx);
stx->iso.so.type = scheme_stx_type; stx->iso.so.type = scheme_stx_type;
STX_KEY(stx) = HAS_SUBSTX(val) ? STX_SUBSTX_FLAG : 0; STX_KEY(stx) = HAS_SUBSTX(val) ? STX_SUBSTX_FLAG : 0;

48
racket/src/racket/src/thread.c
View File

@ -178,6 +178,8 @@ THREAD_LOCAL_DECL(int scheme_did_gc_count);
THREAD_LOCAL_DECL(static intptr_t process_time_at_swap); THREAD_LOCAL_DECL(static intptr_t process_time_at_swap);
THREAD_LOCAL_DECL(static intptr_t max_gc_pre_used_bytes); THREAD_LOCAL_DECL(static intptr_t max_gc_pre_used_bytes);
THREAD_LOCAL_DECL(static intptr_t num_major_garbage_collections);
THREAD_LOCAL_DECL(static intptr_t num_minor_garbage_collections);
SHARED_OK static int init_load_on_demand = 1; SHARED_OK static int init_load_on_demand = 1;
SHARED_OK static int compiled_file_check = SCHEME_COMPILED_FILE_CHECK_MODIFY_SECONDS; SHARED_OK static int compiled_file_check = SCHEME_COMPILED_FILE_CHECK_MODIFY_SECONDS;
@ -244,6 +246,7 @@ THREAD_LOCAL_DECL(struct Scheme_GC_Pre_Post_Callback_Desc *gc_prepost_callback_d
ROSYM static Scheme_Object *read_symbol, *write_symbol, *execute_symbol, *delete_symbol, *exists_symbol; ROSYM static Scheme_Object *read_symbol, *write_symbol, *execute_symbol, *delete_symbol, *exists_symbol;
ROSYM static Scheme_Object *client_symbol, *server_symbol; ROSYM static Scheme_Object *client_symbol, *server_symbol;
ROSYM static Scheme_Object *major_symbol, *minor_symbol, *incremental_symbol; ROSYM static Scheme_Object *major_symbol, *minor_symbol, *incremental_symbol;
ROSYM static Scheme_Object *cumulative_symbol;
ROSYM static Scheme_Object *initial_compiled_file_check_symbol; ROSYM static Scheme_Object *initial_compiled_file_check_symbol;
@ -528,6 +531,9 @@ void scheme_init_thread(Scheme_Env *env)
minor_symbol = scheme_intern_symbol("minor"); minor_symbol = scheme_intern_symbol("minor");
incremental_symbol = scheme_intern_symbol("incremental"); incremental_symbol = scheme_intern_symbol("incremental");
REGISTER_SO(cumulative_symbol);
cumulative_symbol = scheme_intern_symbol("cumulative");
GLOBAL_PRIM_W_ARITY("dump-memory-stats" , scheme_dump_gc_stats, 0, -1, env); GLOBAL_PRIM_W_ARITY("dump-memory-stats" , scheme_dump_gc_stats, 0, -1, env);
GLOBAL_PRIM_W_ARITY("vector-set-performance-stats!", current_stats , 1, 2, env); GLOBAL_PRIM_W_ARITY("vector-set-performance-stats!", current_stats , 1, 2, env);
@ -734,6 +740,7 @@ static Scheme_Object *collect_garbage(int argc, Scheme_Object *argv[])
static Scheme_Object *current_memory_use(int argc, Scheme_Object *args[]) static Scheme_Object *current_memory_use(int argc, Scheme_Object *args[])
{ {
Scheme_Object *arg = NULL; Scheme_Object *arg = NULL;
int cumulative = 0;
uintptr_t retval = 0; uintptr_t retval = 0;
if (argc) { if (argc) {
@ -741,19 +748,30 @@ static Scheme_Object *current_memory_use(int argc, Scheme_Object *args[])
arg = args[0]; arg = args[0];
} else if (SAME_TYPE(SCHEME_TYPE(args[0]), scheme_custodian_type)) { } else if (SAME_TYPE(SCHEME_TYPE(args[0]), scheme_custodian_type)) {
arg = args[0]; arg = args[0];
} else if (SAME_OBJ(args[0], cumulative_symbol)) {
cumulative = 1;
arg = NULL;
} else { } else {
scheme_wrong_contract("current-memory-use", scheme_wrong_contract("current-memory-use",
"(or/c custodian? #f)", "(or/c custodian? 'cumulative #f)",
0, argc, args); 0, argc, args);
} }
} }
if (cumulative) {
#ifdef MZ_PRECISE_GC #ifdef MZ_PRECISE_GC
retval = GC_get_memory_use(arg); retval = GC_get_memory_ever_allocated();
#else #else
scheme_unused_object(arg); retval = GC_get_total_bytes();
retval = GC_get_memory_use();
#endif #endif
} else {
#ifdef MZ_PRECISE_GC
retval = GC_get_memory_use(arg);
#else
scheme_unused_object(arg);
retval = GC_get_memory_use();
#endif
}
return scheme_make_integer_value_from_unsigned(retval); return scheme_make_integer_value_from_unsigned(retval);
} }
@ -9255,6 +9273,11 @@ static void inform_GC(int master_gc, int major_gc, int inc_gc,
&& (max_gc_pre_used_bytes >= 0)) && (max_gc_pre_used_bytes >= 0))
max_gc_pre_used_bytes = pre_used; max_gc_pre_used_bytes = pre_used;
if (major_gc)
num_major_garbage_collections++;
else
num_minor_garbage_collections++;
logger = scheme_get_gc_logger(); logger = scheme_get_gc_logger();
if (logger && scheme_log_level_p(logger, SCHEME_LOG_DEBUG)) { if (logger && scheme_log_level_p(logger, SCHEME_LOG_DEBUG)) {
/* Don't use scheme_log(), because it wants to allocate a buffer /* Don't use scheme_log(), because it wants to allocate a buffer
@ -9330,17 +9353,26 @@ static void log_peak_memory_use()
if (max_gc_pre_used_bytes > 0) { if (max_gc_pre_used_bytes > 0) {
logger = scheme_get_gc_logger(); logger = scheme_get_gc_logger();
if (logger && scheme_log_level_p(logger, SCHEME_LOG_DEBUG)) { if (logger && scheme_log_level_p(logger, SCHEME_LOG_DEBUG)) {
char buf[256], nums[128], *num, *num2; char buf[256], nums[128], *num, *numt, *num2;
intptr_t buflen; intptr_t buflen, allocated_bytes;
#ifdef MZ_PRECISE_GC
allocated_bytes = GC_get_memory_ever_allocated();
#else
allocated_bytes = GC_get_total_bytes();
#endif
memset(nums, 0, sizeof(nums)); memset(nums, 0, sizeof(nums));
num = gc_num(nums, max_gc_pre_used_bytes); num = gc_num(nums, max_gc_pre_used_bytes);
numt = gc_num(nums, allocated_bytes);
num2 = gc_unscaled_num(nums, scheme_total_gc_time); num2 = gc_unscaled_num(nums, scheme_total_gc_time);
sprintf(buf, sprintf(buf,
"" PLACE_ID_FORMAT "atexit peak was %sK; total %sms", "" PLACE_ID_FORMAT "atexit peak %sK; alloc %sK; major %d; minor %d; %sms",
#ifdef MZ_USE_PLACES #ifdef MZ_USE_PLACES
scheme_current_place_id, scheme_current_place_id,
#endif #endif
num, num,
numt,
num_major_garbage_collections,
num_minor_garbage_collections,
num2); num2);
buflen = strlen(buf); buflen = strlen(buf);
scheme_log_message(logger, SCHEME_LOG_DEBUG, buf, buflen, scheme_false); scheme_log_message(logger, SCHEME_LOG_DEBUG, buf, buflen, scheme_false);

2
racket/src/racket/src/vector.c
View File

@ -287,6 +287,8 @@ scheme_make_vector (intptr_t size, Scheme_Object *fill)
scheme_wrong_contract("make-vector", "exact-nonnegative-integer?", -1, 0, &vec); scheme_wrong_contract("make-vector", "exact-nonnegative-integer?", -1, 0, &vec);
} }
DEBUG_COUNT_ALLOCATION(scheme_make_integer(scheme_vector_type));
if (size < 1024) { if (size < 1024) {
vec = (Scheme_Object *)scheme_malloc_tagged(VECTOR_BYTES(size)); vec = (Scheme_Object *)scheme_malloc_tagged(VECTOR_BYTES(size));
} else { } else {