From b374d0d015beee5b4dc8635031d4a2a8b4a0714e Mon Sep 17 00:00:00 2001 From: Matthew Flatt Date: Mon, 14 May 2012 15:39:30 -0600 Subject: [PATCH] ffi: fix big-endian s->c conversion of bytes and shorts --- collects/tests/racket/foreign-test.c | 23 +++++++---- collects/tests/racket/foreign-test.rktl | 27 ++++++++----- src/foreign/foreign.c | 54 +++++++++++++++++++++++++ src/foreign/foreign.rktc | 8 +++- 4 files changed, 93 insertions(+), 19 deletions(-) diff --git a/collects/tests/racket/foreign-test.c b/collects/tests/racket/foreign-test.c index c5249d2521..9a95e173d8 100644 --- a/collects/tests/racket/foreign-test.c +++ b/collects/tests/racket/foreign-test.c @@ -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; } diff --git a/collects/tests/racket/foreign-test.rktl b/collects/tests/racket/foreign-test.rktl index e29ebf3806..b9a670fee6 100644 --- a/collects/tests/racket/foreign-test.rktl +++ b/collects/tests/racket/foreign-test.rktl @@ -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) diff --git a/src/foreign/foreign.c b/src/foreign/foreign.c index 2330ec23d9..0cc4a55975 100644 --- a/src/foreign/foreign.c +++ b/src/foreign/foreign.c @@ -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)C","int8",0,1,&(val)); return NULL; case FOREIGN_uint8: +# ifdef SCHEME_BIG_ENDIAN + if (sizeof(Tuint8)C","uint8",0,1,&(val)); return NULL; case FOREIGN_int16: +# ifdef SCHEME_BIG_ENDIAN + if (sizeof(Tsint16)C","int16",0,1,&(val)); return NULL; case FOREIGN_uint16: +# ifdef SCHEME_BIG_ENDIAN + if (sizeof(Tuint16)C","uint16",0,1,&(val)); return NULL; case FOREIGN_int32: +# ifdef SCHEME_BIG_ENDIAN + if (sizeof(Tsint32)C","int32",0,1,&(val)); return NULL; case FOREIGN_uint32: +# ifdef SCHEME_BIG_ENDIAN + if (sizeof(Tuint32)C","uint32",0,1,&(val)); return NULL; case FOREIGN_int64: +# ifdef SCHEME_BIG_ENDIAN + if (sizeof(Tsint64)C","int64",0,1,&(val)); return NULL; case FOREIGN_uint64: +# ifdef SCHEME_BIG_ENDIAN + if (sizeof(Tuint64)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*)C","fpointer",0,1,&(val)); break; case FOREIGN_struct: diff --git a/src/foreign/foreign.rktc b/src/foreign/foreign.rktc index 0722199d6f..1764d9b12a 100755 --- a/src/foreign/foreign.rktc +++ b/src/foreign/foreign.rktc @@ -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)