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

ffi: fix big-endian s->c conversion of bytes and shorts

Browse Source
This commit is contained in:
Matthew Flatt 2012-05-14 15:39:30 -06:00
parent 005d3b7218
commit b374d0d015
4 changed files with 93 additions and 19 deletions
Show Stats Download Patch File Download Diff File Expand all files Collapse all files

23
collects/tests/racket/foreign-test.c
View File

@ -21,14 +21,21 @@ X byte decimal_byte_int_byte (byte x, int y) { return 10*x + y; }
X byte decimal_int_byte_byte (int x, byte y) { return 10*x + y; }
X byte decimal_byte_byte_byte (byte x, byte y) { return 10*x + y; }
X int callback3_int_int_int (int(*f)(int)) { if (f) return f(3); else return 79; }
X int callback3_byte_int_int (int(*f)(byte)) { return f(3); }
X int callback3_int_byte_int (byte(*f)(int)) { return f(3); }
X int callback3_byte_byte_int (byte(*f)(byte)) { return f(3); }
X byte callback3_int_int_byte (int(*f)(int)) { return f(3); }
X byte callback3_byte_int_byte (int(*f)(byte)) { return f(3); }
X byte callback3_int_byte_byte (byte(*f)(int)) { return f(3); }
X byte callback3_byte_byte_byte (byte(*f)(byte)) { return f(3); }
X int callback3_int_int_int (int(*f)(int)) { if (f) return f(3); else return 79; }
X int callback3_byte_int_int (int(*f)(byte)) { return f(3); }
X int callback3_short_int_int (int(*f)(short)) { return f(3); }
X int callback3_int_byte_int (byte(*f)(int)) { return f(3); }
X int callback3_int_short_int (short(*f)(int)) { return f(3); }
X int callback3_byte_byte_int (byte(*f)(byte)) { return f(3); }
X int callback3_short_short_int (short(*f)(short)) { return f(3); }
X byte callback3_int_int_byte (int(*f)(int)) { return f(3); }
X short callback3_int_int_short (int(*f)(int)) { return f(3); }
X byte callback3_byte_int_byte (int(*f)(byte)) { return f(3); }
X short callback3_short_int_short (int(*f)(short)) { return f(3); }
X byte callback3_int_byte_byte (byte(*f)(int)) { return f(3); }
X short callback3_int_short_short (short(*f)(int)) { return f(3); }
X byte callback3_byte_byte_byte (byte(*f)(byte)) { return f(3); }
X short callback3_short_short_short(short(*f)(short)) { return f(3); }
X int g1;
X int curry_ret_int_int (int x) { return g1 + x; }

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

@ -151,16 +151,23 @@
(t 12 'decimal_int_byte_byte (_fun _int _byte -> _byte) 1 2)
(t 12 'decimal_byte_byte_byte (_fun _byte _byte -> _byte) 1 2)
;; ---
(t 9 'callback3_int_int_int (_fun (_fun _int -> _int ) -> _int ) sqr)
(t 79 'callback3_int_int_int (_fun (_fun _int -> _int ) -> _int ) #f) ; NULL allowed as function pointer
(t 9 'callback3_int_int_int (_fun _pointer -> _int ) (function-ptr sqr (_fun _int -> _int ))) ; callback allowed as pointer
(t 9 'callback3_byte_int_int (_fun (_fun _byte -> _int ) -> _int ) sqr)
(t 9 'callback3_int_byte_int (_fun (_fun _int -> _byte) -> _int ) sqr)
(t 9 'callback3_byte_byte_int (_fun (_fun _byte -> _byte) -> _int ) sqr)
(t 9 'callback3_int_int_byte (_fun (_fun _int -> _int ) -> _byte) sqr)
(t 9 'callback3_byte_int_byte (_fun (_fun _byte -> _int ) -> _byte) sqr)
(t 9 'callback3_int_byte_byte (_fun (_fun _int -> _byte) -> _byte) sqr)
(t 9 'callback3_byte_byte_byte (_fun (_fun _byte -> _byte) -> _byte) sqr)
(t 9 'callback3_int_int_int (_fun (_fun _int -> _int ) -> _int ) sqr)
(t 79 'callback3_int_int_int (_fun (_fun _int -> _int ) -> _int ) #f) ; NULL allowed as function pointer
(t 9 'callback3_int_int_int (_fun _pointer -> _int ) (function-ptr sqr (_fun _int -> _int ))) ; callback allowed as pointer
(t 9 'callback3_byte_int_int (_fun (_fun _byte -> _int ) -> _int ) sqr)
(t 9 'callback3_short_int_int (_fun (_fun _short -> _int ) -> _int ) sqr)
(t 9 'callback3_int_byte_int (_fun (_fun _int -> _byte) -> _int ) sqr)
(t 9 'callback3_int_short_int (_fun (_fun _int -> _short) -> _int ) sqr)
(t 9 'callback3_byte_byte_int (_fun (_fun _byte -> _byte) -> _int ) sqr)
(t 9 'callback3_short_short_int (_fun (_fun _short -> _short) -> _int ) sqr)
(t 9 'callback3_int_int_byte (_fun (_fun _int -> _int ) -> _byte) sqr)
(t 9 'callback3_int_int_short (_fun (_fun _int -> _int ) -> _short) sqr)
(t 9 'callback3_byte_int_byte (_fun (_fun _byte -> _int ) -> _byte) sqr)
(t 9 'callback3_short_int_short (_fun (_fun _short -> _int ) -> _short) sqr)
(t 9 'callback3_int_byte_byte (_fun (_fun _int -> _byte) -> _byte) sqr)
(t 9 'callback3_int_short_short (_fun (_fun _int -> _short) -> _short) sqr)
(t 9 'callback3_byte_byte_byte (_fun (_fun _byte -> _byte) -> _byte) sqr)
(t 9 'callback3_short_short_short (_fun (_fun _short -> _short) -> _short) sqr)
;; ---
(tc 3 'curry_int_int_int (_fun _int -> (_fun _int -> _int )) 1 2)
(tc 3 'curry_byte_int_int (_fun _byte -> (_fun _int -> _int )) 1 2)

54
src/foreign/foreign.c
View File

@ -1621,27 +1621,75 @@ static void* SCHEME2C(Scheme_Object *type, void *dst, intptr_t delta,
if (!ret_loc) scheme_wrong_type("Scheme->C","non-void-C-type",0,1,&(type));
break;
case FOREIGN_int8:
# ifdef SCHEME_BIG_ENDIAN
if (sizeof(Tsint8)<sizeof(int) && ret_loc) {
((int*)W_OFFSET(dst,delta))[0] = 0;
delta += (sizeof(int)-sizeof(Tsint8));
}
# endif /* SCHEME_BIG_ENDIAN */
if (!(get_byte_val(val,&(((Tsint8*)W_OFFSET(dst,delta))[0])))) scheme_wrong_type("Scheme->C","int8",0,1,&(val));
return NULL;
case FOREIGN_uint8:
# ifdef SCHEME_BIG_ENDIAN
if (sizeof(Tuint8)<sizeof(int) && ret_loc) {
((int*)W_OFFSET(dst,delta))[0] = 0;
delta += (sizeof(int)-sizeof(Tuint8));
}
# endif /* SCHEME_BIG_ENDIAN */
if (!(get_ubyte_val(val,&(((Tuint8*)W_OFFSET(dst,delta))[0])))) scheme_wrong_type("Scheme->C","uint8",0,1,&(val));
return NULL;
case FOREIGN_int16:
# ifdef SCHEME_BIG_ENDIAN
if (sizeof(Tsint16)<sizeof(int) && ret_loc) {
((int*)W_OFFSET(dst,delta))[0] = 0;
delta += (sizeof(int)-sizeof(Tsint16));
}
# endif /* SCHEME_BIG_ENDIAN */
if (!(get_short_val(val,&(((Tsint16*)W_OFFSET(dst,delta))[0])))) scheme_wrong_type("Scheme->C","int16",0,1,&(val));
return NULL;
case FOREIGN_uint16:
# ifdef SCHEME_BIG_ENDIAN
if (sizeof(Tuint16)<sizeof(int) && ret_loc) {
((int*)W_OFFSET(dst,delta))[0] = 0;
delta += (sizeof(int)-sizeof(Tuint16));
}
# endif /* SCHEME_BIG_ENDIAN */
if (!(get_ushort_val(val,&(((Tuint16*)W_OFFSET(dst,delta))[0])))) scheme_wrong_type("Scheme->C","uint16",0,1,&(val));
return NULL;
case FOREIGN_int32:
# ifdef SCHEME_BIG_ENDIAN
if (sizeof(Tsint32)<sizeof(int) && ret_loc) {
((int*)W_OFFSET(dst,delta))[0] = 0;
delta += (sizeof(int)-sizeof(Tsint32));
}
# endif /* SCHEME_BIG_ENDIAN */
if (!(scheme_get_realint_val(val,&(((Tsint32*)W_OFFSET(dst,delta))[0])))) scheme_wrong_type("Scheme->C","int32",0,1,&(val));
return NULL;
case FOREIGN_uint32:
# ifdef SCHEME_BIG_ENDIAN
if (sizeof(Tuint32)<sizeof(int) && ret_loc) {
((int*)W_OFFSET(dst,delta))[0] = 0;
delta += (sizeof(int)-sizeof(Tuint32));
}
# endif /* SCHEME_BIG_ENDIAN */
if (!(scheme_get_unsigned_realint_val(val,&(((Tuint32*)W_OFFSET(dst,delta))[0])))) scheme_wrong_type("Scheme->C","uint32",0,1,&(val));
return NULL;
case FOREIGN_int64:
# ifdef SCHEME_BIG_ENDIAN
if (sizeof(Tsint64)<sizeof(int) && ret_loc) {
((int*)W_OFFSET(dst,delta))[0] = 0;
delta += (sizeof(int)-sizeof(Tsint64));
}
# endif /* SCHEME_BIG_ENDIAN */
if (!(scheme_get_long_long_val(val,&(((Tsint64*)W_OFFSET(dst,delta))[0])))) scheme_wrong_type("Scheme->C","int64",0,1,&(val));
return NULL;
case FOREIGN_uint64:
# ifdef SCHEME_BIG_ENDIAN
if (sizeof(Tuint64)<sizeof(int) && ret_loc) {
((int*)W_OFFSET(dst,delta))[0] = 0;
delta += (sizeof(int)-sizeof(Tuint64));
}
# endif /* SCHEME_BIG_ENDIAN */
if (!(scheme_get_unsigned_long_long_val(val,&(((Tuint64*)W_OFFSET(dst,delta))[0])))) scheme_wrong_type("Scheme->C","uint64",0,1,&(val));
return NULL;
case FOREIGN_fixint:
@ -1941,6 +1989,12 @@ static void* SCHEME2C(Scheme_Object *type, void *dst, intptr_t delta,
return NULL; /* hush the compiler */
}
case FOREIGN_fpointer:
# ifdef SCHEME_BIG_ENDIAN
if (sizeof(void*)<sizeof(int) && ret_loc) {
((int*)W_OFFSET(dst,delta))[0] = 0;
delta += (sizeof(int)-sizeof(void*));
}
# endif /* SCHEME_BIG_ENDIAN */
if (!(ret_loc)) scheme_wrong_type("Scheme->C","fpointer",0,1,&(val));
break;
case FOREIGN_struct:

8
src/foreign/foreign.rktc
View File

@ -1390,7 +1390,13 @@ static void* SCHEME2C(Scheme_Object *type, void *dst, intptr_t delta,
break;
}]
[(not s->c)
@list{if (!(@(if ptr? "ret_loc" (pred "val" x)))) @;
@list{
@@IFDEF{SCHEME_BIG_ENDIAN}{
if (sizeof(@ctype)<sizeof(int) && ret_loc) {
((int*)W_OFFSET(dst,delta))[0] = 0;
delta += (sizeof(int)-sizeof(@ctype));
}}
if (!(@(if ptr? "ret_loc" (pred "val" x)))) @;
@wrong-type["val" stype];
@(if ptr? "break" "return NULL");}]
[else