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

fix 'interior mode for malloc

Browse Source
This commit is contained in:
Matthew Flatt 2019-01-01 11:22:54 -07:00
parent 5cec8d52c2
commit 7797d3672b
3 changed files with 16 additions and 2 deletions
Show Stats Download Patch File Download Diff File Expand all files Collapse all files

14
pkgs/racket-test-core/tests/racket/foreign-test.rktl
View File

@ -615,6 +615,20 @@
(test (cast p _thing-pointer _intptr)
cast q _stuff-pointer _intptr))
;; test 'interior allocation mode
(let ()
;; Example by Ron Garcia
(define-struct data (a b))
(define (cbox s)
(define ptr (malloc _racket 'interior))
(ptr-set! ptr _racket s)
ptr)
(define (cunbox cb)
(ptr-ref cb _racket 0))
(define cb1 (cbox (make-data 1 2)))
(collect-garbage)
(test 1 data-a (cunbox cb1)))
(let ()
(struct foo (ptr)
#:property prop:cpointer 0)

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

@ -2665,7 +2665,7 @@ static Scheme_Object *foreign_malloc(int argc, Scheme_Object *argv[])
else if (SAME_OBJ(mode, stubborn_sym)) mf = scheme_malloc_stubborn;
else if (SAME_OBJ(mode, eternal_sym)) mf = scheme_malloc_eternal;
else if (SAME_OBJ(mode, uncollectable_sym)) mf = scheme_malloc_uncollectable;
else if (SAME_OBJ(mode, interior_sym)) mf = scheme_malloc_atomic_allow_interior;
else if (SAME_OBJ(mode, interior_sym)) mf = scheme_malloc_allow_interior;
else if (SAME_OBJ(mode, atomic_interior_sym)) mf = scheme_malloc_atomic_allow_interior;
else if (SAME_OBJ(mode, raw_sym)) mf = malloc;
else if (SAME_OBJ(mode, tagged_sym)) mf = scheme_malloc_tagged;

2
racket/src/foreign/foreign.rktc
View File

@ -1904,7 +1904,7 @@ static void* SCHEME2C(const char *who,
else if (SAME_OBJ(mode, stubborn_sym)) mf = scheme_malloc_stubborn;
else if (SAME_OBJ(mode, eternal_sym)) mf = scheme_malloc_eternal;
else if (SAME_OBJ(mode, uncollectable_sym)) mf = scheme_malloc_uncollectable;
else if (SAME_OBJ(mode, interior_sym)) mf = scheme_malloc_atomic_allow_interior;
else if (SAME_OBJ(mode, interior_sym)) mf = scheme_malloc_allow_interior;
else if (SAME_OBJ(mode, atomic_interior_sym)) mf = scheme_malloc_atomic_allow_interior;
else if (SAME_OBJ(mode, raw_sym)) mf = malloc;
else if (SAME_OBJ(mode, tagged_sym)) mf = scheme_malloc_tagged;