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

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
@cppdef{SCHEME_INPORTP}, but use @cppdef{SCHEME_INPUT_PORTP} to recognize
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}
extracts/sets the user data pointer; test for just this type with
@cppdef{SCHEME_OUTPORTP}, but use @cppdef{SCHEME_OUTPUT_PORTP} to
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
this type with @cppdef{SCHEME_THREADP}}

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

@ -164,7 +164,7 @@ For example,
2)]
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?]{

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
declaration, it effectively assigns to the old variable.
If a module is @tech{instantiate}d in any @tech{phase}s before it is
redeclared, each redeclaration of the module is immediately
@tech{instantiate}d in the same @tech{phase}s.
If a module is @tech{instantiate}d in the current namespace's
@tech{base phase} before the module is redeclared, the redeclaration
of the module is immediately @tech{instantiate}d in that
@tech{phase}.
If the current @tech{inspector} does not manage a module's declaration
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.}]}
@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
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).
Returns information about memory use:
If @racket[cust] is not provided, the estimate is a total reachable from
any custodians.
@itemlist[
When Racket is compiled without support for memory accounting, the
estimate is the same (i.e., all memory) for any individual custodian;
see also @racket[custodian-memory-accounting-available?].
@item{If @racket[mode] is @racket[#f] (the default), the result is an
estimate of the number of bytes reachable from any custodian.}
@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]{

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

@ -22,7 +22,8 @@ otherwise.}
@defproc[(make-empty-namespace) namespace?]{
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
namespace}. Attach modules from an existing namespace to the new one
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]
in the top-level environment of the current namespace, like a
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
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
to @racket[current-load-relative-directory] or
@ -249,7 +250,7 @@ undefined.}
@defproc[(namespace-attach-module [src-namespace namespace?]
[modname module-path?]
[modname (or module-path? resolved-module-path?)]
[dest-namespace namespace? (current-namespace)])
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
@racket[inspector] must currently control the invocation of the module
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?])

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

@ -6,14 +6,16 @@
@note-lib[racket/pretty]
@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?]{
Pretty-prints the value @racket[v] using the same printed form as the
default @racket[print] mode, but with newlines and whitespace inserted
to avoid lines longer than @racket[(pretty-print-columns)], as
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
counting enabled (see @secref["linecol"]), then printing is sensitive
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
called appropriately). Use
@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?]{
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?]{
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)]
@ -243,15 +262,18 @@ beginning of the new line.
The @racket[proc] procedure is called before any characters are
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
value has been printed with @racket[#f] as the line number and with the
length of the last line. Whenever the pretty-printer starts a new
line, @racket[proc] is called with the new line's number (where the
first new line is numbered @racket[1]) and the just-finished line's
length. The destination-columns argument to @racket[proc] is always
line length. Whenever the pretty-printer starts a new line,
@racket[proc] is called with the new line's number (where the 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
@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
number is not @racket[0] and the column count is not
@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
its datum is a pair, and if the syntax object corresponding
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
as if the syntax object had the @racket['transparent]
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?)]{
Produces a procedure that behaves like the result of
@racket[make-syntax-introducer], but using the @tech{scopes} of
@racket[ext-stx] that are not shared with @racket[base-stx], and with
a default action of @racket['remove].
@racket[make-syntax-introducer], but using a set of @tech{scopes} from
@racket[ext-stx] and with a default action of @racket['add].
@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
object with no @tech{scopes}.
@ -1012,8 +1029,9 @@ level as reported by @racket[syntax-local-phase-level].}
@defproc[(syntax-local-module-required-identifiers
[mod-path (or/c module-path? #f)]
[phase-level (or/c exact-integer? #f #t)])
(listof (cons/c (or/c exact-integer? #f)
(listof identifier?)))]{
(or/c (listof (cons/c (or/c exact-integer? #f)
(listof identifier?)))
#f)]{
Can be called only while
@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[#f]. The association list includes all identifiers imported
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
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.
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
@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[rel-string] is always parsed as a Unix-format relative path:
@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
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
@ -1215,7 +1216,8 @@ composable, and not extensible. Also, sub-form names like
@racketidfont{for-syntax} and @racketidfont{lib} are recognized
symbolically, instead of via bindings. Although not formalized in the
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
@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?)
(let ([s1 (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 "#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

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

@ -654,17 +654,17 @@
(if (function-shape-preserves-marks? constantness) 1 0))]))]
[(struct-type-shape? constantness)
(to-sym (arithmetic-shift (struct-type-shape-field-count constantness)
4))]
3))]
[(constructor-shape? constantness)
(to-sym (bitwise-ior 1 (arithmetic-shift (constructor-shape-arity constantness)
4)))]
3)))]
[(predicate-shape? constantness) (to-sym 2)]
[(accessor-shape? constantness)
(to-sym (bitwise-ior 3 (arithmetic-shift (accessor-shape-field-count constantness)
4)))]
3)))]
[(mutator-shape? constantness)
(to-sym (bitwise-ior 4 (arithmetic-shift (mutator-shape-field-count constantness)
4)))]
3)))]
[(struct-type-property-shape? constantness)
(to-sym #:prefix "prop"
(if (struct-type-property-shape-has-guard? constantness)
@ -1197,7 +1197,7 @@
(append
(vector->list closure-map)
(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)))]
[set-bit! (lambda (i bit)
(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)))
(case n
[(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
;; 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)
(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
#:method [method-bss #"GET"]
#:content-decode [decodes '(gzip)]
@ -302,13 +307,9 @@
(regexp-member #rx#"^(?i:Connection: +close)$" headers)))
(when close?
(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?)
(cond
[head? (values (open-input-bytes #"") #f)]
[(head? method-bss) (values (open-input-bytes #"") #f)]
[(regexp-member #rx#"^(?i:Transfer-Encoding: +chunked)$" headers)
(values (http-conn-response-port/chunked! hc #:close? #t)
#t)]
@ -327,7 +328,7 @@
(values (http-conn-response-port/rest! hc) #t)]))
(define decoded-response-port
(cond
[head? raw-response-port]
[(head? method-bss) raw-response-port]
[(and (memq 'gzip decodes)
(regexp-member #rx#"^(?i:Content-Encoding: +gzip)$" headers)
(not (eof-object? (peek-byte raw-response-port))))
@ -377,13 +378,15 @@
#:data [data #f]
#:content-decode [decodes '(gzip)])
(define hc (http-conn-open host-bs #:ssl? ssl? #:port port))
(http-conn-sendrecv! hc url-bs
#:version version-bs
#:method method-bss
#:headers headers-bs
#:data data
#:content-decode decodes
#:close? #t))
(begin0 (http-conn-sendrecv! hc url-bs
#:version version-bs
#:method method-bss
#:headers headers-bs
#:data data
#:content-decode decodes
#:close? #t)
(when (head? method-bss)
(http-conn-close! hc))))
(define data-procedure/c
(-> (-> (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)
#: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))
(define-ssl SSL_CTX_callback_ctrl
(_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
(define (do-template ctx tstx quasi? loc-id)
(with-disappeared-uses
(parameterize ((current-syntax-context ctx)
(quasi (and quasi? (box null))))
(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)
'props-guide
'guide
vars-vector)))])))))))
vars-vector)))]))))))))
(define-syntax (template stx)
(syntax-case stx ()
@ -599,7 +600,8 @@ instead of integers and integer vectors.
(values drivers #f guide props-guide))]))
(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)
(let* ([pvar-depth (syntax-mapping-depth v)]
[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
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();
/*
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: */
#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
gen-1/2 space: */
#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->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->place_memory_limit = (uintptr_t)(intptr_t)-1;
@ -973,6 +976,16 @@ intptr_t GC_get_memory_use(void *o)
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 */
/* */
@ -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_mem_allocated = mmu_memory_allocated(gc->mmu) + gc->phantom_count + gc->gen0_phantom_count;
gc->total_memory_allocated += old_gen0;
TIME_DECLS();
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
fraction of the actual use by live data: */
|| (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
? INCREMENTAL_EXTRA_SIZE_RATIO
: 1)))

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

@ -312,6 +312,8 @@ typedef struct NewGC {
uintptr_t minor_old_skipped;
uintptr_t modified_unprotects;
uintptr_t total_memory_allocated; /* doesn't include current gen0 */
/* THREAD_LOCAL variables that need to be saved off */
void *saved_GC_variable_stack;
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
};
#define SCHEME_INPORT_VAL(i) (((Scheme_Input_Port *)i)->port_data)
struct Scheme_Output_Port
{
struct Scheme_Port p;
@ -1566,6 +1568,8 @@ struct Scheme_Output_Port
struct Scheme_Input_Port *input_half;
};
#define SCHEME_OUTPORT_VAL(o) (((Scheme_Output_Port *)o)->port_data)
#define SCHEME_SPECIAL (-2)
#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_;
intptr_t scheme_code_page_total_;
intptr_t max_gc_pre_used_bytes_;
int num_major_garbage_collections_;
int num_minor_garbage_collections_;
int locale_on_;
void *current_locale_name_ptr_;
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 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 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 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_)

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;
#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 manage_mem_use, manage_real_mem_use;
@ -2230,11 +2230,14 @@ void GC_dump(void)
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
with the Boehm GC */
return (long)mem_real_use;
return (size_t)mem_real_use;
}
size_t GC_get_total_bytes()
{
return (size_t)mem_cumulative_use;
}
void GC_end_stubborn_change(void *p)
@ -2504,6 +2507,7 @@ static void *do_malloc(SET_NO_BACKINFO
else
mem_use += size;
mem_real_use += (size + sizeof(MemoryChunk));
mem_cumulative_use += (size + sizeof(MemoryChunk));
num_chunks++;
if (!low_plausible || (c->start < low_plausible))
@ -2642,6 +2646,7 @@ static void *do_malloc(SET_NO_BACKINFO
high_plausible = block->end;
mem_real_use += SECTOR_SEGMENT_SIZE;
mem_cumulative_use += SECTOR_SEGMENT_SIZE;
block_top:
@ -2950,6 +2955,7 @@ static void register_finalizer(void *p, void (*f)(void *p, void *data),
if (!fn) {
fn = (Finalizer *)malloc_managed(sizeof(Finalizer));
mem_real_use += sizeof(Finalizer);
mem_cumulative_use += sizeof(Finalizer);
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 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 *);

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

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

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

@ -191,6 +191,7 @@
s_v
iSi_s
siS_v
Sii_s
z_p
si_s
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;
DEBUG_COUNT_ALLOCATION(scheme_make_integer(scheme_hash_table_type));
table = MALLOC_ONE_TAGGED(Scheme_Hash_Table);
table->size = 0;
@ -640,6 +642,8 @@ Scheme_Hash_Table *scheme_clone_hash_table(Scheme_Hash_Table *ht)
Scheme_Hash_Table *table;
Scheme_Object **ba;
DEBUG_COUNT_ALLOCATION(scheme_make_integer(scheme_hash_table_type));
table = MALLOC_ONE_TAGGED(Scheme_Hash_Table);
memcpy(table, ht, sizeof(Scheme_Hash_Table));
MZ_OPT_HASH_KEY(&(table->iso)) = 0;
@ -723,6 +727,8 @@ scheme_make_bucket_table (intptr_t size, int type)
Scheme_Bucket_Table *table;
size_t asize;
DEBUG_COUNT_ALLOCATION(scheme_make_integer(scheme_bucket_table_type));
table = MALLOC_ONE_TAGGED(Scheme_Bucket_Table);
table->size = 4;
@ -1119,6 +1125,8 @@ Scheme_Bucket_Table *scheme_clone_bucket_table(Scheme_Bucket_Table *bt)
Scheme_Bucket_Table *table;
size_t asize;
DEBUG_COUNT_ALLOCATION(scheme_make_integer(scheme_bucket_table_type));
table = MALLOC_ONE_TAGGED(Scheme_Bucket_Table);
table->so.type = scheme_bucket_table_type;
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)
/* 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));
}

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_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 *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 *on_demand_jit_arity_code, *in_progress_on_demand_jit_arity_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_si_s(scheme_struct_ref, 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_procedure_arity_includes, 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_struct_ref scheme_struct_ref
# 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_scheme_string_eq_2 scheme_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 \
id(g216, g217, g218); \
}
#define define_ts_z_p(id, src_type) \
static void* ts_ ## id(size_t g219) \
#define define_ts_Sii_s(id, src_type) \
static Scheme_Object* ts_ ## id(Scheme_Object** g219, int g220, int g221) \
XFORM_SKIP_PROC \
{ \
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 \
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) \
static Scheme_Object* ts_ ## id(Scheme_Object* g220, int g221) \
static Scheme_Object* ts_ ## id(Scheme_Object* g223, int g224) \
XFORM_SKIP_PROC \
{ \
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 \
return id(g220, g221); \
return id(g223, g224); \
}
#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 \
{ \
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 \
id(g222, g223, g224); \
id(g225, g226, g227); \
}
#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 \
{ \
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 \
return id(g225, g226); \
return id(g228, g229); \
}
#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 \
{ \
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 \
id(g227, g228, g229); \
id(g230, g231, g232); \
}
#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 \
{ \
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 \
return id(g230, g231, g232); \
return id(g233, g234, g235); \
}
#define define_ts__v(id, src_type) \
static void ts_ ## id() \
@ -251,11 +260,11 @@ static void ts_ ## id() \
id(); \
}
#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 \
{ \
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 \
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
{
Scheme_Future_Thread_State *fts = scheme_future_thread_state;
@ -13,9 +13,9 @@
future->time_of_request = tm;
future->source_of_request = who;
future->source_type = src_type;
future->arg_s0 = g235;
future->arg_i1 = g236;
future->arg_S2 = g237;
future->arg_s0 = g238;
future->arg_i1 = g239;
future->arg_S2 = g240;
future_do_runtimecall(fts, (void*)f, 0, 1, 0);
fts->thread = scheme_current_thread;
@ -25,7 +25,7 @@
receive_special_result(future, retval, 1);
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
{
Scheme_Future_Thread_State *fts = scheme_future_thread_state;
@ -40,9 +40,9 @@
future->time_of_request = tm;
future->source_of_request = who;
future->source_type = src_type;
future->arg_i0 = g238;
future->arg_S1 = g239;
future->arg_s2 = g240;
future->arg_i0 = g241;
future->arg_S1 = g242;
future->arg_s2 = g243;
future_do_runtimecall(fts, (void*)f, 0, 1, 0);
fts->thread = scheme_current_thread;
@ -52,7 +52,7 @@
receive_special_result(future, retval, 1);
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
{
Scheme_Future_Thread_State *fts = scheme_future_thread_state;
@ -67,8 +67,8 @@
future->time_of_request = tm;
future->source_of_request = who;
future->source_type = src_type;
future->arg_s0 = g241;
send_special_result(future, g241);
future->arg_s0 = g244;
send_special_result(future, g244);
future_do_runtimecall(fts, (void*)f, 0, 1, 0);
fts->thread = scheme_current_thread;
future = fts->thread->current_ft;
@ -77,7 +77,7 @@
receive_special_result(future, retval, 1);
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
{
Scheme_Future_Thread_State *fts = scheme_future_thread_state;
@ -92,7 +92,7 @@
future->time_of_request = tm;
future->source_of_request = who;
future->source_type = src_type;
future->arg_n0 = g242;
future->arg_n0 = g245;
future_do_runtimecall(fts, (void*)f, 0, 1, 0);
fts->thread = scheme_current_thread;
@ -127,7 +127,7 @@
receive_special_result(future, retval, 1);
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
{
Scheme_Future_Thread_State *fts = scheme_future_thread_state;
@ -142,8 +142,8 @@
future->time_of_request = tm;
future->source_of_request = who;
future->source_type = src_type;
future->arg_s0 = g243;
future->arg_s1 = g244;
future->arg_s0 = g246;
future->arg_s1 = g247;
future_do_runtimecall(fts, (void*)f, 0, 1, 0);
fts->thread = scheme_current_thread;
@ -153,7 +153,7 @@
receive_special_result(future, retval, 1);
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
{
Scheme_Future_Thread_State *fts = scheme_future_thread_state;
@ -168,9 +168,9 @@
future->time_of_request = tm;
future->source_of_request = who;
future->source_type = src_type;
future->arg_s0 = g245;
future->arg_s1 = g246;
future->arg_i2 = g247;
future->arg_s0 = g248;
future->arg_s1 = g249;
future->arg_i2 = g250;
future_do_runtimecall(fts, (void*)f, 0, 1, 0);
fts->thread = scheme_current_thread;
@ -180,7 +180,7 @@
receive_special_result(future, retval, 1);
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
{
Scheme_Future_Thread_State *fts = scheme_future_thread_state;
@ -195,8 +195,8 @@
future->time_of_request = tm;
future->source_of_request = who;
future->source_type = src_type;
future->arg_t0 = g248;
future->arg_t1 = g249;
future->arg_t0 = g251;
future->arg_t1 = g252;
future_do_runtimecall(fts, (void*)f, 0, 1, 0);
fts->thread = scheme_current_thread;
@ -206,7 +206,7 @@
receive_special_result(future, retval, 1);
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
{
Scheme_Future_Thread_State *fts = scheme_future_thread_state;
@ -221,8 +221,8 @@
future->time_of_request = tm;
future->source_of_request = who;
future->source_type = src_type;
future->arg_s0 = g250;
future->arg_s1 = g251;
future->arg_s0 = g253;
future->arg_s1 = g254;
future_do_runtimecall(fts, (void*)f, 0, 1, 0);
fts->thread = scheme_current_thread;
@ -232,7 +232,7 @@
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
{
Scheme_Future_Thread_State *fts = scheme_future_thread_state;
@ -247,8 +247,8 @@
future->time_of_request = tm;
future->source_of_request = who;
future->source_type = src_type;
future->arg_S0 = g252;
future->arg_l1 = g253;
future->arg_S0 = g255;
future->arg_l1 = g256;
future_do_runtimecall(fts, (void*)f, 0, 1, 0);
fts->thread = scheme_current_thread;
@ -258,7 +258,7 @@
receive_special_result(future, retval, 1);
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
{
Scheme_Future_Thread_State *fts = scheme_future_thread_state;
@ -273,7 +273,7 @@
future->time_of_request = tm;
future->source_of_request = who;
future->source_type = src_type;
future->arg_l0 = g254;
future->arg_l0 = g257;
future_do_runtimecall(fts, (void*)f, 0, 1, 0);
fts->thread = scheme_current_thread;
@ -283,7 +283,7 @@
receive_special_result(future, retval, 1);
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
{
Scheme_Future_Thread_State *fts = scheme_future_thread_state;
@ -298,9 +298,9 @@
future->time_of_request = tm;
future->source_of_request = who;
future->source_type = src_type;
future->arg_b0 = g255;
future->arg_s1 = g256;
future->arg_i2 = g257;
future->arg_b0 = g258;
future->arg_s1 = g259;
future->arg_i2 = g260;
future_do_runtimecall(fts, (void*)f, 0, 1, 0);
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
{
Scheme_Future_Thread_State *fts = scheme_future_thread_state;
@ -325,9 +325,9 @@
future->time_of_request = tm;
future->source_of_request = who;
future->source_type = src_type;
future->arg_i0 = g258;
future->arg_i1 = g259;
future->arg_S2 = g260;
future->arg_i0 = g261;
future->arg_i1 = g262;
future->arg_S2 = g263;
future_do_runtimecall(fts, (void*)f, 0, 1, 0);
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
{
Scheme_Future_Thread_State *fts = scheme_future_thread_state;
@ -352,8 +352,8 @@
future->time_of_request = tm;
future->source_of_request = who;
future->source_type = src_type;
future->arg_s0 = g261;
future->arg_s1 = g262;
future->arg_s0 = g264;
future->arg_s1 = g265;
future_do_runtimecall(fts, (void*)f, 0, 1, 0);
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
{
Scheme_Future_Thread_State *fts = scheme_future_thread_state;
@ -378,7 +378,7 @@
future->time_of_request = tm;
future->source_of_request = who;
future->source_type = src_type;
future->arg_b0 = g263;
future->arg_b0 = g266;
future_do_runtimecall(fts, (void*)f, 0, 1, 0);
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
{
Scheme_Future_Thread_State *fts = scheme_future_thread_state;
@ -403,8 +403,8 @@
future->time_of_request = tm;
future->source_of_request = who;
future->source_type = src_type;
future->arg_s0 = g264;
future->arg_l1 = g265;
future->arg_s0 = g267;
future->arg_l1 = g268;
future_do_runtimecall(fts, (void*)f, 0, 1, 0);
fts->thread = scheme_current_thread;
@ -414,7 +414,7 @@
receive_special_result(future, retval, 1);
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
{
Scheme_Future_Thread_State *fts = scheme_future_thread_state;
@ -429,8 +429,8 @@
future->time_of_request = tm;
future->source_of_request = who;
future->source_type = src_type;
future->arg_i0 = g266;
future->arg_S1 = g267;
future->arg_i0 = g269;
future->arg_S1 = g270;
future_do_runtimecall(fts, (void*)f, 0, 1, 0);
fts->thread = scheme_current_thread;
@ -440,7 +440,7 @@
receive_special_result(future, retval, 1);
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
{
Scheme_Future_Thread_State *fts = scheme_future_thread_state;
@ -455,7 +455,7 @@
future->time_of_request = tm;
future->source_of_request = who;
future->source_type = src_type;
future->arg_S0 = g268;
future->arg_S0 = g271;
future_do_runtimecall(fts, (void*)f, 0, 1, 0);
fts->thread = scheme_current_thread;
@ -465,7 +465,7 @@
receive_special_result(future, retval, 1);
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
{
Scheme_Future_Thread_State *fts = scheme_future_thread_state;
@ -480,8 +480,8 @@
future->time_of_request = tm;
future->source_of_request = who;
future->source_type = src_type;
future->arg_s0 = g269;
send_special_result(future, g269);
future->arg_s0 = g272;
send_special_result(future, g272);
future_do_runtimecall(fts, (void*)f, 0, 1, 0);
fts->thread = scheme_current_thread;
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
{
Scheme_Future_Thread_State *fts = scheme_future_thread_state;
@ -505,9 +505,9 @@
future->time_of_request = tm;
future->source_of_request = who;
future->source_type = src_type;
future->arg_i0 = g270;
future->arg_S1 = g271;
future->arg_i2 = g272;
future->arg_i0 = g273;
future->arg_S1 = g274;
future->arg_i2 = g275;
future_do_runtimecall(fts, (void*)f, 0, 1, 0);
fts->thread = scheme_current_thread;
@ -517,7 +517,7 @@
receive_special_result(future, retval, 1);
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
{
Scheme_Future_Thread_State *fts = scheme_future_thread_state;
@ -532,9 +532,9 @@
future->time_of_request = tm;
future->source_of_request = who;
future->source_type = src_type;
future->arg_s0 = g273;
future->arg_i1 = g274;
future->arg_S2 = g275;
future->arg_s0 = g276;
future->arg_i1 = g277;
future->arg_S2 = g278;
future_do_runtimecall(fts, (void*)f, 0, 1, 0);
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
{
Scheme_Future_Thread_State *fts = scheme_future_thread_state;
@ -559,7 +586,7 @@
future->time_of_request = tm;
future->source_of_request = who;
future->source_type = src_type;
future->arg_z0 = g276;
future->arg_z0 = g282;
future_do_runtimecall(fts, (void*)f, 0, 1, 0);
fts->thread = scheme_current_thread;
@ -569,7 +596,7 @@
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
{
Scheme_Future_Thread_State *fts = scheme_future_thread_state;
@ -584,8 +611,8 @@
future->time_of_request = tm;
future->source_of_request = who;
future->source_type = src_type;
future->arg_s0 = g277;
future->arg_i1 = g278;
future->arg_s0 = g283;
future->arg_i1 = g284;
future_do_runtimecall(fts, (void*)f, 0, 1, 0);
fts->thread = scheme_current_thread;
@ -595,7 +622,7 @@
receive_special_result(future, retval, 1);
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
{
Scheme_Future_Thread_State *fts = scheme_future_thread_state;
@ -610,9 +637,9 @@
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_s2 = g281;
future->arg_s0 = g285;
future->arg_i1 = g286;
future->arg_s2 = g287;
future_do_runtimecall(fts, (void*)f, 0, 1, 0);
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
{
Scheme_Future_Thread_State *fts = scheme_future_thread_state;
@ -637,8 +664,8 @@
future->time_of_request = tm;
future->source_of_request = who;
future->source_type = src_type;
future->arg_s0 = g282;
future->arg_s1 = g283;
future->arg_s0 = g288;
future->arg_s1 = g289;
future_do_runtimecall(fts, (void*)f, 0, 1, 0);
fts->thread = scheme_current_thread;
@ -648,7 +675,7 @@
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
{
Scheme_Future_Thread_State *fts = scheme_future_thread_state;
@ -663,9 +690,9 @@
future->time_of_request = tm;
future->source_of_request = who;
future->source_type = src_type;
future->arg_i0 = g284;
future->arg_S1 = g285;
future->arg_p2 = g286;
future->arg_i0 = g290;
future->arg_S1 = g291;
future->arg_p2 = g292;
future_do_runtimecall(fts, (void*)f, 0, 1, 0);
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
{
Scheme_Future_Thread_State *fts = scheme_future_thread_state;
@ -690,9 +717,9 @@
future->time_of_request = tm;
future->source_of_request = who;
future->source_type = src_type;
future->arg_s0 = g287;
future->arg_s1 = g288;
future->arg_s2 = g289;
future->arg_s0 = g293;
future->arg_s1 = g294;
future->arg_s2 = g295;
future_do_runtimecall(fts, (void*)f, 0, 1, 0);
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
{
Scheme_Future_Thread_State *fts = scheme_future_thread_state;
@ -742,8 +769,8 @@
future->time_of_request = tm;
future->source_of_request = who;
future->source_type = src_type;
future->arg_i0 = g290;
future->arg_S1 = g291;
future->arg_i0 = g296;
future->arg_S1 = g297;
future_do_runtimecall(fts, (void*)f, 0, 1, 0);
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
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
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
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
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
typedef Scheme_Object* (*prim__s)();
Scheme_Object* scheme_rtcall__s(const char *who, int src_type, prim__s f );
#define SIG_ss_s 16
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
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
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
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
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
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
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
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
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
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
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
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
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
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
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
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);
#define SIG_z_p 32
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_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);
void* scheme_rtcall_z_p(const char *who, int src_type, prim_z_p f, size_t g390);
#define SIG_si_s 33
void* scheme_rtcall_z_p(const char *who, int src_type, prim_z_p f, size_t g402);
#define SIG_si_s 34
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);
#define SIG_sis_v 34
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 35
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);
#define SIG_ss_i 35
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 36
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);
#define SIG_iSp_v 36
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 37
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);
#define SIG_sss_s 37
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 38
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);
#define SIG__v 38
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 39
typedef void (*prim__v)();
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**);
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);
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;
}
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);
#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;
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 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;
Scheme_Native_Closure *inline_direct_native = NULL;
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;
}
#ifdef USE_FLONUM_UNBOXING
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))) {
if (direct_lam)
num_unsafe_struct_refs = 0;
else
#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 extfl;
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 {
(void)jit_movi_p(JIT_R0, NULL);
}
} else
#endif
if (inline_direct_args) {
if (inline_direct_args[i].gen)
} else if (inline_direct_args) {
if (inline_direct_args[i].gen)
scheme_generate(arg, jitter, 0, 0, 0, inline_direct_args[i].reg, NULL, NULL);
} else
scheme_generate_non_tail(arg, jitter, 0, !need_non_tail, 0); /* sync'd below */
} else
scheme_generate_non_tail(arg, jitter, 0, !need_non_tail, 0); /* sync'd below */
RESUME_JIT_DATA();
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;
}
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

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]);
}
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
#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);
}
/* *** 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 *** */
/* 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)
{
#ifdef MZ_PRECISE_GC
DEBUG_COUNT_ALLOCATION(scheme_make_integer(scheme_pair_type));
return GC_malloc_pair(car, cdr);
#else
Scheme_Object *cons;
DEBUG_COUNT_ALLOCATION(scheme_make_integer(scheme_pair_type));
cons = scheme_alloc_object();
cons->type = scheme_pair_type;
SCHEME_CAR(cons) = car;
@ -1793,6 +1795,8 @@ Scheme_Object *scheme_box(Scheme_Object *v)
{
Scheme_Object *obj;
DEBUG_COUNT_ALLOCATION(scheme_make_integer(scheme_box_type));
obj = scheme_alloc_small_object();
obj->type = scheme_box_type;
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)
{
#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);
#else
Scheme_Small_Object *obj;
DEBUG_COUNT_ALLOCATION(scheme_make_integer(scheme_weak_box_type));
obj = MALLOC_ONE_TAGGED_WEAK(Scheme_Small_Object);
obj->iso.so.type = scheme_weak_box_type;
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);
} else {
print_utf8_string(pp, "#<", 0, 2);
print_string_in_angle(pp, scheme_symbol_val(((Scheme_Struct_Type *)obj)->name),
"struct-type:",
SCHEME_SYM_LEN(((Scheme_Struct_Type *)obj)->name));
if (((Scheme_Struct_Type *)obj)->name) {
print_string_in_angle(pp, scheme_symbol_val(((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);
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);
} else {
print_utf8_string(pp, "#<", 0, 2);
print_string_in_angle(pp, scheme_symbol_val(((Scheme_Struct_Property *)obj)->name),
"struct-type-property:",
SCHEME_SYM_LEN(((Scheme_Struct_Property *)obj)->name));
if (((Scheme_Struct_Property *)obj)->name) {
print_string_in_angle(pp, scheme_symbol_val(((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);
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
/**********************************************************************/
#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
/* 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 */
/*========================================================================*/

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;
DEBUG_COUNT_ALLOCATION((Scheme_Object *)stype);
c = stype->num_slots;
inst = (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;
int c;
DEBUG_COUNT_ALLOCATION((Scheme_Object *)stype);
c = stype->num_slots;
inst = (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;
int i, c;
DEBUG_COUNT_ALLOCATION((Scheme_Object *)stype);
c = stype->num_slots;
inst = (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];
int i, c;
DEBUG_COUNT_ALLOCATION((Scheme_Object *)stype);
c = stype->num_slots;
inst = (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;
DEBUG_COUNT_ALLOCATION(scheme_make_integer(scheme_stx_type));
stx = MALLOC_ONE_TAGGED(Scheme_Stx);
stx->iso.so.type = scheme_stx_type;
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 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 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 *client_symbol, *server_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;
@ -528,6 +531,9 @@ void scheme_init_thread(Scheme_Env *env)
minor_symbol = scheme_intern_symbol("minor");
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("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[])
{
Scheme_Object *arg = NULL;
int cumulative = 0;
uintptr_t retval = 0;
if (argc) {
@ -741,19 +748,30 @@ static Scheme_Object *current_memory_use(int argc, Scheme_Object *args[])
arg = args[0];
} else if (SAME_TYPE(SCHEME_TYPE(args[0]), scheme_custodian_type)) {
arg = args[0];
} else if (SAME_OBJ(args[0], cumulative_symbol)) {
cumulative = 1;
arg = NULL;
} else {
scheme_wrong_contract("current-memory-use",
"(or/c custodian? #f)",
"(or/c custodian? 'cumulative #f)",
0, argc, args);
}
}
if (cumulative) {
#ifdef MZ_PRECISE_GC
retval = GC_get_memory_use(arg);
retval = GC_get_memory_ever_allocated();
#else
scheme_unused_object(arg);
retval = GC_get_memory_use();
retval = GC_get_total_bytes();
#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);
}
@ -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 = pre_used;
if (major_gc)
num_major_garbage_collections++;
else
num_minor_garbage_collections++;
logger = scheme_get_gc_logger();
if (logger && scheme_log_level_p(logger, SCHEME_LOG_DEBUG)) {
/* 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) {
logger = scheme_get_gc_logger();
if (logger && scheme_log_level_p(logger, SCHEME_LOG_DEBUG)) {
char buf[256], nums[128], *num, *num2;
intptr_t buflen;
char buf[256], nums[128], *num, *numt, *num2;
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));
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);
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
scheme_current_place_id,
#endif
num,
numt,
num_major_garbage_collections,
num_minor_garbage_collections,
num2);
buflen = strlen(buf);
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);
}
DEBUG_COUNT_ALLOCATION(scheme_make_integer(scheme_vector_type));
if (size < 1024) {
vec = (Scheme_Object *)scheme_malloc_tagged(VECTOR_BYTES(size));
} else {