Menu
▾
▴
[MLton-commit] r4688
|
From: Stephen W. <sw...@ml...> - 2006-07-17 18:33:06
|
Fixed bug on platforms that require 64-bit words to be double word
aligned (e.g. Sparc). Fixed bug on HPPA -- it needs to handle
misaligned reals and words. Both of these bugs were likely not seen
because they only show up when compiling with -align 4, and the
default on both HPPA and Sparc is -align 8.
Here's a simple program that demonstrates the bug.
val ws: Word64.word list = List.tabulate (10, Word64.fromInt)
val () = List.app (fn w => print (concat [Word64.toString w, "\n"])) ws
----------------------------------------------------------------------
U mlton/branches/on-20050822-x86_64-branch/basis-library/primitive/basis-ffi.sml
U mlton/branches/on-20050822-x86_64-branch/mlton/codegen/c-codegen/c-codegen.fun
U mlton/branches/on-20050822-x86_64-branch/runtime/basis/Word/Word-ops.h
U mlton/branches/on-20050822-x86_64-branch/runtime/gen/basis-ffi.def
----------------------------------------------------------------------
Modified: mlton/branches/on-20050822-x86_64-branch/basis-library/primitive/basis-ffi.sml
===================================================================
--- mlton/branches/on-20050822-x86_64-branch/basis-library/primitive/basis-ffi.sml 2006-07-18 01:31:18 UTC (rev 4687)
+++ mlton/branches/on-20050822-x86_64-branch/basis-library/primitive/basis-ffi.sml 2006-07-18 01:33:00 UTC (rev 4688)
@@ -1225,12 +1225,15 @@
val add = _import "Word64_add" : Word64.t * Word64.t -> Word64.t;
val andb = _import "Word64_andb" : Word64.t * Word64.t -> Word64.t;
val equal = _import "Word64_equal" : Word64.t * Word64.t -> Bool.t;
+val fetch = _import "Word64_fetch" : (Word64.t) ref -> Word64.t;
val lshift = _import "Word64_lshift" : Word64.t * Word32.t -> Word64.t;
+val move = _import "Word64_move" : (Word64.t) ref * (Word64.t) ref -> unit;
val neg = _import "Word64_neg" : Word64.t -> Word64.t;
val notb = _import "Word64_notb" : Word64.t -> Word64.t;
val orb = _import "Word64_orb" : Word64.t * Word64.t -> Word64.t;
val rol = _import "Word64_rol" : Word64.t * Word32.t -> Word64.t;
val ror = _import "Word64_ror" : Word64.t * Word32.t -> Word64.t;
+val store = _import "Word64_store" : (Word64.t) ref * Word64.t -> unit;
val sub = _import "Word64_sub" : Word64.t * Word64.t -> Word64.t;
val xorb = _import "Word64_xorb" : Word64.t * Word64.t -> Word64.t;
end
Modified: mlton/branches/on-20050822-x86_64-branch/mlton/codegen/c-codegen/c-codegen.fun
===================================================================
--- mlton/branches/on-20050822-x86_64-branch/mlton/codegen/c-codegen/c-codegen.fun 2006-07-18 01:31:18 UTC (rev 4687)
+++ mlton/branches/on-20050822-x86_64-branch/mlton/codegen/c-codegen/c-codegen.fun 2006-07-18 01:33:00 UTC (rev 4688)
@@ -579,30 +579,42 @@
then s
else concat [s, " /* ", Label.toString l, " */"]
end
- val handleMisalignedReals =
+ val handleMisaligned =
let
open Control
in
- !align = Align4 andalso !targetArch = Sparc
+ !align = Align4
+ andalso (case !targetArch of
+ HPPA => true
+ | Sparc => true
+ | _ => false)
end
+ val handleMisaligned =
+ fn ty =>
+ handleMisaligned
+ andalso (Type.equals (ty, Type.real R64)
+ orelse Type.equals (ty, Type.word (Bits.fromInt 64)))
fun addr z = concat ["&(", z, ")"]
- fun realFetch z = concat ["Real64_fetch(", addr z, ")"]
- fun realMove {dst, src} =
- concat ["Real64_move(", addr dst, ", ", addr src, ");\n"]
- fun realStore {dst, src} =
- concat ["Real64_store(", addr dst, ", ", src, ");\n"]
+ fun fetch (z, ty) =
+ concat [CType.toString (Type.toCType ty),
+ "_fetch(", addr z, ")"]
+ fun move' ({dst, src}, ty) =
+ concat [CType.toString (Type.toCType ty),
+ "_move(", addr dst, ", ", addr src, ");\n"]
+ fun store ({dst, src}, ty) =
+ concat [CType.toString (Type.toCType ty),
+ "_store(", addr dst, ", ", src, ");\n"]
fun move {dst: string, dstIsMem: bool,
src: string, srcIsMem: bool,
ty: Type.t}: string =
- if handleMisalignedReals
- andalso Type.equals (ty, Type.real R64)
- then
- case (dstIsMem, srcIsMem) of
- (false, false) => concat [dst, " = ", src, ";\n"]
- | (false, true) => concat [dst, " = ", realFetch src, ";\n"]
- | (true, false) => realStore {dst = dst, src = src}
- | (true, true) => realMove {dst = dst, src = src}
- else concat [dst, " = ", src, ";\n"]
+ if handleMisaligned ty then
+ case (dstIsMem, srcIsMem) of
+ (false, false) => concat [dst, " = ", src, ";\n"]
+ | (false, true) => concat [dst, " = ", fetch (src, ty), ";\n"]
+ | (true, false) => store ({dst = dst, src = src}, ty)
+ | (true, true) => move' ({dst = dst, src = src}, ty)
+ else
+ concat [dst, " = ", src, ";\n"]
local
datatype z = datatype Operand.t
fun toString (z: Operand.t): string =
@@ -641,11 +653,10 @@
val operandToString = toString
end
fun fetchOperand (z: Operand.t): string =
- if handleMisalignedReals
- andalso Type.equals (Operand.ty z, Type.real R64)
- andalso Operand.isMem z
- then realFetch (operandToString z)
- else operandToString z
+ if handleMisaligned (Operand.ty z) andalso Operand.isMem z then
+ fetch (operandToString z, Operand.ty z)
+ else
+ operandToString z
fun outputStatement (s, print) =
let
datatype z = datatype Statement.t
Modified: mlton/branches/on-20050822-x86_64-branch/runtime/basis/Word/Word-ops.h
===================================================================
--- mlton/branches/on-20050822-x86_64-branch/runtime/basis/Word/Word-ops.h 2006-07-18 01:31:18 UTC (rev 4687)
+++ mlton/branches/on-20050822-x86_64-branch/runtime/basis/Word/Word-ops.h 2006-07-18 01:33:00 UTC (rev 4688)
@@ -47,6 +47,40 @@
return op w; \
}
+#define misaligned(size) \
+ typedef volatile union { \
+ Word##size##_t r; \
+ Word32_t ws[sizeof(Word##size##_t) / sizeof(Word32_t)]; \
+ } Word##size##OrWord32s; \
+ MLTON_CODEGEN_STATIC_INLINE \
+ Word##size##_t Word##size##_fetch (Ref(Word##size##_t) rp) { \
+ Word##size##OrWord32s u; \
+ Word32_t *wp; \
+ wp = (Word32_t*)rp; \
+ u.ws[0] = wp[0]; \
+ if ((sizeof(Word##size##_t) / sizeof(Word32_t)) > 1) \
+ u.ws[1] = wp[1]; \
+ return u.r; \
+ } \
+ MLTON_CODEGEN_STATIC_INLINE \
+ void Word##size##_store (Ref(Word##size##_t) rp, Word##size##_t r) { \
+ Word##size##OrWord32s u; \
+ Word32_t *wp; \
+ wp = (Word32_t*)rp; \
+ u.r = r; \
+ wp[0] = u.ws[0]; \
+ if ((sizeof(Word##size##_t) / sizeof(Word32_t)) > 1) \
+ wp[1] = u.ws[1]; \
+ return; \
+ } \
+ MLTON_CODEGEN_STATIC_INLINE \
+ void Word##size##_move (Ref(Word##size##_t) dst, Ref(Word##size##_t) src) { \
+ Word##size##_t r; \
+ r = Word##size##_fetch (src); \
+ Word##size##_store (dst, r); \
+ return; \
+ }
+
#define all(size) \
binary (size, add, +) \
binary (size, andb, &) \
@@ -79,17 +113,20 @@
shift (S##size, rshift, >>) \
shift (U##size, rshift, >>) \
binary (size, sub, -) \
-binary (size, xorb, ^) \
+binary (size, xorb, ^)
all (8)
all (16)
all (32)
all (64)
+misaligned(64)
+
+#undef all
#undef binary
#undef bothBinary
+#undef bothCompare
#undef compare
-#undef bothCompare
+#undef misaligned
+#undef shift
#undef unary
-#undef shift
-#undef all
Modified: mlton/branches/on-20050822-x86_64-branch/runtime/gen/basis-ffi.def
===================================================================
--- mlton/branches/on-20050822-x86_64-branch/runtime/gen/basis-ffi.def 2006-07-18 01:31:18 UTC (rev 4687)
+++ mlton/branches/on-20050822-x86_64-branch/runtime/gen/basis-ffi.def 2006-07-18 01:33:00 UTC (rev 4688)
@@ -997,12 +997,15 @@
Word64.add = _import MLTON_CODEGEN_STATIC_INLINE : Word64.t * Word64.t -> Word64.t
Word64.andb = _import MLTON_CODEGEN_STATIC_INLINE : Word64.t * Word64.t -> Word64.t
Word64.equal = _import MLTON_CODEGEN_STATIC_INLINE : Word64.t * Word64.t -> Bool.t
+Word64.fetch = _import MLTON_CODEGEN_STATIC_INLINE : Word64.t ref -> Word64.t
Word64.lshift = _import MLTON_CODEGEN_STATIC_INLINE : Word64.t * Word32.t -> Word64.t
+Word64.move = _import MLTON_CODEGEN_STATIC_INLINE : Word64.t ref * Word64.t ref -> unit
Word64.neg = _import MLTON_CODEGEN_STATIC_INLINE : Word64.t -> Word64.t
Word64.notb = _import MLTON_CODEGEN_STATIC_INLINE : Word64.t -> Word64.t
Word64.orb = _import MLTON_CODEGEN_STATIC_INLINE : Word64.t * Word64.t -> Word64.t
Word64.rol = _import MLTON_CODEGEN_STATIC_INLINE : Word64.t * Word32.t -> Word64.t
Word64.ror = _import MLTON_CODEGEN_STATIC_INLINE : Word64.t * Word32.t -> Word64.t
+Word64.store = _import MLTON_CODEGEN_STATIC_INLINE : Word64.t ref * Word64.t -> unit
Word64.sub = _import MLTON_CODEGEN_STATIC_INLINE : Word64.t * Word64.t -> Word64.t
Word64.xorb = _import MLTON_CODEGEN_STATIC_INLINE : Word64.t * Word64.t -> Word64.t
WordS8.addCheckOverflows = _import MLTON_CODEGEN_STATIC_INLINE : Int8.t * Int8.t -> Bool.t
|
