From a559d96009cd54ccb73a6a73701b55257e807331 Mon Sep 17 00:00:00 2001
From: Eli Barzilay <eli@racket-lang.org>
Date: Tue, 31 May 2005 21:29:34 +0000
Subject: [PATCH] Fixed a stupid alignment bug on big-endian machines.

svn: r29
---
 src/foreign/foreign.c   | 46 ++++++++++++++++++++---------------------
 src/foreign/foreign.ssc |  7 ++++++-
 2 files changed, 29 insertions(+), 24 deletions(-)

diff --git a/src/foreign/foreign.c b/src/foreign/foreign.c
index 802af2a9e4..dbd976028e 100644
--- a/src/foreign/foreign.c
+++ b/src/foreign/foreign.c
@@ -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);
diff --git a/src/foreign/foreign.ssc b/src/foreign/foreign.ssc
index 46ff2d0967..ce3b8d4028 100755
--- a/src/foreign/foreign.ssc
+++ b/src/foreign/foreign.ssc
@@ -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);