[MLton] cvs commit: extended ArrayOffset in Rssa and Machine
Stephen Weeks
sweeks@mlton.org
Sat, 24 Jul 2004 06:55:50 -0700
sweeks 04/07/24 06:55:49
Modified: include c-chunk.h
mlton/backend backend.fun machine.fun machine.sig
rep-type.sig rssa.fun rssa.sig ssa-to-rssa.fun
mlton/codegen/c-codegen c-codegen.fun
mlton/codegen/x86-codegen x86-translate.fun
Log:
MAIL extended ArrayOffset in Rssa and Machine
ArrayOffset operands now take an additional "offset" field specifying
a byte offset within the array element. For now, SsaToRssa always
inserts an offset of zero. Once we support flattened arrays in SSA,
this will change.
Matthew, I didn't make the fix to toX86Operand in x86-translate.fun to
handle offsets. Could you please do so? Thanks.
Revision Changes Path
1.29 +1 -1 mlton/include/c-chunk.h
Index: c-chunk.h
===================================================================
RCS file: /cvsroot/mlton/mlton/include/c-chunk.h,v
retrieving revision 1.28
retrieving revision 1.29
diff -u -r1.28 -r1.29
--- c-chunk.h 3 Jun 2004 03:55:24 -0000 1.28
+++ c-chunk.h 24 Jul 2004 13:55:47 -0000 1.29
@@ -32,7 +32,7 @@
#define G(ty, i) (global##ty [i])
#define GPNR(i) G(PointerNonRoot, i)
#define O(ty, b, o) (*(ty*)((b) + (o)))
-#define X(ty, b, i) (*(ty*)((b) + ((i) * sizeof(ty))))
+#define X(ty, b, i, o) (*(ty*)((b) + ((i) * sizeof(ty)) + (o)))
#define S(ty, i) *(ty*)(StackTop + (i))
/* ------------------------------------------------- */
1.77 +2 -1 mlton/mlton/backend/backend.fun
Index: backend.fun
===================================================================
RCS file: /cvsroot/mlton/mlton/mlton/backend/backend.fun,v
retrieving revision 1.76
retrieving revision 1.77
diff -u -r1.76 -r1.77
--- backend.fun 30 Jun 2004 17:46:45 -0000 1.76
+++ backend.fun 24 Jul 2004 13:55:47 -0000 1.77
@@ -429,9 +429,10 @@
datatype z = datatype R.Operand.t
in
case oper of
- ArrayOffset {base, index, ty} =>
+ ArrayOffset {base, index, offset, ty} =>
M.Operand.ArrayOffset {base = translateOperand base,
index = translateOperand index,
+ offset = offset,
ty = ty}
| Cast (z, t) => M.Operand.Cast (translateOperand z, t)
| Const c => constOperand c
1.74 +5 -3 mlton/mlton/backend/machine.fun
Index: machine.fun
===================================================================
RCS file: /cvsroot/mlton/mlton/mlton/backend/machine.fun,v
retrieving revision 1.73
retrieving revision 1.74
diff -u -r1.73 -r1.74
--- machine.fun 30 Jun 2004 17:46:46 -0000 1.73
+++ machine.fun 24 Jul 2004 13:55:47 -0000 1.74
@@ -196,6 +196,7 @@
datatype t =
ArrayOffset of {base: t,
index: t,
+ offset: Bytes.t,
ty: Type.t}
| Cast of t * Type.t
| Contents of {oper: t,
@@ -241,9 +242,9 @@
else empty
in
case z of
- ArrayOffset {base, index, ty} =>
+ ArrayOffset {base, index, offset, ty} =>
seq [str (concat ["X", Type.name ty, " "]),
- tuple [layout base, layout index],
+ tuple [layout base, layout index, Bytes.layout offset],
constrain ty]
| Cast (z, ty) =>
seq [str "Cast ", tuple [layout z, Type.layout ty]]
@@ -1014,13 +1015,14 @@
datatype z = datatype Operand.t
fun ok () =
case x of
- ArrayOffset {base, index, ty} =>
+ ArrayOffset {base, index, offset, ty} =>
(checkOperand (base, alloc)
; checkOperand (index, alloc)
; (Operand.isLocation base
andalso
(Type.arrayOffsetIsOk {base = Operand.ty base,
index = Operand.ty index,
+ offset = offset,
pointerTy = tyconTy,
result = ty})))
| Cast (z, t) =>
1.51 +1 -0 mlton/mlton/backend/machine.sig
Index: machine.sig
===================================================================
RCS file: /cvsroot/mlton/mlton/mlton/backend/machine.sig,v
retrieving revision 1.50
retrieving revision 1.51
diff -u -r1.50 -r1.51
--- machine.sig 30 Jun 2004 17:46:46 -0000 1.50
+++ machine.sig 24 Jul 2004 13:55:47 -0000 1.51
@@ -74,6 +74,7 @@
datatype t =
ArrayOffset of {base: t,
index: t,
+ offset: Bytes.t,
ty: Type.t}
| Cast of t * Type.t
| Contents of {oper: t,
1.8 +1 -0 mlton/mlton/backend/rep-type.sig
Index: rep-type.sig
===================================================================
RCS file: /cvsroot/mlton/mlton/mlton/backend/rep-type.sig,v
retrieving revision 1.7
retrieving revision 1.8
diff -u -r1.7 -r1.8
--- rep-type.sig 31 May 2004 02:12:38 -0000 1.7
+++ rep-type.sig 24 Jul 2004 13:55:47 -0000 1.8
@@ -46,6 +46,7 @@
val andb: t * t -> t option
val arrayOffsetIsOk: {base: t,
index: t,
+ offset: Bytes.t,
pointerTy: PointerTycon.t -> ObjectType.t,
result: t} -> bool
val arshift: t * t -> t
1.63 +5 -3 mlton/mlton/backend/rssa.fun
Index: rssa.fun
===================================================================
RCS file: /cvsroot/mlton/mlton/mlton/backend/rssa.fun,v
retrieving revision 1.62
retrieving revision 1.63
diff -u -r1.62 -r1.63
--- rssa.fun 3 Jun 2004 16:59:32 -0000 1.62
+++ rssa.fun 24 Jul 2004 13:55:47 -0000 1.63
@@ -51,6 +51,7 @@
datatype t =
ArrayOffset of {base: t,
index: t,
+ offset: Bytes.t,
ty: Type.t}
| Cast of t * Type.t
| Const of Const.t
@@ -100,9 +101,9 @@
open Layout
in
case z of
- ArrayOffset {base, index, ty} =>
+ ArrayOffset {base, index, offset, ty} =>
seq [str (concat ["X", Type.name ty, " "]),
- tuple [layout base, layout index],
+ tuple [layout base, layout index, Bytes.layout offset],
constrain ty]
| Cast (z, ty) =>
seq [str "Cast ", tuple [layout z, Type.layout ty]]
@@ -1114,11 +1115,12 @@
datatype z = datatype Operand.t
fun ok () =
case x of
- ArrayOffset {base, index, ty} =>
+ ArrayOffset {base, index, offset, ty} =>
(checkOperand base
; checkOperand index
; Type.arrayOffsetIsOk {base = Operand.ty base,
index = Operand.ty index,
+ offset = offset,
pointerTy = tyconTy,
result = ty})
| Cast (z, ty) =>
1.42 +1 -0 mlton/mlton/backend/rssa.sig
Index: rssa.sig
===================================================================
RCS file: /cvsroot/mlton/mlton/mlton/backend/rssa.sig,v
retrieving revision 1.41
retrieving revision 1.42
diff -u -r1.41 -r1.42
--- rssa.sig 3 Jun 2004 16:59:32 -0000 1.41
+++ rssa.sig 24 Jul 2004 13:55:47 -0000 1.42
@@ -41,6 +41,7 @@
datatype t =
ArrayOffset of {base: t,
index: t,
+ offset: Bytes.t,
ty: Type.t}
| Cast of t * Type.t
| Const of Const.t
1.86 +7 -0 mlton/mlton/backend/ssa-to-rssa.fun
Index: ssa-to-rssa.fun
===================================================================
RCS file: /cvsroot/mlton/mlton/mlton/backend/ssa-to-rssa.fun,v
retrieving revision 1.85
retrieving revision 1.86
diff -u -r1.85 -r1.86
--- ssa-to-rssa.fun 12 Jul 2004 22:53:26 -0000 1.85
+++ ssa-to-rssa.fun 24 Jul 2004 13:55:47 -0000 1.86
@@ -339,6 +339,7 @@
Move {dst = (ArrayOffset
{base = Runtime GCField.CardMap,
index = Var {ty = indexTy, var = index},
+ offset = Bytes.zero,
ty = Type.word Bits.inByte}),
src = Operand.word (WordX.one (WordSize.fromBits Bits.inByte))}]
end
@@ -352,6 +353,7 @@
then
ss @ [Move {dst = ArrayOffset {base = array,
index = index,
+ offset = Bytes.zero,
ty = arrayElementTy},
src = elt}]
else
@@ -718,6 +720,7 @@
Statement.resize
(ArrayOffset {base = base,
index = index,
+ offset = Bytes.zero,
ty = arrayElementType base},
Type.width ty)
val s = Bind {dst = (valOf var, ty),
@@ -729,6 +732,7 @@
fun subWord () =
move (ArrayOffset {base = a 0,
index = a 1,
+ offset = Bytes.zero,
ty = Type.defaultWord})
fun dst () =
case var of
@@ -800,10 +804,12 @@
fun pointerGet ty =
move (ArrayOffset {base = a 0,
index = a 1,
+ offset = Bytes.zero,
ty = ty})
fun pointerSet ty =
add (Move {dst = ArrayOffset {base = a 0,
index = a 1,
+ offset = Bytes.zero,
ty = ty},
src = a 2})
fun codegenOrC (p: Prim.t) =
@@ -1098,6 +1104,7 @@
add (Move {dst = (ArrayOffset
{base = a 0,
index = a 1,
+ offset = Bytes.zero,
ty = Type.defaultWord}),
src = a 2})
| Word8Vector_subWord => subWord ()
1.85 +3 -2 mlton/mlton/codegen/c-codegen/c-codegen.fun
Index: c-codegen.fun
===================================================================
RCS file: /cvsroot/mlton/mlton/mlton/codegen/c-codegen/c-codegen.fun,v
retrieving revision 1.84
retrieving revision 1.85
diff -u -r1.84 -r1.85
--- c-codegen.fun 3 Jun 2004 03:55:26 -0000 1.84
+++ c-codegen.fun 24 Jul 2004 13:55:48 -0000 1.85
@@ -583,10 +583,11 @@
datatype z = datatype Operand.t
fun toString (z: Operand.t): string =
case z of
- ArrayOffset {base, index, ty} =>
+ ArrayOffset {base, index, offset, ty} =>
concat ["X", C.args [Type.toC ty,
toString base,
- toString index]]
+ toString index,
+ C.bytes offset]]
| Cast (z, ty) => concat ["(", Type.toC ty, ")", toString z]
| Contents {oper, ty} => contents (ty, toString oper)
| File => "__FILE__"
1.62 +5 -2 mlton/mlton/codegen/x86-codegen/x86-translate.fun
Index: x86-translate.fun
===================================================================
RCS file: /cvsroot/mlton/mlton/mlton/codegen/x86-codegen/x86-translate.fun,v
retrieving revision 1.61
retrieving revision 1.62
diff -u -r1.61 -r1.62
--- x86-translate.fun 3 Jun 2004 03:55:26 -0000 1.61
+++ x86-translate.fun 24 Jul 2004 13:55:48 -0000 1.62
@@ -76,8 +76,12 @@
get #1 0 v
val rec toX86Operand : t -> (x86.Operand.t * x86.Size.t) vector =
- fn ArrayOffset {base, index, ty}
+ fn ArrayOffset {base, index, offset, ty}
=> let
+ val _ =
+ if Bytes.isZero offset
+ then ()
+ else Error.bug "toX86Operand can't handle nonzero offset"
val base = toX86Operand base
val _ = Assert.assert("x86Translate.Operand.toX86Operand: Array/base",
fn () => Vector.length base = 1)
@@ -86,7 +90,6 @@
val _ = Assert.assert("x86Translate.Operand.toX86Operand: Array/index",
fn () => Vector.length index = 1)
val index = getOp0 index
-
val ty = Type.toCType ty
val origin =
case (x86.Operand.deMemloc base,