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

fix ffi handling of non-GCable pointers with offsets

Browse Source 
Closes PR 11567
This commit is contained in:
Matthew Flatt 2010-12-25 09:31:38 -06:00
parent 8bb2543b34
commit e7b52bf10f
3 changed files with 37 additions and 13 deletions
Show Stats Download Patch File Download Diff File Expand all files Collapse all files

19
collects/tests/racket/foreign-test.rktl
View File

@ -256,6 +256,25 @@
(test 'hello hash-ref ht seventeen2 #f) (test 'hello hash-ref ht seventeen2 #f)
(test 'hello hash-ref ht seventeen3 #f))) (test 'hello hash-ref ht seventeen3 #f)))
;; Check proper handling of offsets:
(let ()
(define scheme_make_sized_byte_string
(get-ffi-obj 'scheme_make_sized_byte_string #f (_fun _pointer _long _int -> _scheme)))
;; Non-gcable:
(let ()
(define p (cast (ptr-add #f 20) _pointer _pointer))
(define d (scheme_make_sized_byte_string (ptr-add p 24)
4
0))
(test 44 values (cast d _pointer _long)))
;; GCable:
(let ()
(define p (cast (ptr-add #f 20) _pointer _gcpointer))
(define d (scheme_make_sized_byte_string (ptr-add p 24)
4
0))
(test 44 values (cast d _gcpointer _long))))
(delete-test-files) (delete-test-files)
(report-errs) (report-errs)

14
src/foreign/foreign.c
View File

@ -1676,12 +1676,14 @@ static void* SCHEME2C(Scheme_Object *type, void *dst, intptr_t delta,
void* tmp; intptr_t toff; void* tmp; intptr_t toff;
tmp = (void*)(SCHEME_FFIANYPTR_VAL(val)); tmp = (void*)(SCHEME_FFIANYPTR_VAL(val));
toff = SCHEME_FFIANYPTR_OFFSET(val); toff = SCHEME_FFIANYPTR_OFFSET(val);
if (_offset) *_offset = toff;
if (basetype_p == NULL || (tmp == NULL && toff == 0) || !is_gcable_pointer(val)) { if (basetype_p == NULL || (tmp == NULL && toff == 0) || !is_gcable_pointer(val)) {
(((void**)W_OFFSET(dst,delta))[0]) = (_offset ? tmp : (void*)W_OFFSET(tmp, toff)); if (_offset) *_offset = 0;
(((void**)W_OFFSET(dst,delta))[0]) = (void*)W_OFFSET(tmp, toff);;
return NULL; return NULL;
} else { } else {
*basetype_p = FOREIGN_pointer; *basetype_p = FOREIGN_pointer;
toff = SCHEME_FFIANYPTR_OFFSET(val);
if (_offset) *_offset = toff;
return _offset ? tmp : (void*)W_OFFSET(tmp, toff); return _offset ? tmp : (void*)W_OFFSET(tmp, toff);
} }
} else { } else {
@ -1699,12 +1701,14 @@ static void* SCHEME2C(Scheme_Object *type, void *dst, intptr_t delta,
void* tmp; intptr_t toff; void* tmp; intptr_t toff;
tmp = (void*)(SCHEME_FFIANYPTR_VAL(val)); tmp = (void*)(SCHEME_FFIANYPTR_VAL(val));
toff = SCHEME_FFIANYPTR_OFFSET(val); toff = SCHEME_FFIANYPTR_OFFSET(val);
if (_offset) *_offset = toff;
if (basetype_p == NULL || (tmp == NULL && toff == 0) || 0) { if (basetype_p == NULL || (tmp == NULL && toff == 0) || 0) {
(((void**)W_OFFSET(dst,delta))[0]) = (_offset ? tmp : (void*)W_OFFSET(tmp, toff)); if (_offset) *_offset = 0;
(((void**)W_OFFSET(dst,delta))[0]) = (void*)W_OFFSET(tmp, toff);;
return NULL; return NULL;
} else { } else {
*basetype_p = FOREIGN_gcpointer; *basetype_p = FOREIGN_gcpointer;
toff = SCHEME_FFIANYPTR_OFFSET(val);
if (_offset) *_offset = toff;
return _offset ? tmp : (void*)W_OFFSET(tmp, toff); return _offset ? tmp : (void*)W_OFFSET(tmp, toff);
} }
} else { } else {
@ -1749,7 +1753,7 @@ static void* SCHEME2C(Scheme_Object *type, void *dst, intptr_t delta,
return NULL; return NULL;
} else { } else {
*basetype_p = FOREIGN_struct; *basetype_p = FOREIGN_struct;
if (_offset) { if (_offset && is_gcable_pointer(val)) {
*_offset = poff; *_offset = poff;
return p; return p;
} else { } else {

17
src/foreign/foreign.rktc
View File

@ -1156,10 +1156,7 @@ static void* SCHEME2C(Scheme_Object *type, void *dst, intptr_t delta,
if (@f[pred]) { if (@f[pred]) {
@ctype tmp@";"@and[offset]{ intptr_t toff@";"} @ctype tmp@";"@and[offset]{ intptr_t toff@";"}
tmp = (@ctype)(@f[s->c]); tmp = (@ctype)(@f[s->c]);
@and[offset @list{ @and[offset @list{toff = SCHEME_@|offset|_OFFSET(val);@"\n"}]@;
toff = SCHEME_@|offset|_OFFSET(val);
if (_offset) *_offset = toff;@;
@"\n" }]@;
@(if ptr? @(if ptr?
@list{if (basetype_p == NULL || @; @list{if (basetype_p == NULL || @;
@(if offset @(if offset
@ -1168,13 +1165,17 @@ static void* SCHEME2C(Scheme_Object *type, void *dst, intptr_t delta,
@(if (equal? ftype "pointer") @(if (equal? ftype "pointer")
@list{!is_gcable_pointer(val)} @list{!is_gcable_pointer(val)}
@list{0})) { @list{0})) {
@and[offset @list{if (_offset) *_offset = 0;@"\n"}]@;
@x = @(if offset @x = @(if offset
@list{(_offset ? tmp : @; @list{(@ctype)W_OFFSET(tmp, toff);}
(@ctype)W_OFFSET(tmp, toff))} "tmp");
"tmp");
return NULL; return NULL;
} else { } else {
*basetype_p = FOREIGN_@cname; *basetype_p = FOREIGN_@cname;
@and[offset @list{
toff = SCHEME_@|offset|_OFFSET(val);
if (_offset) *_offset = toff;@;
@"\n" }]@;
return @(if offset return @(if offset
@list{_offset ? tmp : @; @list{_offset ? tmp : @;
(@ctype)W_OFFSET(tmp, toff)} (@ctype)W_OFFSET(tmp, toff)}
@ -1199,7 +1200,7 @@ static void* SCHEME2C(Scheme_Object *type, void *dst, intptr_t delta,
return NULL; return NULL;
} else { } else {
*basetype_p = FOREIGN_struct; *basetype_p = FOREIGN_struct;
if (_offset) { if (_offset && is_gcable_pointer(val)) {
*_offset = poff; *_offset = poff;
return p; return p;
} else { } else {