Skip to content

Commit

Permalink
cs: use new immobile-object support
Browse files Browse the repository at this point in the history
Implement 'atomic-interior allocation and immobile cells using
`make-immobile-bytevector` and `make-immobile-vector`, which avoids
having to unlock through a finalizer.

Also, the Chez Scheme GC can now mostly mark a major generation,
instead of copying it, which can significantly reduce memory
use during a GC for an old, large heap (such as DrRacket's).
  • Loading branch information
mflatt committed Apr 22, 2020
1 parent dccd841 commit 16ad9ed
Show file tree
Hide file tree
Showing 7 changed files with 21 additions and 35 deletions.
2 changes: 1 addition & 1 deletion pkgs/base/info.rkt
Original file line number Diff line number Diff line change
Expand Up @@ -12,7 +12,7 @@

(define collection 'multi)

(define version "7.7.0.2")
(define version "7.7.0.3")

(define deps `("racket-lib"
["racket" #:version ,version]))
Expand Down
19 changes: 4 additions & 15 deletions pkgs/racket-doc/scribblings/foreign/pointers.scrbl
Original file line number Diff line number Diff line change
Expand Up @@ -280,23 +280,12 @@ specification is required at minimum:
@item{@indexed-racket['atomic-interior] --- Like
@racket['atomic], but the allocated object will not be moved by
the garbage collector as long as the allocated object is
sufficiently retained as described below.
retained.

For the @3m[] and @CGC[] Racket variants, ``sufficiently retained''
means that the garbage collector does not collect the allocated
object because some pointer (that is visible to the collector)
refers to the object. Furthermore, that reference can point to
the interior of the object, insteda of its starting address.
For the @3m[] and @CGC[] Racket variants, a reference can point
to the interior of the object, instead of its starting address.
This allocation mode corresponds to
@cpp{scheme_malloc_atomic_allow_interior} in the C API.

For the @CS[] Racket variant, ``sufficiently retained'' means that the
specific C pointer object returned by @racket[malloc] remains
accessible. Note that casting the pointer via @racket[cast], for example,
generates a new pointer object which would not by itself
prevent the result of @racket[malloc] from moving, even though
a reference to the same memory could prevent the object from
being reclaimed.}
@cpp{scheme_malloc_atomic_allow_interior} in the C API.}

@item{@indexed-racket['nonatomic-interior] --- Like
@racket['nonatomic], but the allocated object will not be moved
Expand Down
2 changes: 1 addition & 1 deletion racket/src/cs/compile-file.ss
Original file line number Diff line number Diff line change
Expand Up @@ -2,7 +2,7 @@
;; Check to make we're using a build of Chez Scheme
;; that has all the features we need.
(define-values (need-maj need-min need-sub need-dev)
(values 9 5 3 26))
(values 9 5 3 27))

(unless (guard (x [else #f]) (eval 'scheme-fork-version-number))
(error 'compile-file
Expand Down
1 change: 0 additions & 1 deletion racket/src/cs/io.sls
Original file line number Diff line number Diff line change
Expand Up @@ -475,7 +475,6 @@
[else
(post-as-asynchronous-callback go)]))))])
(let ([callable (foreign-callable __collect_safe glib-log-message (string int string) void)])
(lock-object callable)
(foreign-callable-entry-point callable))))

;; ----------------------------------------
Expand Down
4 changes: 2 additions & 2 deletions racket/src/cs/rumble/ephemeron.ss
Original file line number Diff line number Diff line change
Expand Up @@ -15,7 +15,7 @@
(if (eq? v #!bwp)
gced-v
v))]
[(e gced-v keep-live)
[(e gced-v keep-live-v)
(let ([v (ephemeron-value e gced-v)])
(#%$keep-live keep-live)
(keep-live keep-live-v)
v)]))
26 changes: 12 additions & 14 deletions racket/src/cs/rumble/foreign.ss
Original file line number Diff line number Diff line change
Expand Up @@ -1409,11 +1409,8 @@
;; a finalizer is associated with the cpointer (as opposed to
;; the address that is wrapped by the cpointer). Also, interior
;; pointers are not allowed as GCable pointers.
(let* ([bstr (make-bytevector size 0)]
[p (make-cpointer bstr #f)])
(lock-object bstr)
(unsafe-add-global-finalizer p (lambda () (unlock-object bstr)))
p)]
(let* ([bstr (make-immobile-bytevector size)])
(make-cpointer bstr #f))]
[else
(raise-unsupported-error 'malloc
(format "'~a mode is not supported" mode))]))
Expand All @@ -1427,13 +1424,18 @@
(parent cpointer)
(fields))

(define immobile-cells (make-eq-hashtable))

(define (malloc-immobile-cell v)
(let ([vec (vector v)])
(lock-object vec)
(let ([vec (make-immobile-vector 1)])
(#%vector-set! vec 0 v)
(with-global-lock
(eq-hashtable-set! immobile-cells vec #t))
(make-cpointer/cell vec #f)))

(define (free-immobile-cell b)
(unlock-object (cpointer-memory b)))
(with-global-lock
(eq-hashtable-delete! immobile-cells (cpointer-memory b))))

(define (immobile-cell-ref b)
(#%vector-ref (cpointer-memory b) 0))
Expand Down Expand Up @@ -1542,7 +1544,7 @@
;; so uses of the FFI can rely on passing an argument to a foreign
;; function as retaining the argument until the function returns.
(let ([result e])
(#%$keep-live v) ...
(keep-live v) ...
result))

(define call-locks (make-eq-hashtable))
Expand Down Expand Up @@ -1945,11 +1947,7 @@
(let ([make-code (ffi-call/callable #f in-types out-type abi #f #f #f #f (and atomic? #t) async-apply)])
(lambda (proc)
(check 'make-ffi-callback procedure? proc)
(let* ([code (make-code proc)]
[cb (create-callback code)])
(lock-object code)
(unsafe-add-global-finalizer cb (lambda () (unlock-object code)))
cb)))]))
(create-callback (make-code proc))))]))

;; ----------------------------------------

Expand Down
2 changes: 1 addition & 1 deletion racket/src/racket/src/schvers.h
Original file line number Diff line number Diff line change
Expand Up @@ -16,7 +16,7 @@
#define MZSCHEME_VERSION_X 7
#define MZSCHEME_VERSION_Y 7
#define MZSCHEME_VERSION_Z 0
#define MZSCHEME_VERSION_W 2
#define MZSCHEME_VERSION_W 3

/* A level of indirection makes `#` work as needed: */
#define AS_a_STR_HELPER(x) #x
Expand Down

0 comments on commit 16ad9ed

Please sign in to comment.