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

Fixed a stupid alignment bug on big-endian machines.

Browse Source 
svn: r29
This commit is contained in:
Eli Barzilay 2005-05-31 21:29:34 +00:00
parent 11046b5b14
commit a559d96009
2 changed files with 29 additions and 24 deletions
Show Stats Download Patch File Download Diff File Expand all files Collapse all files

46
src/foreign/foreign.c
View File

@ -979,29 +979,29 @@ static Scheme_Object *c_to_scheme(Scheme_Object *type, void *src)
return (Scheme_Object*)src;
} else switch (CTYPE_PRIMLABEL(type)) {
case FOREIGN_void: return scheme_void;
case FOREIGN_int8: return scheme_make_integer(((Tsint8*)src)[0]);
case FOREIGN_uint8: return scheme_make_integer_from_unsigned(((Tuint8*)src)[0]);
case FOREIGN_int16: return scheme_make_integer(((Tsint16*)src)[0]);
case FOREIGN_uint16: return scheme_make_integer_from_unsigned(((Tuint16*)src)[0]);
case FOREIGN_int32: return scheme_make_realinteger_value(((Tsint32*)src)[0]);
case FOREIGN_uint32: return scheme_make_realinteger_value_from_unsigned(((Tuint32*)src)[0]);
case FOREIGN_int64: return scheme_make_integer_value_from_long_long(((Tsint64*)src)[0]);
case FOREIGN_uint64: return scheme_make_integer_value_from_unsigned_long_long(((Tuint64*)src)[0]);
case FOREIGN_fixint: return scheme_make_integer(((Tsint32*)src)[0]);
case FOREIGN_ufixint: return scheme_make_integer_from_unsigned(((Tuint32*)src)[0]);
case FOREIGN_fixnum: return scheme_make_integer(((long*)src)[0]);
case FOREIGN_ufixnum: return scheme_make_integer_from_unsigned(((unsigned long*)src)[0]);
case FOREIGN_float: return scheme_make_float(((float*)src)[0]);
case FOREIGN_double: return scheme_make_double(((double*)src)[0]);
case FOREIGN_doubleS: return scheme_make_double(((double*)src)[0]);
case FOREIGN_bool: return (((int*)src)[0]?scheme_true:scheme_false);
case FOREIGN_string_ucs_4: return scheme_make_char_string_without_copying(((mzchar**)src)[0]);
case FOREIGN_string_utf_16: return utf16_pointer_to_ucs4_string(((unsigned short**)src)[0]);
case FOREIGN_bytes: return (((char**)src)[0]==NULL)?scheme_false:scheme_make_byte_string_without_copying(((char**)src)[0]);
case FOREIGN_path: return (((char**)src)[0]==NULL)?scheme_false:scheme_make_path_without_copying(((char**)src)[0]);
case FOREIGN_symbol: return scheme_intern_symbol(((char**)src)[0]);
case FOREIGN_pointer: return scheme_make_foreign_cpointer(((void**)src)[0]);
case FOREIGN_scheme: return ((Scheme_Object**)src)[0];
case FOREIGN_int8: return scheme_make_integer(((sizeof(Tsint8)<sizeof(int)) ? ((Tsint8)(((int*)src)[0])) : (((Tsint8*)src)[0])));
case FOREIGN_uint8: return scheme_make_integer_from_unsigned(((sizeof(Tuint8)<sizeof(int)) ? ((Tuint8)(((int*)src)[0])) : (((Tuint8*)src)[0])));
case FOREIGN_int16: return scheme_make_integer(((sizeof(Tsint16)<sizeof(int)) ? ((Tsint16)(((int*)src)[0])) : (((Tsint16*)src)[0])));
case FOREIGN_uint16: return scheme_make_integer_from_unsigned(((sizeof(Tuint16)<sizeof(int)) ? ((Tuint16)(((int*)src)[0])) : (((Tuint16*)src)[0])));
case FOREIGN_int32: return scheme_make_realinteger_value(((sizeof(Tsint32)<sizeof(int)) ? ((Tsint32)(((int*)src)[0])) : (((Tsint32*)src)[0])));
case FOREIGN_uint32: return scheme_make_realinteger_value_from_unsigned(((sizeof(Tuint32)<sizeof(int)) ? ((Tuint32)(((int*)src)[0])) : (((Tuint32*)src)[0])));
case FOREIGN_int64: return scheme_make_integer_value_from_long_long(((sizeof(Tsint64)<sizeof(int)) ? ((Tsint64)(((int*)src)[0])) : (((Tsint64*)src)[0])));
case FOREIGN_uint64: return scheme_make_integer_value_from_unsigned_long_long(((sizeof(Tuint64)<sizeof(int)) ? ((Tuint64)(((int*)src)[0])) : (((Tuint64*)src)[0])));
case FOREIGN_fixint: return scheme_make_integer(((sizeof(Tsint32)<sizeof(int)) ? ((Tsint32)(((int*)src)[0])) : (((Tsint32*)src)[0])));
case FOREIGN_ufixint: return scheme_make_integer_from_unsigned(((sizeof(Tuint32)<sizeof(int)) ? ((Tuint32)(((int*)src)[0])) : (((Tuint32*)src)[0])));
case FOREIGN_fixnum: return scheme_make_integer(((sizeof(long)<sizeof(int)) ? ((long)(((int*)src)[0])) : (((long*)src)[0])));
case FOREIGN_ufixnum: return scheme_make_integer_from_unsigned(((sizeof(unsigned long)<sizeof(int)) ? ((unsigned long)(((int*)src)[0])) : (((unsigned long*)src)[0])));
case FOREIGN_float: return scheme_make_float(((sizeof(float)<sizeof(int)) ? ((float)(((int*)src)[0])) : (((float*)src)[0])));
case FOREIGN_double: return scheme_make_double(((sizeof(double)<sizeof(int)) ? ((double)(((int*)src)[0])) : (((double*)src)[0])));
case FOREIGN_doubleS: return scheme_make_double(((sizeof(double)<sizeof(int)) ? ((double)(((int*)src)[0])) : (((double*)src)[0])));
case FOREIGN_bool: return (((sizeof(int)<sizeof(int)) ? ((int)(((int*)src)[0])) : (((int*)src)[0]))?scheme_true:scheme_false);
case FOREIGN_string_ucs_4: return scheme_make_char_string_without_copying(((sizeof(mzchar*)<sizeof(int)) ? ((mzchar*)(((int*)src)[0])) : (((mzchar**)src)[0])));
case FOREIGN_string_utf_16: return utf16_pointer_to_ucs4_string(((sizeof(unsigned short*)<sizeof(int)) ? ((unsigned short*)(((int*)src)[0])) : (((unsigned short**)src)[0])));
case FOREIGN_bytes: return (((sizeof(char*)<sizeof(int)) ? ((char*)(((int*)src)[0])) : (((char**)src)[0]))==NULL)?scheme_false:scheme_make_byte_string_without_copying(((sizeof(char*)<sizeof(int)) ? ((char*)(((int*)src)[0])) : (((char**)src)[0])));
case FOREIGN_path: return (((sizeof(char*)<sizeof(int)) ? ((char*)(((int*)src)[0])) : (((char**)src)[0]))==NULL)?scheme_false:scheme_make_path_without_copying(((sizeof(char*)<sizeof(int)) ? ((char*)(((int*)src)[0])) : (((char**)src)[0])));
case FOREIGN_symbol: return scheme_intern_symbol(((sizeof(char*)<sizeof(int)) ? ((char*)(((int*)src)[0])) : (((char**)src)[0])));
case FOREIGN_pointer: return scheme_make_foreign_cpointer(((sizeof(void*)<sizeof(int)) ? ((void*)(((int*)src)[0])) : (((void**)src)[0])));
case FOREIGN_scheme: return ((sizeof(Scheme_Object*)<sizeof(int)) ? ((Scheme_Object*)(((int*)src)[0])) : (((Scheme_Object**)src)[0]));
case FOREIGN_fpointer: return scheme_void;
case FOREIGN_struct: return scheme_make_foreign_cpointer(src);
default: scheme_signal_error("corrupt foreign type: %V", type);

7
src/foreign/foreign.ssc
View File

@ -809,7 +809,12 @@ static Scheme_Object *c_to_scheme(Scheme_Object *type, void *src)
{:(for-each-type
(~ "case FOREIGN_"cname": return "
(if ctype
(let ([x (list "(("ctype"*)src)[0]")])
(let ([x (list
;; will cause a bug in big-endians with int8 & int16
;; "(("ctype"*)src)[0]"
"((sizeof("ctype")<sizeof(int))"
" ? (("ctype")(((int*)src)[0]))"
" : ((("ctype"*)src)[0]))")])
(if (procedure? c->s) (c->s x) (list c->s"("x")")))
"scheme_void")";")):}
case FOREIGN_struct: return scheme_make_foreign_cpointer(src);