[MLton-commit] r5435
Matthew Fluet
fluet at mlton.org
Thu Mar 15 13:59:23 PST 2007
Propagate Word<N>.word sizes through representation for proper
alignment of Word64.word array components with -align 8.
----------------------------------------------------------------------
U mlton/branches/on-20050822-x86_64-branch/mlton/ast/word-size.fun
U mlton/branches/on-20050822-x86_64-branch/mlton/ast/word-size.sig
U mlton/branches/on-20050822-x86_64-branch/mlton/backend/packed-representation.fun
U mlton/branches/on-20050822-x86_64-branch/mlton/backend/rep-type.fun
U mlton/branches/on-20050822-x86_64-branch/mlton/backend/rep-type.sig
U mlton/branches/on-20050822-x86_64-branch/mlton/backend/rssa.fun
U mlton/branches/on-20050822-x86_64-branch/mlton/backend/ssa-to-rssa.fun
U mlton/branches/on-20050822-x86_64-branch/mlton/codegen/c-codegen/c-codegen.fun
----------------------------------------------------------------------
Modified: mlton/branches/on-20050822-x86_64-branch/mlton/ast/word-size.fun
===================================================================
--- mlton/branches/on-20050822-x86_64-branch/mlton/ast/word-size.fun 2007-03-15 17:00:16 UTC (rev 5434)
+++ mlton/branches/on-20050822-x86_64-branch/mlton/ast/word-size.fun 2007-03-15 21:59:21 UTC (rev 5435)
@@ -45,6 +45,7 @@
val shiftArg = fromBits (Bits.fromInt 32)
val word8 = fromBits (Bits.fromInt 8)
val word32 = fromBits (Bits.fromInt 32)
+val word64 = fromBits (Bits.fromInt 64)
val allVector = Vector.tabulate (65, fn i =>
if isValidSize i
Modified: mlton/branches/on-20050822-x86_64-branch/mlton/ast/word-size.sig
===================================================================
--- mlton/branches/on-20050822-x86_64-branch/mlton/ast/word-size.sig 2007-03-15 17:00:16 UTC (rev 5434)
+++ mlton/branches/on-20050822-x86_64-branch/mlton/ast/word-size.sig 2007-03-15 21:59:21 UTC (rev 5435)
@@ -49,4 +49,5 @@
val toString: t -> string
val word8: t
val word32: t
+ val word64: t
end
Modified: mlton/branches/on-20050822-x86_64-branch/mlton/backend/packed-representation.fun
===================================================================
--- mlton/branches/on-20050822-x86_64-branch/mlton/backend/packed-representation.fun 2007-03-15 17:00:16 UTC (rev 5434)
+++ mlton/branches/on-20050822-x86_64-branch/mlton/backend/packed-representation.fun 2007-03-15 21:59:21 UTC (rev 5435)
@@ -493,7 +493,7 @@
let
val seqIndexSize = WordSize.seqIndex ()
val csizeSize = WordSize.csize ()
- val csizeTy = Type.word (WordSize.bits csizeSize)
+ val csizeTy = Type.word csizeSize
(* vector + (eltWidth * index) + offset *)
val ind = Var.newNoname ()
val s0 =
@@ -756,9 +756,15 @@
| Control.Align8 =>
if (Vector.exists
(components, fn {component = c, ...} =>
- case Type.deReal (Component.ty c) of
- NONE => false
- | SOME s => RealSize.equals (s, RealSize.R64)))
+ (case Type.deReal (Component.ty c) of
+ NONE => false
+ | SOME s =>
+ RealSize.equals (s, RealSize.R64))
+ orelse
+ (case Type.deWord (Component.ty c) of
+ NONE => false
+ | SOME s =>
+ WordSize.equals (s, WordSize.word64))))
then Bytes.alignWord64 width
else width
in
@@ -767,6 +773,10 @@
else let
(* An object needs space for a forwarding objptr. *)
val width' = Bytes.max (width, Runtime.objptrSize ())
+ (* Node that with Align8 and objptrSize == 64bits,
+ * the following ensures that objptrs will be
+ * mod 8 aligned.
+ *)
val width'' = Bytes.+ (width', Runtime.headerSize ())
val alignWidth'' =
case !Control.align of
@@ -1507,7 +1517,7 @@
(* CHECK: Shouldn't cast come before mask above? *)
val tagOp =
if isObjptr
- then Operand.cast (tagOp, Type.word testBits)
+ then Operand.cast (tagOp, Type.bits testBits)
else tagOp
val default =
if Vector.length variants = Vector.length cases
@@ -1520,7 +1530,7 @@
let
val (s, test) =
Statement.andb
- (Operand.cast (test, Type.word testBits),
+ (Operand.cast (test, Type.bits testBits),
Operand.word (WordX.fromIntInf (3, testSize)))
val t =
Switch
@@ -2545,7 +2555,7 @@
in
r'
end
- | Word s => nonObjptr (Type.word (WordSize.bits s))
+ | Word s => nonObjptr (Type.word s)
end))
val () = typeRepRef := typeRep
val _ = typeRep (S.Type.vector1 (S.Type.word WordSize.byte))
Modified: mlton/branches/on-20050822-x86_64-branch/mlton/backend/rep-type.fun
===================================================================
--- mlton/branches/on-20050822-x86_64-branch/mlton/backend/rep-type.fun 2007-03-15 17:00:16 UTC (rev 5434)
+++ mlton/branches/on-20050822-x86_64-branch/mlton/backend/rep-type.fun 2007-03-15 21:59:21 UTC (rev 5435)
@@ -19,14 +19,15 @@
datatype t = T of {node: node,
width: Bits.t}
and node =
- CPointer
+ Bits
+ | CPointer
| ExnStack
| GCState
| Label of Label.t
| Objptr of ObjptrTycon.t vector
| Real of RealSize.t
| Seq of t vector
- | Word
+ | Word of WordSize.t
local
fun make f (T r) = f r
@@ -42,7 +43,8 @@
open Layout
in
case node t of
- CPointer => str "CPointer"
+ Bits => str (concat ["Bits", Bits.toString (width t)])
+ | CPointer => str "CPointer"
| ExnStack => str "ExnStack"
| GCState => str "GCState"
| Label l => seq [str "Label ", Label.layout l]
@@ -51,7 +53,7 @@
tuple (Vector.toListMap (opts, ObjptrTycon.layout))]
| Real s => str (concat ["Real", RealSize.toString s])
| Seq ts => List.layout layout (Vector.toList ts)
- | Word => str (concat ["Word", Bits.toString (width t)])
+ | Word s => str (concat ["Word", WordSize.toString s])
end
val rec equals: t * t -> bool =
@@ -59,7 +61,8 @@
Bits.equals (width t, width t')
andalso
(case (node t, node t') of
- (CPointer, CPointer) => true
+ (Bits, Bits) => true
+ | (CPointer, CPointer) => true
| (ExnStack, ExnStack) => true
| (GCState, GCState) => true
| (Label l, Label l') => Label.equals (l, l')
@@ -67,13 +70,15 @@
Vector.equals (opts, opts', ObjptrTycon.equals)
| (Real s, Real s') => RealSize.equals (s, s')
| (Seq ts, Seq ts') => Vector.equals (ts, ts', equals)
- | (Word, Word) => true
+ | (Word s, Word s') => WordSize.equals (s, s')
| _ => false)
val sameWidth: t * t -> bool =
fn (t, t') => Bits.equals (width t, width t')
+ val bits: Bits.t -> t = fn width => T {node = Bits, width = width}
+
val cpointer: unit -> t = fn () =>
T {node = CPointer, width = WordSize.bits (WordSize.cpointer ())}
@@ -93,20 +98,21 @@
val real: RealSize.t -> t =
fn s => T {node = Real s, width = RealSize.bits s}
- val word: Bits.t -> t = fn width => T {node = Word, width = width}
+ val word: WordSize.t -> t =
+ fn s => T {node = Word s, width = WordSize.bits s}
- val bool: t = word (WordSize.bits WordSize.bool)
+ val bool: t = word WordSize.bool
- val csize: unit -> t = word o WordSize.bits o WordSize.csize
+ val csize: unit -> t = word o WordSize.csize
- val cint: unit -> t = word o WordSize.bits o WordSize.cint
+ val cint: unit -> t = word o WordSize.cint
- val objptrHeader: unit -> t = word o WordSize.bits o WordSize.objptrHeader
+ val objptrHeader: unit -> t = word o WordSize.objptrHeader
- val seqIndex: unit -> t = word o WordSize.bits o WordSize.seqIndex
+ val seqIndex: unit -> t = word o WordSize.seqIndex
- val shiftArg: t = word (WordSize.bits WordSize.shiftArg)
+ val shiftArg: t = word WordSize.shiftArg
val stack : unit -> t = fn () =>
objptr ObjptrTycon.stack
@@ -114,26 +120,27 @@
val thread : unit -> t = fn () =>
objptr ObjptrTycon.thread
- val word0: t = word (Bits.fromInt 0)
- val word32: t = word (WordSize.bits WordSize.word32)
+ val word0: t = bits Bits.zero
+ val word32: t = word WordSize.word32
- val wordVector: Bits.t -> t = objptr o ObjptrTycon.wordVector
+ val wordVector: WordSize.t -> t =
+ objptr o ObjptrTycon.wordVector o WordSize.bits
val word8Vector: unit -> t = fn () =>
- wordVector (WordSize.bits WordSize.word8)
+ wordVector WordSize.word8
val string: unit -> t = word8Vector
- val unit: t = word Bits.zero
+ val unit: t = bits Bits.zero
- val zero: Bits.t -> t = word
+ val zero: Bits.t -> t = bits
val ofWordX: WordX.t -> t =
- fn w => word (WordSize.bits (WordX.size w))
+ fn w => word (WordX.size w)
fun ofWordXVector (v: WordXVector.t): t =
- wordVector (WordSize.bits (WordXVector.elementSize v))
+ wordVector (WordXVector.elementSize v)
val seq: t vector -> t =
@@ -150,7 +157,7 @@
| t' :: ac' =>
(case (node t, node t') of
(Seq ts, _) => seqOnto (ts, ac)
- | (Word, Word) => word (Bits.+ (width t, width t')) :: ac'
+ | (Bits, Bits) => bits (Bits.+ (width t, width t')) :: ac'
| _ => t :: ac))
in
case seqOnto (ts, []) of
@@ -192,13 +199,13 @@
val intInf: unit -> t = fn () =>
sum (Vector.new2
- (wordVector (WordSize.bits (WordSize.bigIntInfWord ())),
+ (wordVector (WordSize.bigIntInfWord ()),
seq (Vector.new2
- (word Bits.one,
- word (Bits.- (WordSize.bits (WordSize.smallIntInfWord ()),
- Bits.one))))))
+ (bits Bits.one,
+ word (WordSize.fromBits
+ (Bits.- (WordSize.bits (WordSize.smallIntInfWord ()),
+ Bits.one)))))))
-
val deLabel: t -> Label.t option =
fn t =>
case node t of
@@ -220,6 +227,12 @@
Real s => SOME s
| _ => NONE
+ val deWord: t -> WordSize.t option =
+ fn t =>
+ case node t of
+ Word s => SOME s
+ | _ => NONE
+
val isCPointer: t -> bool =
fn t =>
case node t of
@@ -245,8 +258,16 @@
(Objptr opts, Objptr opts') =>
Vector.isSubsequence (opts, opts', ObjptrTycon.equals)
| (Real _, _) => false
- | (Word, Objptr _) => true
- | (_, Word) => true
+ | (Bits, Objptr _) => true
+ | (Word _, Objptr _) => true
+ | (Seq ts, Objptr _) =>
+ Vector.forall
+ (ts, (fn Bits => true | Word _ => true | _ => false) o node)
+ | (_, Bits) => true
+ | (_, Word _) => true
+ | (_, Seq ts) =>
+ Vector.forall
+ (ts, (fn Bits => true | Word _ => true | _ => false) o node)
| _ => false)
val isSubtype =
@@ -261,7 +282,7 @@
| _ => false)
- val resize: t * Bits.t -> t = fn (_, b) => word b
+ val resize: t * Bits.t -> t = fn (_, b) => bits b
val bogusWord: t -> WordX.t =
fn t => WordX.one (WordSize.fromBits (width t))
@@ -404,7 +425,7 @@
in
(ObjptrTycon.wordVector b,
Array {hasIdentity = false,
- elt = Type.word b})
+ elt = Type.word (WordSize.fromBits b)})
end
in
Vector.fromList
@@ -498,7 +519,7 @@
local
fun make b = fn () =>
T {args = Vector.new5 (Type.gcState (), Type.csize (), Type.bool,
- Type.cpointer (), Type.word (Bits.fromInt 32)),
+ Type.cpointer (), Type.word WordSize.word32),
bytesNeeded = NONE,
convention = Cdecl,
ensuresBytesFree = true,
Modified: mlton/branches/on-20050822-x86_64-branch/mlton/backend/rep-type.sig
===================================================================
--- mlton/branches/on-20050822-x86_64-branch/mlton/backend/rep-type.sig 2007-03-15 17:00:16 UTC (rev 5434)
+++ mlton/branches/on-20050822-x86_64-branch/mlton/backend/rep-type.sig 2007-03-15 21:59:21 UTC (rev 5435)
@@ -50,6 +50,7 @@
tyconTy: ObjptrTycon.t -> ObjectType.t,
result: t,
scale: Scale.t} -> bool
+ val bits: Bits.t -> t
val bool: t
val bytes: t -> Bytes.t
val castIsOk: {from: t,
@@ -64,6 +65,7 @@
val deLabel: t -> Label.t option
val deObjptr: t -> ObjptrTycon.t option
val deReal: t -> RealSize.t option
+ val deWord: t -> WordSize.t option
val equals: t * t -> bool
val exnStack: unit -> t
val gcState: unit -> t
@@ -96,8 +98,8 @@
val toCType: t -> CType.t
val unit: t
val width: t -> Bits.t
- val word: Bits.t -> t
- val wordVector: Bits.t -> t
+ val word: WordSize.t -> t
+ val wordVector: WordSize.t -> t
val zero: Bits.t -> t
structure BuiltInCFunction:
Modified: mlton/branches/on-20050822-x86_64-branch/mlton/backend/rssa.fun
===================================================================
--- mlton/branches/on-20050822-x86_64-branch/mlton/backend/rssa.fun 2007-03-15 17:00:16 UTC (rev 5434)
+++ mlton/branches/on-20050822-x86_64-branch/mlton/backend/rssa.fun 2007-03-15 21:59:21 UTC (rev 5435)
@@ -95,14 +95,15 @@
Bytes.layout offset]]
| Cast (z, ty) =>
seq [str "Cast ", tuple [layout z, Type.layout ty]]
- | Const c => Const.layout c
+ | Const c => seq [Const.layout c, constrain (ty z)]
| EnsuresBytesFree => str "<EnsuresBytesFree>"
| File => str "<File>"
| GCState => str "<GCState>"
| Line => str "<Line>"
| Offset {base, offset, ty} =>
seq [str (concat ["O", Type.name ty, " "]),
- tuple [layout base, Bytes.layout offset]]
+ tuple [layout base, Bytes.layout offset],
+ constrain ty]
| ObjptrTycon opt => ObjptrTycon.layout opt
| Runtime r => GCField.layout r
| Var {var, ...} => Var.layout var
Modified: mlton/branches/on-20050822-x86_64-branch/mlton/backend/ssa-to-rssa.fun
===================================================================
--- mlton/branches/on-20050822-x86_64-branch/mlton/backend/ssa-to-rssa.fun 2007-03-15 17:00:16 UTC (rev 5434)
+++ mlton/branches/on-20050822-x86_64-branch/mlton/backend/ssa-to-rssa.fun 2007-03-15 21:59:21 UTC (rev 5435)
@@ -267,7 +267,7 @@
datatype z = datatype CFunction.Target.t
val name = toString n
val real = Type.real
- val word = Type.word o WordSize.bits
+ val word = Type.word
val vanilla = CFunction.vanilla
fun coerce (t1, t2, sg) =
vanilla {args = Vector.new1 t1,
@@ -314,9 +314,9 @@
target = Direct name,
writesStackTop = false}
val intInfToString = fn () =>
- (* CHECK; cint would be better *)
+ (* CHECK; cint would be better? *)
CFunction.T {args = Vector.new3 (Type.intInf (),
- Type.word (Bits.fromInt 32),
+ Type.word WordSize.word32,
Type.csize ()),
bytesNeeded = SOME 2,
convention = Cdecl,
@@ -428,12 +428,12 @@
| IntInf_andb => intInfBinary ()
| IntInf_arshift => intInfShift ()
| IntInf_compare =>
- (* CHECK; change to cint? *)
+ (* CHECK; cint would be better? *)
vanilla {args = Vector.new2 (Type.intInf (), Type.intInf ()),
name = name,
prototype = (Vector.new2 (CType.intInf, CType.intInf),
SOME CType.Int32),
- return = Type.word (Bits.fromInt 32)}
+ return = Type.word WordSize.word32}
| IntInf_equal =>
vanilla {args = Vector.new2 (Type.intInf (), Type.intInf ()),
name = name,
@@ -508,11 +508,9 @@
| Word_sub s => wordBinary (s, {signed = false})
| Word_subCheck (s, sg) => wordBinaryOverflows (s, sg)
| Word_toReal (s1, s2, sg) =>
- coerce (Type.word (WordSize.bits s1), Type.real s2, sg)
+ coerce (Type.word s1, Type.real s2, sg)
| Word_toWord (s1, s2, sg) =>
- coerce (Type.word (WordSize.bits s1),
- Type.word (WordSize.bits s2),
- sg)
+ coerce (Type.word s1, Type.word s2, sg)
| Word_xorb s => wordBinary (s, {signed = false})
| _ => Error.bug "SsaToRssa.Name.cFunctionRaise"
end
@@ -542,9 +540,10 @@
fun updateCard (addr: Operand.t): Statement.t list =
let
val index = Var.newNoname ()
- (* CHECK *)
+ (* CHECK; WordSize.objptr or WordSize.cpointer? *)
val sz = WordSize.objptr ()
- val indexTy = Type.word (WordSize.bits sz)
+ val indexTy = Type.word sz
+ val cardElemSize = WordSize.fromBits Bits.inByte
in
[PrimApp {args = (Vector.new2
(addr,
@@ -557,8 +556,8 @@
index = Var {ty = indexTy, var = index},
offset = Bytes.zero,
scale = Scale.One,
- ty = Type.word Bits.inByte}),
- src = Operand.word (WordX.one (WordSize.fromBits Bits.inByte))}]
+ ty = Type.word cardElemSize}),
+ src = Operand.word (WordX.one cardElemSize)}]
end
fun convertConst (c: Const.t): Const.t =
@@ -1008,7 +1007,7 @@
ty = Type.seqIndex ()})
fun subWord s =
let
- val ty = Type.word (WordSize.bits s)
+ val ty = Type.word s
in
move (ArrayOffset {base = a 0,
index = a 1,
@@ -1389,7 +1388,7 @@
| Word8Array_subWord s => subWord s
| Word8Array_updateWord s =>
let
- val ty = Type.word (WordSize.bits s)
+ val ty = Type.word s
in
add (Move {dst = (ArrayOffset
{base = a 0,
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 2007-03-15 17:00:16 UTC (rev 5434)
+++ mlton/branches/on-20050822-x86_64-branch/mlton/codegen/c-codegen/c-codegen.fun 2007-03-15 21:59:21 UTC (rev 5435)
@@ -595,7 +595,7 @@
fn ty =>
handleMisaligned
andalso (Type.equals (ty, Type.real R64)
- orelse Type.equals (ty, Type.word (Bits.fromInt 64)))
+ orelse Type.equals (ty, Type.word WordSize.word64))
fun addr z = concat ["&(", z, ")"]
fun fetch (z, ty) =
concat [CType.toString (Type.toCType ty),
More information about the MLton-commit
mailing list