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

fix problems with recent FFI changes

Browse Source 
svn: r16565
This commit is contained in:
Matthew Flatt 2009-11-05 20:29:18 +00:00
parent a021b75a67
commit c880b2119c
3 changed files with 19 additions and 6 deletions
Show Stats Download Patch File Download Diff File Expand all files Collapse all files

6
collects/scheme/foreign.ss
View File

@ -1280,8 +1280,8 @@
[(pointer) _pointer]
[(gcpointer) _gcpointer]
[(fpointer) _fpointer])
(lambda (v) (and v (cast _pointer v)))
(lambda (v) (and v (cast ctype v))))))
(lambda (v) (and v (cast v _pointer _pointer)))
(lambda (v) (and v (cast v _pointer ctype))))))
(define* (_gcable ctype)
(unless (memq (ctype-coretype ctype) '(pointer gcpointer))
@ -1298,7 +1298,7 @@
(let loop ([c (ctype-basetype c)])
(if (symbol? c)
c
(loop c))))
(loop (ctype-basetype c)))))
;; A macro version of the above two functions, using the defined name for a tag
;; string, and defining a predicate too. The name should look like `_foo', the

16
src/foreign/foreign.c
View File

@ -1629,7 +1629,13 @@ static void* SCHEME2C(Scheme_Object *type, void *dst, long delta,
tmp = (void*)(SCHEME_FFIANYPTR_VAL(val));
toff = SCHEME_FFIANYPTR_OFFSET(val);
if (_offset) *_offset = toff;
(((void**)W_OFFSET(dst,delta))[0]) = tmp; return NULL;
if (basetype_p == NULL || (tmp == NULL && toff == 0)) {
(((void**)W_OFFSET(dst,delta))[0]) = (_offset ? tmp : (void*)W_OFFSET(tmp, toff));
return NULL;
} else {
*basetype_p = FOREIGN_gcpointer;
return _offset ? tmp : (void*)W_OFFSET(tmp, toff);
}
} else {
scheme_wrong_type("Scheme->C","gcpointer",0,1,&(val));
return NULL; /* hush the compiler */
@ -1644,7 +1650,13 @@ static void* SCHEME2C(Scheme_Object *type, void *dst, long delta,
if (1) {
Scheme_Object* tmp;
tmp = (Scheme_Object*)(val);
(((Scheme_Object**)W_OFFSET(dst,delta))[0]) = tmp; return NULL;
if (basetype_p == NULL || tmp == NULL) {
(((Scheme_Object**)W_OFFSET(dst,delta))[0]) = tmp;
return NULL;
} else {
*basetype_p = FOREIGN_scheme;
return tmp;
}
} else {
scheme_wrong_type("Scheme->C","scheme",0,1,&(val));
return NULL; /* hush the compiler */

3
src/foreign/foreign.ssc
View File

@ -538,7 +538,8 @@ Scheme_Object *utf16_pointer_to_ucs4_string(unsigned short *utf)
[s->c (get 's->c)]
[c->s (get 'c->s)]
[offset (get 'offset)]
[ptr? (equal? "pointer" ftype)])
[ptr? (or (equal? "pointer" ftype)
(equal? "gcpointer" ftype))])
body ...))
types)))]))