[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