[MLton-commit] r5268
Matthew Fluet
fluet at mlton.org
Mon Feb 19 14:50:53 PST 2007
First pass over compiler proper for x86_64 port.
This commit serves two major purposes:
1. Remove Words structure from /mlton/control/bits.sml.
2. Use Control.Target.Size.* functions for target dependent sizes.
These changes have been pushed through the entire compiler, and
self-comple and regressions pass (for all codegens (on x86-linux,
x86-darwin)).
Removing the Words structure means that all size related information
is in bytes (or bits). The notion of word size is hard enough to keep
straight, and a structure whose meaning is target dependent is even
harder. It seemed simplest to remove the structure entirely; indeed,
most uses of Words.t could easily be converted to being in terms of
Bytes.t.
Along with removing the Words structure, any 'defaultWord' related
notion has been removed. In some situations, this meant using the
Control.Target.Size.* functions (which in turn meant that many values
needed to be thunked, in order to delay querying the sizes until they
are set at the end of command line processing). In other situations,
this meant fixing a particular size (e.g., booleans across the FFI are
32bits, the shift argument to a word shift primitive is 32bits).
----------------------------------------------------------------------
U mlton/branches/on-20050822-x86_64-branch/include/bytecode.h
U mlton/branches/on-20050822-x86_64-branch/include/c-chunk.h
U mlton/branches/on-20050822-x86_64-branch/include/main.h
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/atoms/c-type.fun
U mlton/branches/on-20050822-x86_64-branch/mlton/atoms/c-type.sig
U mlton/branches/on-20050822-x86_64-branch/mlton/atoms/const.fun
U mlton/branches/on-20050822-x86_64-branch/mlton/atoms/const.sig
U mlton/branches/on-20050822-x86_64-branch/mlton/atoms/hash-type.fun
U mlton/branches/on-20050822-x86_64-branch/mlton/atoms/prim.fun
U mlton/branches/on-20050822-x86_64-branch/mlton/atoms/prim.sig
U mlton/branches/on-20050822-x86_64-branch/mlton/atoms/type-ops.fun
U mlton/branches/on-20050822-x86_64-branch/mlton/atoms/type-ops.sig
U mlton/branches/on-20050822-x86_64-branch/mlton/backend/allocate-registers.fun
U mlton/branches/on-20050822-x86_64-branch/mlton/backend/backend.fun
U mlton/branches/on-20050822-x86_64-branch/mlton/backend/limit-check.fun
U mlton/branches/on-20050822-x86_64-branch/mlton/backend/machine.fun
U mlton/branches/on-20050822-x86_64-branch/mlton/backend/machine.sig
U mlton/branches/on-20050822-x86_64-branch/mlton/backend/object-type.sig
A mlton/branches/on-20050822-x86_64-branch/mlton/backend/objptr-tycon.fun
A mlton/branches/on-20050822-x86_64-branch/mlton/backend/objptr-tycon.sig
U mlton/branches/on-20050822-x86_64-branch/mlton/backend/packed-representation.fun
D mlton/branches/on-20050822-x86_64-branch/mlton/backend/pointer-tycon.fun
D mlton/branches/on-20050822-x86_64-branch/mlton/backend/pointer-tycon.sig
U mlton/branches/on-20050822-x86_64-branch/mlton/backend/profile.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/representation.sig
U mlton/branches/on-20050822-x86_64-branch/mlton/backend/rssa.fun
U mlton/branches/on-20050822-x86_64-branch/mlton/backend/rssa.sig
U mlton/branches/on-20050822-x86_64-branch/mlton/backend/runtime.fun
U mlton/branches/on-20050822-x86_64-branch/mlton/backend/runtime.sig
U mlton/branches/on-20050822-x86_64-branch/mlton/backend/signal-check.fun
U mlton/branches/on-20050822-x86_64-branch/mlton/backend/sources.cm
U mlton/branches/on-20050822-x86_64-branch/mlton/backend/sources.mlb
U mlton/branches/on-20050822-x86_64-branch/mlton/backend/ssa-to-rssa.fun
U mlton/branches/on-20050822-x86_64-branch/mlton/backend/switch.fun
U mlton/branches/on-20050822-x86_64-branch/mlton/codegen/bytecode/bytecode.fun
U mlton/branches/on-20050822-x86_64-branch/mlton/codegen/c-codegen/c-codegen.fun
U mlton/branches/on-20050822-x86_64-branch/mlton/codegen/x86-codegen/x86-codegen.fun
U mlton/branches/on-20050822-x86_64-branch/mlton/codegen/x86-codegen/x86-generate-transfers.fun
U mlton/branches/on-20050822-x86_64-branch/mlton/codegen/x86-codegen/x86-mlton-basic.fun
U mlton/branches/on-20050822-x86_64-branch/mlton/codegen/x86-codegen/x86-mlton-basic.sig
U mlton/branches/on-20050822-x86_64-branch/mlton/codegen/x86-codegen/x86-translate.fun
U mlton/branches/on-20050822-x86_64-branch/mlton/codegen/x86-codegen/x86.fun
U mlton/branches/on-20050822-x86_64-branch/mlton/control/bits.sml
U mlton/branches/on-20050822-x86_64-branch/mlton/control/control-flags.sig
U mlton/branches/on-20050822-x86_64-branch/mlton/control/control-flags.sml
U mlton/branches/on-20050822-x86_64-branch/mlton/control/sources.cm
U mlton/branches/on-20050822-x86_64-branch/mlton/control/sources.mlb
U mlton/branches/on-20050822-x86_64-branch/mlton/elaborate/elaborate-core.fun
U mlton/branches/on-20050822-x86_64-branch/mlton/elaborate/elaborate-env.fun
U mlton/branches/on-20050822-x86_64-branch/mlton/elaborate/type-env.fun
U mlton/branches/on-20050822-x86_64-branch/mlton/elaborate/type-env.sig
U mlton/branches/on-20050822-x86_64-branch/mlton/main/compile.fun
U mlton/branches/on-20050822-x86_64-branch/mlton/main/lookup-constant.fun
U mlton/branches/on-20050822-x86_64-branch/mlton/main/main.fun
U mlton/branches/on-20050822-x86_64-branch/mlton/ssa/analyze2.fun
U mlton/branches/on-20050822-x86_64-branch/mlton/ssa/analyze2.sig
U mlton/branches/on-20050822-x86_64-branch/mlton/ssa/constant-propagation.fun
U mlton/branches/on-20050822-x86_64-branch/mlton/ssa/deep-flatten.fun
U mlton/branches/on-20050822-x86_64-branch/mlton/ssa/poly-equal.fun
U mlton/branches/on-20050822-x86_64-branch/mlton/ssa/ref-flatten.fun
U mlton/branches/on-20050822-x86_64-branch/mlton/ssa/ssa-tree2.fun
U mlton/branches/on-20050822-x86_64-branch/mlton/ssa/ssa-tree2.sig
U mlton/branches/on-20050822-x86_64-branch/mlton/ssa/type-check2.fun
U mlton/branches/on-20050822-x86_64-branch/mlton/ssa/useless.fun
U mlton/branches/on-20050822-x86_64-branch/runtime/bytecode/interpret.c
U mlton/branches/on-20050822-x86_64-branch/runtime/bytecode/interpret.h
U mlton/branches/on-20050822-x86_64-branch/runtime/bytecode/opcode.h
----------------------------------------------------------------------
Modified: mlton/branches/on-20050822-x86_64-branch/include/bytecode.h
===================================================================
--- mlton/branches/on-20050822-x86_64-branch/include/bytecode.h 2007-02-19 22:35:19 UTC (rev 5267)
+++ mlton/branches/on-20050822-x86_64-branch/include/bytecode.h 2007-02-19 22:50:42 UTC (rev 5268)
@@ -6,4 +6,10 @@
*/
#include <stdint.h>
+#include "ml-types.h"
+#include "c-types.h"
+
+typedef Pointer CPointer;
+typedef Pointer Objptr;
+
#include "interpret.h"
Modified: mlton/branches/on-20050822-x86_64-branch/include/c-chunk.h
===================================================================
--- mlton/branches/on-20050822-x86_64-branch/include/c-chunk.h 2007-02-19 22:35:19 UTC (rev 5267)
+++ mlton/branches/on-20050822-x86_64-branch/include/c-chunk.h 2007-02-19 22:50:42 UTC (rev 5268)
@@ -15,6 +15,9 @@
#include "c-types.h"
#include "c-common.h"
+typedef Pointer CPointer;
+typedef Pointer Objptr;
+
#ifndef TRUE
#define TRUE 1
#endif
@@ -41,7 +44,7 @@
#define C(ty, x) (*(ty*)(x))
#define G(ty, i) (global##ty [i])
-#define GPNR(i) G(PointerNonRoot, i)
+#define GPNR(i) G(ObjptrNonRoot, i)
#define O(ty, b, o) (*(ty*)((b) + (o)))
#define X(ty, b, i, s, o) (*(ty*)((b) + ((i) * (s)) + (o)))
#define S(ty, i) *(ty*)(StackTop + (i))
Modified: mlton/branches/on-20050822-x86_64-branch/include/main.h
===================================================================
--- mlton/branches/on-20050822-x86_64-branch/include/main.h 2007-02-19 22:35:19 UTC (rev 5267)
+++ mlton/branches/on-20050822-x86_64-branch/include/main.h 2007-02-19 22:50:42 UTC (rev 5268)
@@ -13,6 +13,9 @@
#define MLTON_GC_INTERNAL_BASIS
#include "platform.h"
+typedef Pointer CPointer;
+typedef Pointer Objptr;
+
/* The label must be declared as weak because gcc's optimizer may prove that
* the code that declares the label is dead and hence eliminate the declaration.
*/
@@ -39,8 +42,8 @@
gcState.atMLtonsLength = cardof(atMLtons); \
gcState.frameLayouts = frameLayouts; \
gcState.frameLayoutsLength = cardof(frameLayouts); \
- gcState.globals = globalPointer; \
- gcState.globalsLength = cardof(globalPointer); \
+ gcState.globals = globalObjptr; \
+ gcState.globalsLength = cardof(globalObjptr); \
gcState.intInfInits = intInfInits; \
gcState.intInfInitsLength = cardof(intInfInits); \
gcState.loadGlobals = loadGlobals; \
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-02-19 22:35:19 UTC (rev 5267)
+++ mlton/branches/on-20050822-x86_64-branch/mlton/ast/word-size.fun 2007-02-19 22:50:42 UTC (rev 5268)
@@ -28,9 +28,23 @@
fun isValidSize (i: int) =
(1 <= i andalso i <= 32) orelse i = 64
-val byte = fromBits (Bits.fromInt 8)
+val byte = fromBits (Bits.inByte)
+fun bigIntInfWord () = fromBits (Control.Target.Size.mplimb ())
+fun cint () = fromBits (Control.Target.Size.cint ())
+fun cpointer () = fromBits (Control.Target.Size.cpointer ())
+fun cptrdiff () = fromBits (Control.Target.Size.cptrdiff ())
+fun csize () = fromBits (Control.Target.Size.csize ())
+val exnStack = fromBits (Bits.fromInt 32)
+fun objptr () = fromBits (Control.Target.Size.objptr ())
+fun objptrHeader () = fromBits (Control.Target.Size.header ())
+fun seqIndex () = fromBits (Control.Target.Size.seqIndex ())
+fun smallIntInfWord () = objptr ()
val bool = fromBits (Bits.fromInt 32)
+val compareRes = fromBits (Bits.fromInt 32)
+val shiftArg = fromBits (Bits.fromInt 32)
+val word8 = fromBits (Bits.fromInt 8)
+val word32 = fromBits (Bits.fromInt 32)
val allVector = Vector.tabulate (65, fn i =>
if isValidSize i
@@ -41,10 +55,6 @@
val prims = List.map ([8, 16, 32, 64], fromBits o Bits.fromInt)
-val default = fromBits Bits.inWord
-
-fun pointer () = fromBits Bits.inWord
-
val memoize: (t -> 'a) -> t -> 'a =
fn f =>
let
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-02-19 22:35:19 UTC (rev 5267)
+++ mlton/branches/on-20050822-x86_64-branch/mlton/ast/word-size.sig 2007-02-19 22:50:42 UTC (rev 5268)
@@ -19,22 +19,34 @@
val all: t list
val bits: t -> Bits.t
+ val bigIntInfWord: unit -> t
val bool: t
val bytes: t -> Bytes.t
val byte: t
val cardinality: t -> IntInf.t
+ val cint: unit -> t
val compare: t * t -> Relation.t
- val default: t
+ val compareRes: t
+ val cpointer: unit -> t
+ val cptrdiff: unit -> t
+ val csize: unit -> t
val equals: t * t -> bool
+ val exnStack: t
val fromBits: Bits.t -> t
val isInRange: t * IntInf.t * {signed: bool} -> bool
val max: t * {signed: bool} -> IntInf.t
val min: t * {signed: bool} -> IntInf.t
val memoize: (t -> 'a) -> t -> 'a
- val pointer: unit -> t
+ val objptr: unit -> t
+ val objptrHeader: unit -> t
datatype prim = W8 | W16 | W32 | W64
val prim: t -> prim
val prims: t list
val roundUpToPrim: t -> t
+ val seqIndex: unit -> t
+ val shiftArg: t
+ val smallIntInfWord: unit -> t
val toString: t -> string
+ val word8: t
+ val word32: t
end
Modified: mlton/branches/on-20050822-x86_64-branch/mlton/atoms/c-type.fun
===================================================================
--- mlton/branches/on-20050822-x86_64-branch/mlton/atoms/c-type.fun 2007-02-19 22:35:19 UTC (rev 5267)
+++ mlton/branches/on-20050822-x86_64-branch/mlton/atoms/c-type.fun 2007-02-19 22:50:42 UTC (rev 5268)
@@ -11,11 +11,12 @@
open S
datatype t =
- Int8
+ CPointer
+ | Int8
| Int16
| Int32
| Int64
- | Pointer
+ | Objptr
| Real32
| Real64
| Word8
@@ -23,38 +24,39 @@
| Word32
| Word64
-val all = [Int8, Int16, Int32, Int64,
- Pointer,
+val all = [CPointer,
+ Int8, Int16, Int32, Int64,
+ Objptr,
Real32, Real64,
Word8, Word16, Word32, Word64]
-val bool = Int32
+val cpointer = CPointer
+val objptr = Objptr
+val thread = objptr
-val pointer = Pointer
-
-val thread = Pointer
-
val equals: t * t -> bool = op =
fun memo (f: t -> 'a): t -> 'a =
let
- val pointer = f Pointer
- val real32 = f Real32
- val real64 = f Real64
+ val cpointer = f CPointer
val int8 = f Int8
val int16 = f Int16
val int32 = f Int32
val int64 = f Int64
+ val objptr = f Objptr
+ val real32 = f Real32
+ val real64 = f Real64
val word8 = f Word8
val word16 = f Word16
val word32 = f Word32
val word64 = f Word64
in
- fn Int8 => int8
+ fn CPointer => cpointer
+ | Int8 => int8
| Int16 => int16
| Int32 => int32
| Int64 => int64
- | Pointer => pointer
+ | Objptr => objptr
| Real32 => real32
| Real64 => real64
| Word8 => word8
@@ -64,11 +66,12 @@
end
val toString =
- fn Int8 => "Int8"
+ fn CPointer => "CPointer"
+ | Int8 => "Int8"
| Int16 => "Int16"
| Int32 => "Int32"
| Int64 => "Int64"
- | Pointer => "Pointer"
+ | Objptr => "Objptr" (* CHECK *)
| Real32 => "Real32"
| Real64 => "Real64"
| Word8 => "Word8"
@@ -80,11 +83,12 @@
fun size (t: t): Bytes.t =
case t of
- Int8 => Bytes.fromInt 1
+ CPointer => Bits.toBytes (Control.Target.Size.cpointer ())
+ | Int8 => Bytes.fromInt 1
| Int16 => Bytes.fromInt 2
| Int32 => Bytes.fromInt 4
| Int64 => Bytes.fromInt 8
- | Pointer => Bytes.inPointer
+ | Objptr => Bits.toBytes (Control.Target.Size.objptr ())
| Real32 => Bytes.fromInt 4
| Real64 => Bytes.fromInt 8
| Word8 => Bytes.fromInt 1
@@ -94,11 +98,12 @@
fun name t =
case t of
- Int8 => "I8"
+ CPointer => "Q" (* CHECK *)
+ | Int8 => "I8"
| Int16 => "I16"
| Int32 => "I32"
| Int64 => "I64"
- | Pointer => "P"
+ | Objptr => "P" (* CHECK *)
| Real32 => "R32"
| Real64 => "R64"
| Word8 => "W8"
@@ -115,8 +120,8 @@
| 64 => Real64
| _ => Error.bug "CType.real"
-fun word (s: WordSize.t, {signed: bool}): t =
- case (signed, Bits.toInt (WordSize.bits s)) of
+fun word' (b: Bits.t, {signed: bool}): t =
+ case (signed, Bits.toInt b) of
(false, 8) => Word8
| (true, 8) => Int8
| (false, 16) => Word16
@@ -125,6 +130,31 @@
| (true, 32) => Int32
| (false, 64) => Word64
| (true, 64) => Int64
- | _ => Error.bug "CType.word"
+ | _ => Error.bug "CType.word'"
+fun word (s: WordSize.t, {signed: bool}): t =
+ word' (WordSize.bits s, {signed = signed})
+
+val cint =
+ Promise.lazy
+ (fn () => word' (Control.Target.Size.cint (),
+ {signed = true}))
+val csize =
+ Promise.lazy
+ (fn () => word' (Control.Target.Size.cint (),
+ {signed = true}))
+
+val seqIndex =
+ Promise.lazy
+ (fn () => word' (Control.Target.Size.seqIndex (),
+ {signed = true}))
+
+val objptrHeader =
+ Promise.lazy
+ (fn () => word' (Control.Target.Size.header (),
+ {signed = true}))
+
+val bool = word (WordSize.bool, {signed = true})
+val shiftArg = word (WordSize.shiftArg, {signed = false})
+
end
Modified: mlton/branches/on-20050822-x86_64-branch/mlton/atoms/c-type.sig
===================================================================
--- mlton/branches/on-20050822-x86_64-branch/mlton/atoms/c-type.sig 2007-02-19 22:35:19 UTC (rev 5267)
+++ mlton/branches/on-20050822-x86_64-branch/mlton/atoms/c-type.sig 2007-02-19 22:50:42 UTC (rev 5268)
@@ -16,11 +16,12 @@
include C_TYPE_STRUCTS
datatype t =
- Int8
+ CPointer
+ | Int8
| Int16
| Int32
| Int64
- | Pointer
+ | Objptr
| Real32
| Real64
| Word8
@@ -31,13 +32,19 @@
val align: t * Bytes.t -> Bytes.t
val all: t list
val bool: t
+ val cpointer: t
+ val cint: unit -> t
+ val csize: unit -> t
val equals: t * t -> bool
+ val objptrHeader: unit -> t
val memo: (t -> 'a) -> t -> 'a
(* name: I{8,16,32,64} R{32,64} W{8,16,32,64} *)
val name: t -> string
val layout: t -> Layout.t
- val pointer: t
+ val objptr: t
val real: RealSize.t -> t
+ val seqIndex: unit -> t
+ val shiftArg: t
val size: t -> Bytes.t
val thread: t
val toString: t -> string
Modified: mlton/branches/on-20050822-x86_64-branch/mlton/atoms/const.fun
===================================================================
--- mlton/branches/on-20050822-x86_64-branch/mlton/atoms/const.fun 2007-02-19 22:35:19 UTC (rev 5267)
+++ mlton/branches/on-20050822-x86_64-branch/mlton/atoms/const.fun 2007-02-19 22:50:42 UTC (rev 5268)
@@ -18,23 +18,25 @@
structure SmallIntInf =
struct
- structure Word = Pervasive.Word
+ structure WordSize = WordX.WordSize
- val minSmall: IntInf.t = ~0x40000000
- val maxSmall: IntInf.t = 0x3FFFFFFF
+ fun toWord (i: IntInf.t): WordX.t option =
+ let
+ val ws = WordSize.smallIntInfWord ()
+ val ws' = WordSize.fromBits (Bits.- (WordSize.bits ws, Bits.one))
+ in
+ if WordSize.isInRange (ws', i, {signed = true})
+ then SOME (WordX.orb (WordX.one ws,
+ WordX.lshift (WordX.fromIntInf (i, ws),
+ WordX.one ws)))
+
+ else NONE
+ end
- fun isSmall (i: IntInf.t): bool =
- minSmall <= i andalso i <= maxSmall
+ val isSmall = isSome o toWord
- fun toWord (i: IntInf.t): word option =
- if isSmall i
- then SOME (Word.orb (0w1,
- Word.<< (Word.fromInt (IntInf.toInt i),
- 0w1)))
- else NONE
-
- fun fromWord (w: word): IntInf.t =
- IntInf.fromInt (Word.toIntX (Word.~>> (w, 0w1)))
+ fun fromWord (w: WordX.t): IntInf.t =
+ WordX.toIntInfX (WordX.rshift (w, WordX.one (WordX.size w), {signed = true}))
end
datatype t =
Modified: mlton/branches/on-20050822-x86_64-branch/mlton/atoms/const.sig
===================================================================
--- mlton/branches/on-20050822-x86_64-branch/mlton/atoms/const.sig 2007-02-19 22:35:19 UTC (rev 5267)
+++ mlton/branches/on-20050822-x86_64-branch/mlton/atoms/const.sig 2007-02-19 22:50:42 UTC (rev 5268)
@@ -25,9 +25,9 @@
structure SmallIntInf:
sig
- val fromWord: word -> IntInf.t
+ val fromWord: WordX.t -> IntInf.t
val isSmall: IntInf.t -> bool
- val toWord: IntInf.t -> word option
+ val toWord: IntInf.t -> WordX.t option
end
datatype t =
Modified: mlton/branches/on-20050822-x86_64-branch/mlton/atoms/hash-type.fun
===================================================================
--- mlton/branches/on-20050822-x86_64-branch/mlton/atoms/hash-type.fun 2007-02-19 22:35:19 UTC (rev 5267)
+++ mlton/branches/on-20050822-x86_64-branch/mlton/atoms/hash-type.fun 2007-02-19 22:50:42 UTC (rev 5268)
@@ -232,33 +232,41 @@
val realCompare = make real
val wordCompare = make word
end
- fun intInfBinary () = done ([intInf, intInf, defaultWord], intInf)
- fun intInfShift () = done ([intInf, defaultWord, defaultWord], intInf)
- fun intInfUnary () = done ([intInf, defaultWord], intInf)
+ val cint = word (WordSize.cint ())
+ val compareRes = word WordSize.compareRes
+ val csize = word (WordSize.csize ())
+ val cpointer = word (WordSize.cpointer ())
+ val cptrdiff = word (WordSize.cptrdiff ())
+ val seqIndex = word (WordSize.seqIndex ())
+ val shiftArg = word WordSize.shiftArg
+ val bigIntInfWord = word (WordSize.bigIntInfWord ())
+ val smallIntInfWord = word (WordSize.smallIntInfWord ())
+
+ fun intInfBinary () = done ([intInf, intInf, csize], intInf)
+ fun intInfShift () = done ([intInf, shiftArg, csize], intInf)
+ fun intInfUnary () = done ([intInf, csize], intInf)
fun real3 s = done ([real s, real s, real s], real s)
- val pointer = defaultWord
val word8Array = array word8
- val wordVector = vector defaultWord
- fun wordShift s = done ([word s, defaultWord], word s)
+ fun wordShift s = done ([word s, shiftArg], word s)
in
case Prim.name prim of
- Array_array => oneTarg (fn targ => ([defaultWord], array targ))
+ Array_array => oneTarg (fn targ => ([seqIndex], array targ))
| Array_array0Const => oneTarg (fn targ => ([], array targ))
- | Array_length => oneTarg (fn t => ([array t], defaultWord))
- | Array_sub => oneTarg (fn t => ([array t, defaultWord], t))
+ | Array_length => oneTarg (fn t => ([array t], seqIndex))
+ | Array_sub => oneTarg (fn t => ([array t, seqIndex], t))
| Array_toVector => oneTarg (fn t => ([array t], vector t))
- | Array_update => oneTarg (fn t => ([array t, defaultWord, t], unit))
+ | Array_update => oneTarg (fn t => ([array t, seqIndex, t], unit))
| Exn_extra => oneTarg (fn t => ([exn], t))
| Exn_name => done ([exn], string)
| Exn_setExtendExtra => oneTarg (fn t => ([arrow (t, t)], unit))
| Exn_setInitExtra => oneTarg (fn t => ([t], unit))
| FFI f => done (Vector.toList (CFunction.args f), CFunction.return f)
- | FFI_Symbol _ => done ([], pointer)
+ | FFI_Symbol _ => done ([], cpointer)
| GC_collect => done ([], unit)
| IntInf_add => intInfBinary ()
| IntInf_andb => intInfBinary ()
| IntInf_arshift => intInfShift ()
- | IntInf_compare => done ([intInf, intInf], defaultWord)
+ | IntInf_compare => done ([intInf, intInf], compareRes)
| IntInf_equal => done ([intInf, intInf], bool)
| IntInf_gcd => intInfBinary ()
| IntInf_lshift => intInfShift ()
@@ -269,26 +277,26 @@
| IntInf_quot => intInfBinary ()
| IntInf_rem => intInfBinary ()
| IntInf_sub => intInfBinary ()
- | IntInf_toString => done ([intInf, defaultWord, defaultWord], string)
- | IntInf_toVector => done ([intInf], vector defaultWord)
- | IntInf_toWord => done ([intInf], defaultWord)
+ | IntInf_toString => done ([intInf, word32, csize], string)
+ | IntInf_toVector => done ([intInf], vector bigIntInfWord)
+ | IntInf_toWord => done ([intInf], smallIntInfWord)
| IntInf_xorb => intInfBinary ()
| MLton_bogus => oneTarg (fn t => ([], t))
| MLton_bug => done ([string], unit)
| MLton_eq => oneTarg (fn t => ([t, t], bool))
| MLton_equal => oneTarg (fn t => ([t, t], bool))
- | MLton_halt => done ([defaultWord], unit)
+ | MLton_halt => done ([cint], unit)
| MLton_handlesSignals => done ([], bool)
| MLton_installSignalHandler => done ([], unit)
| MLton_share => oneTarg (fn t => ([t], unit))
- | MLton_size => oneTarg (fn t => ([t], defaultWord))
+ | MLton_size => oneTarg (fn t => ([t], csize))
| MLton_touch => oneTarg (fn t => ([t], unit))
- | Pointer_getPointer => oneTarg (fn t => ([pointer, defaultWord], t))
- | Pointer_getReal s => done ([pointer, defaultWord], real s)
- | Pointer_getWord s => done ([pointer, defaultWord], word s)
- | Pointer_setPointer => oneTarg (fn t => ([pointer, defaultWord, t], unit))
- | Pointer_setReal s => done ([pointer, defaultWord, real s], unit)
- | Pointer_setWord s => done ([pointer, defaultWord, word s], unit)
+ | Pointer_getPointer => oneTarg (fn t => ([cpointer, cptrdiff], t))
+ | Pointer_getReal s => done ([cpointer, cptrdiff], real s)
+ | Pointer_getWord s => done ([cpointer, cptrdiff], word s)
+ | Pointer_setPointer => oneTarg (fn t => ([cpointer, cptrdiff, t], unit))
+ | Pointer_setReal s => done ([cpointer, cptrdiff, real s], unit)
+ | Pointer_setWord s => done ([cpointer, cptrdiff, word s], unit)
| Real_Math_acos s => realUnary s
| Real_Math_asin s => realUnary s
| Real_Math_atan s => realUnary s
@@ -304,7 +312,7 @@
| Real_add s => realBinary s
| Real_div s => realBinary s
| Real_equal s => realCompare s
- | Real_ldexp s => done ([real s, defaultWord], real s)
+ | Real_ldexp s => done ([real s, cint], real s)
| Real_le s => realCompare s
| Real_lt s => realCompare s
| Real_mul s => realBinary s
@@ -321,23 +329,22 @@
| Ref_ref => oneTarg (fn t => ([t], reff t))
| Thread_atomicBegin => done ([], unit)
| Thread_atomicEnd => done ([], unit)
- | Thread_canHandle => done ([], defaultWord)
+ | Thread_canHandle => done ([], word32)
| Thread_copy => done ([thread], thread)
| Thread_copyCurrent => done ([], unit)
| Thread_returnToC => done ([], unit)
| Thread_switchTo => done ([thread], unit)
| TopLevel_setHandler => done ([arrow (exn, unit)], unit)
| TopLevel_setSuffix => done ([arrow (unit, unit)], unit)
- | Vector_length => oneTarg (fn t => ([vector t], defaultWord))
- | Vector_sub => oneTarg (fn t => ([vector t, defaultWord], t))
+ | Vector_length => oneTarg (fn t => ([vector t], seqIndex))
+ | Vector_sub => oneTarg (fn t => ([vector t, seqIndex], t))
| Weak_canGet => oneTarg (fn t => ([weak t], bool))
| Weak_get => oneTarg (fn t => ([weak t], t))
| Weak_new => oneTarg (fn t => ([t], weak t))
- | Word8Array_subWord => done ([word8Array, defaultWord], defaultWord)
- | Word8Array_updateWord =>
- done ([word8Array, defaultWord, defaultWord], unit)
- | Word8Vector_subWord => done ([word8Vector, defaultWord], defaultWord)
- | WordVector_toIntInf => done ([wordVector], intInf)
+ | Word8Array_subWord s => done ([word8Array, seqIndex], word s)
+ | Word8Array_updateWord s => done ([word8Array, seqIndex, word s], unit)
+ | Word8Vector_subWord s => done ([word8Vector, seqIndex], word s)
+ | WordVector_toIntInf => done ([vector bigIntInfWord], intInf)
| Word_add s => wordBinary s
| Word_addCheck (s, _) => wordBinary s
| Word_andb s => wordBinary s
@@ -357,7 +364,7 @@
| Word_rshift (s, _) => wordShift s
| Word_sub s => wordBinary s
| Word_subCheck (s, _) => wordBinary s
- | Word_toIntInf => done ([defaultWord], intInf)
+ | Word_toIntInf => done ([smallIntInfWord], intInf)
| Word_toReal (s, s', _) => done ([word s], real s')
| Word_toWord (s, s', _) => done ([word s], word s')
| Word_xorb s => wordBinary s
Modified: mlton/branches/on-20050822-x86_64-branch/mlton/atoms/prim.fun
===================================================================
--- mlton/branches/on-20050822-x86_64-branch/mlton/atoms/prim.fun 2007-02-19 22:35:19 UTC (rev 5267)
+++ mlton/branches/on-20050822-x86_64-branch/mlton/atoms/prim.fun 2007-02-19 22:50:42 UTC (rev 5268)
@@ -172,9 +172,9 @@
| Word_toWord of WordSize.t * WordSize.t * {signed: bool} (* codegen *)
| Word_xorb of WordSize.t (* codegen *)
| WordVector_toIntInf (* ssa to rssa *)
- | Word8Array_subWord (* ssa to rssa *)
- | Word8Array_updateWord (* ssa to rssa *)
- | Word8Vector_subWord (* ssa to rssa *)
+ | Word8Array_subWord of WordSize.t (* ssa to rssa *)
+ | Word8Array_updateWord of WordSize.t (* ssa to rssa *)
+ | Word8Vector_subWord of WordSize.t (* ssa to rssa *)
| Word8Vector_toString (* defunctorize *)
| World_save (* ssa to rssa *)
@@ -190,6 +190,8 @@
fun sign {signed} = if signed then "WordS" else "WordU"
fun word (s: WordSize.t, str: string): string =
concat ["Word", WordSize.toString s, "_", str]
+ fun word8Seq (seq: string, oper: string, s: WordSize.t): string =
+ concat ["Word8", seq, "_", oper, "Word", WordSize.toString s]
fun wordS (s: WordSize.t, sg, str: string): string =
concat [sign sg, WordSize.toString s, "_", str]
val realC = ("Real", RealSize.toString)
@@ -295,9 +297,9 @@
| Weak_canGet => "Weak_canGet"
| Weak_get => "Weak_get"
| Weak_new => "Weak_new"
- | Word8Array_subWord => "Word8Array_subWord"
- | Word8Array_updateWord => "Word8Array_updateWord"
- | Word8Vector_subWord => "Word8Vector_subWord"
+ | Word8Array_subWord w => word8Seq ("Array", "sub", w)
+ | Word8Array_updateWord w => word8Seq ("Array", "update", w)
+ | Word8Vector_subWord w => word8Seq ("Vector", "sub", w)
| Word8Vector_toString => "Word8Vector_toString"
| WordVector_toIntInf => "WordVector_toIntInf"
| Word_add s => word (s, "add")
@@ -465,9 +467,9 @@
andalso sg = sg'
| (Word_xorb s, Word_xorb s') => WordSize.equals (s, s')
| (WordVector_toIntInf, WordVector_toIntInf) => true
- | (Word8Array_subWord, Word8Array_subWord) => true
- | (Word8Array_updateWord, Word8Array_updateWord) => true
- | (Word8Vector_subWord, Word8Vector_subWord) => true
+ | (Word8Array_subWord s, Word8Array_subWord s') => WordSize.equals (s, s')
+ | (Word8Array_updateWord s, Word8Array_updateWord s') => WordSize.equals (s, s')
+ | (Word8Vector_subWord s, Word8Vector_subWord s') => WordSize.equals (s, s')
| (Word8Vector_toString, Word8Vector_toString) => true
| (World_save, World_save) => true
| _ => false
@@ -593,9 +595,9 @@
| Word_toWord z => Word_toWord z
| Word_xorb z => Word_xorb z
| WordVector_toIntInf => WordVector_toIntInf
- | Word8Array_subWord => Word8Array_subWord
- | Word8Array_updateWord => Word8Array_updateWord
- | Word8Vector_subWord => Word8Vector_subWord
+ | Word8Array_subWord z => Word8Array_subWord z
+ | Word8Array_updateWord z => Word8Array_updateWord z
+ | Word8Vector_subWord z => Word8Vector_subWord z
| Word8Vector_toString => Word8Vector_toString
| World_save => World_save
@@ -614,15 +616,16 @@
val intInfEqual = IntInf_equal
val intInfNeg = IntInf_neg
val intInfNotb = IntInf_notb
-fun pointerGet ctype =
+fun pointerGet ctype =
let datatype z = datatype CType.t
in
case ctype of
- Int8 => Pointer_getWord (WordSize.fromBits (Bits.fromInt 8))
+ CPointer => Pointer_getPointer
+ | Int8 => Pointer_getWord (WordSize.fromBits (Bits.fromInt 8))
| Int16 => Pointer_getWord (WordSize.fromBits (Bits.fromInt 16))
| Int32 => Pointer_getWord (WordSize.fromBits (Bits.fromInt 32))
| Int64 => Pointer_getWord (WordSize.fromBits (Bits.fromInt 64))
- | Pointer => Pointer_getPointer
+ | Objptr => Error.bug "Prim.pointerGet"
| Real32 => Pointer_getReal RealSize.R32
| Real64 => Pointer_getReal RealSize.R64
| Word8 => Pointer_getWord (WordSize.fromBits (Bits.fromInt 8))
@@ -630,15 +633,16 @@
| Word32 => Pointer_getWord (WordSize.fromBits (Bits.fromInt 32))
| Word64 => Pointer_getWord (WordSize.fromBits (Bits.fromInt 64))
end
-fun pointerSet ctype =
+fun pointerSet ctype =
let datatype z = datatype CType.t
in
case ctype of
- Int8 => Pointer_setWord (WordSize.fromBits (Bits.fromInt 8))
+ CPointer => Pointer_setPointer
+ | Int8 => Pointer_setWord (WordSize.fromBits (Bits.fromInt 8))
| Int16 => Pointer_setWord (WordSize.fromBits (Bits.fromInt 16))
| Int32 => Pointer_setWord (WordSize.fromBits (Bits.fromInt 32))
| Int64 => Pointer_setWord (WordSize.fromBits (Bits.fromInt 64))
- | Pointer => Pointer_setPointer
+ | Objptr => Error.bug "Prim.pointerSet"
| Real32 => Pointer_setReal RealSize.R32
| Real64 => Pointer_setReal RealSize.R64
| Word8 => Pointer_setWord (WordSize.fromBits (Bits.fromInt 8))
@@ -790,9 +794,9 @@
| Weak_canGet => DependsOnState
| Weak_get => DependsOnState
| Weak_new => Moveable
- | Word8Array_subWord => DependsOnState
- | Word8Array_updateWord => SideEffect
- | Word8Vector_subWord => Functional
+ | Word8Array_subWord _ => DependsOnState
+ | Word8Array_updateWord _ => SideEffect
+ | Word8Vector_subWord _ => Functional
| Word8Vector_toString => Functional
| WordVector_toIntInf => Functional
| Word_add _ => Functional
@@ -883,6 +887,10 @@
(Word_xorb s)]
@ wordSigns (s, true)
@ wordSigns (s, false)
+ fun word8Seqs (s: WordSize.t) =
+ [(Word8Array_subWord s),
+ (Word8Array_updateWord s),
+ (Word8Vector_subWord s)]
in
val all: unit t list =
[Array_array,
@@ -948,9 +956,6 @@
Weak_new,
Word_toIntInf,
WordVector_toIntInf,
- Word8Array_subWord,
- Word8Array_updateWord,
- Word8Vector_subWord,
Word8Vector_toString,
World_save]
@ List.concat [List.concatMap (RealSize.all, reals),
@@ -975,6 +980,7 @@
(real, ac, fn (s', ac) =>
Real_toReal (s, s') :: ac)))))
end
+ @ List.concatMap (WordSize.prims, word8Seqs)
@ let
fun doit (all, get, set) =
List.concatMap (all, fn s => [get s, set s])
@@ -1187,14 +1193,13 @@
| Relation.EQUAL => 0
| Relation.GREATER => 1
in
- word (WordX.fromIntInf (i, WordSize.default))
+ word (WordX.fromIntInf (i, WordSize.compareRes))
end
| (IntInf_equal, [IntInf i1, IntInf i2]) => bool (i1 = i2)
| (IntInf_toWord, [IntInf i]) =>
(case SmallIntInf.toWord i of
NONE => ApplyResult.Unknown
- | SOME w => word (WordX.fromIntInf (Word.toIntInf w,
- WordSize.default)))
+ | SOME w => word w)
| (MLton_eq, [c1, c2]) => eq (c1, c2)
| (MLton_equal, [c1, c2]) => equal (c1, c2)
| (Word_add _, [Word w1, Word w2]) => word (WordX.add (w1, w2))
@@ -1224,9 +1229,7 @@
wordS (WordX.rshift, s, w1, w2)
| (Word_sub _, [Word w1, Word w2]) => word (WordX.sub (w1, w2))
| (Word_subCheck s, [Word w1, Word w2]) => wcheck (op -, s, w1, w2)
- | (Word_toIntInf, [Word w]) =>
- intInf (SmallIntInf.fromWord
- (Word.fromIntInf (WordX.toIntInf w)))
+ | (Word_toIntInf, [Word w]) => intInf (SmallIntInf.fromWord w)
| (Word_toWord (_, s, {signed}), [Word w]) =>
word (if signed then WordX.resizeX (w, s)
else WordX.resize (w, s))
@@ -1334,7 +1337,7 @@
(w,
WordX.fromIntInf (Bits.toIntInf
(WordSize.bits s),
- WordSize.default),
+ WordSize.shiftArg),
{signed = false}))
then zero s
else Unknown
@@ -1494,7 +1497,7 @@
in
case p of
IntInf_compare =>
- word (WordX.zero WordSize.default)
+ word (WordX.zero WordSize.compareRes)
| IntInf_equal => t
| MLton_eq => t
| MLton_equal => t
Modified: mlton/branches/on-20050822-x86_64-branch/mlton/atoms/prim.sig
===================================================================
--- mlton/branches/on-20050822-x86_64-branch/mlton/atoms/prim.sig 2007-02-19 22:35:19 UTC (rev 5267)
+++ mlton/branches/on-20050822-x86_64-branch/mlton/atoms/prim.sig 2007-02-19 22:50:42 UTC (rev 5268)
@@ -162,9 +162,9 @@
| Word_toWord of WordSize.t * WordSize.t * {signed: bool} (* codegen *)
| Word_xorb of WordSize.t (* codegen *)
| WordVector_toIntInf (* ssa to rssa *)
- | Word8Array_subWord (* ssa to rssa *)
- | Word8Array_updateWord (* ssa to rssa *)
- | Word8Vector_subWord (* ssa to rssa *)
+ | Word8Array_subWord of WordSize.t (* ssa to rssa *)
+ | Word8Array_updateWord of WordSize.t (* ssa to rssa *)
+ | Word8Vector_subWord of WordSize.t (* ssa to rssa *)
| Word8Vector_toString (* defunctorize *)
| World_save (* ssa to rssa *)
Modified: mlton/branches/on-20050822-x86_64-branch/mlton/atoms/type-ops.fun
===================================================================
--- mlton/branches/on-20050822-x86_64-branch/mlton/atoms/type-ops.fun 2007-02-19 22:35:19 UTC (rev 5267)
+++ mlton/branches/on-20050822-x86_64-branch/mlton/atoms/type-ops.fun 2007-02-19 22:50:42 UTC (rev 5268)
@@ -27,14 +27,11 @@
val bool = nullary Tycon.bool
val exn = nullary Tycon.exn
val intInf = nullary Tycon.intInf
- val pointer = nullary Tycon.pointer
val real = RealSize.memoize (fn s => nullary (Tycon.real s))
val thread = nullary Tycon.thread
val word = WordSize.memoize (fn s => nullary (Tycon.word s))
end
-val defaultWord = word WordSize.default
-
local
fun unary tycon t = con (tycon, Vector.new1 t)
in
@@ -45,8 +42,9 @@
val weak = unary Tycon.weak
end
-val word8 = word WordSize.byte
+val word8 = word WordSize.word8
val word8Vector = vector word8
+val word32 = word WordSize.word32
local
fun binary tycon (t1, t2) = con (tycon, Vector.new2 (t1, t2))
Modified: mlton/branches/on-20050822-x86_64-branch/mlton/atoms/type-ops.sig
===================================================================
--- mlton/branches/on-20050822-x86_64-branch/mlton/atoms/type-ops.sig 2007-02-19 22:35:19 UTC (rev 5267)
+++ mlton/branches/on-20050822-x86_64-branch/mlton/atoms/type-ops.sig 2007-02-19 22:50:42 UTC (rev 5268)
@@ -41,12 +41,10 @@
val deTupleOpt: t -> t vector option
val deVector: t -> t
val deWeak: t -> t
- val defaultWord: t
val exn: t
val intInf: t
val isTuple: t -> bool
val list: t -> t
- val pointer: t
val real: realSize -> t
val reff: t -> t
val thread: t
@@ -58,4 +56,5 @@
val word: wordSize -> t
val word8: t
val word8Vector: t
+ val word32: t
end
Modified: mlton/branches/on-20050822-x86_64-branch/mlton/backend/allocate-registers.fun
===================================================================
--- mlton/branches/on-20050822-x86_64-branch/mlton/backend/allocate-registers.fun 2007-02-19 22:35:19 UTC (rev 5267)
+++ mlton/branches/on-20050822-x86_64-branch/mlton/backend/allocate-registers.fun 2007-02-19 22:50:42 UTC (rev 5268)
@@ -409,9 +409,9 @@
then
let
val (stack, {offset = handler, ...}) =
- Allocation.Stack.get (stack, Type.defaultWord)
+ Allocation.Stack.get (stack, Type.label (Label.newNoname ()))
val (_, {offset = link, ...}) =
- Allocation.Stack.get (stack, Type.exnStack)
+ Allocation.Stack.get (stack, Type.exnStack ())
in
SOME {handler = handler, link = link}
end
@@ -456,7 +456,7 @@
if linkLive
then
Operand.stackOffset {offset = link,
- ty = Type.exnStack}
+ ty = Type.exnStack ()}
:: extra
else extra
in
@@ -474,8 +474,10 @@
case handlerLinkOffset of
NONE => stackInit
| SOME {handler, link} =>
- StackOffset.T {offset = handler, ty = Type.defaultWord} (* should be label *)
- :: StackOffset.T {offset = link, ty = Type.exnStack}
+ StackOffset.T {offset = handler,
+ ty = Type.label (Label.newNoname ())}
+ :: StackOffset.T {offset = link,
+ ty = Type.exnStack ()}
:: stackInit
val a = Allocation.new (stackInit, registersInit)
val size =
@@ -484,21 +486,20 @@
(case handlerLinkOffset of
NONE => Error.bug "AllocateRegisters.allocate: Handler with no handler offset"
| SOME {handler, ...} =>
- Bytes.+ (Runtime.labelSize, handler))
+ Bytes.+ (Runtime.labelSize (), handler))
| _ =>
let
val size =
Bytes.+
- (Runtime.labelSize,
- Bytes.wordAlign (Allocation.stackSize a))
+ (Runtime.labelSize (),
+ Bytes.alignWord32 (Allocation.stackSize a))
in
case !Control.align of
Control.Align4 => size
- | Control.Align8 =>
- Bytes.align (size, {alignment = Bytes.fromInt 8})
+ | Control.Align8 => Bytes.alignWord64 size
end
val _ =
- if Bytes.isWordAligned size
+ if Bytes.isWord32Aligned size
then ()
else Error.bug (concat ["AllocateRegisters.allocate: ",
"bad size ",
Modified: mlton/branches/on-20050822-x86_64-branch/mlton/backend/backend.fun
===================================================================
--- mlton/branches/on-20050822-x86_64-branch/mlton/backend/backend.fun 2007-02-19 22:35:19 UTC (rev 5267)
+++ mlton/branches/on-20050822-x86_64-branch/mlton/backend/backend.fun 2007-02-19 22:50:42 UTC (rev 5268)
@@ -18,7 +18,7 @@
structure Global = Global
structure Label = Label
structure Live = Live
- structure PointerTycon = PointerTycon
+ structure ObjptrTycon = ObjptrTycon
structure RealX = RealX
structure Register = Register
structure Runtime = Runtime
@@ -382,7 +382,7 @@
hash = hash,
global = M.Global.new {isRoot = true,
ty = ty},
- value = value})))
+ value = value})))
end
fun all () =
HashSet.fold
@@ -394,11 +394,9 @@
in
val (allIntInfs, globalIntInf) =
make (IntInf.equals,
- fn i => let
- val s = IntInf.toString i
- in
- (s, Type.intInf, s)
- end)
+ fn i => (IntInf.toString i,
+ Type.intInf (),
+ i))
val (allReals, globalReal) =
make (RealX.equals,
fn r => (RealX.toString r,
@@ -407,7 +405,7 @@
val (allVectors, globalVector) =
make (WordXVector.equals,
fn v => (WordXVector.toString v,
- Type.ofWordVector v,
+ Type.ofWordXVector v,
v))
end
fun realOp (r: RealX.t): M.Operand.t =
@@ -427,9 +425,7 @@
IntInf i =>
(case Const.SmallIntInf.toWord i of
NONE => globalIntInf i
- | SOME w =>
- M.Operand.Word (WordX.fromIntInf
- (Word.toIntInf w, WordSize.default)))
+ | SOME w => M.Operand.Word w)
| Real r => realOp r
| Word w => M.Operand.Word w
| WordVector v => globalVector v
@@ -453,17 +449,17 @@
temp = temp
})
end
- fun runtimeOp (field: GCField.t, ty: Type.t): M.Operand.t =
+ fun runtimeOp (field: GCField.t): M.Operand.t =
case field of
GCField.Frontier => M.Operand.Frontier
| GCField.StackTop => M.Operand.StackTop
| _ =>
M.Operand.Offset {base = M.Operand.GCState,
offset = GCField.offset field,
- ty = ty}
- val exnStackOp = runtimeOp (GCField.ExnStack, Type.exnStack)
- val stackBottomOp = runtimeOp (GCField.StackBottom, Type.defaultWord)
- val stackTopOp = runtimeOp (GCField.StackTop, Type.defaultWord)
+ ty = Type.ofGCField field}
+ val exnStackOp = runtimeOp GCField.ExnStack
+ val stackBottomOp = runtimeOp GCField.StackBottom
+ val stackTopOp = runtimeOp GCField.StackTop
fun translateOperand (oper: R.Operand.t): M.Operand.t =
let
datatype z = datatype R.Operand.t
@@ -492,14 +488,13 @@
ty = ty}
else bogusOp ty
end
- | PointerTycon pt =>
+ | ObjptrTycon opt =>
M.Operand.Word
(WordX.fromIntInf
(Word.toIntInf (Runtime.typeIndexToHeader
- (PointerTycon.index pt)),
- WordSize.default))
- | Runtime f =>
- runtimeOp (f, R.Operand.ty oper)
+ (ObjptrTycon.index opt)),
+ WordSize.objptrHeader ()))
+ | Runtime f => runtimeOp f
| Var {var, ...} => varOperand var
end
fun translateOperands ops = Vector.map (ops, translateOperand)
@@ -545,11 +540,11 @@
end
| ProfileLabel s => Vector.new1 (M.Statement.ProfileLabel s)
| SetExnStackLocal =>
- (* ExnStack = stackTop + (offset + WORD_SIZE) - StackBottom; *)
+ (* ExnStack = stackTop + (offset + LABEL_SIZE) - StackBottom; *)
let
val tmp =
M.Operand.Register
- (Register.new (Type.defaultWord, NONE))
+ (Register.new (Type.cpointer (), NONE))
in
Vector.new2
(M.Statement.PrimApp
@@ -559,14 +554,14 @@
(WordX.fromIntInf
(Int.toIntInf
(Bytes.toInt
- (Bytes.+ (handlerOffset (), Bytes.inWord))),
- WordSize.default)))),
+ (Bytes.+ (handlerOffset (), Runtime.labelSize ()))),
+ WordSize.cpointer ())))),
dst = SOME tmp,
- prim = Prim.wordAdd WordSize.default},
+ prim = Prim.wordAdd (WordSize.cpointer ())},
M.Statement.PrimApp
{args = Vector.new2 (tmp, stackBottomOp),
dst = SOME exnStackOp,
- prim = Prim.wordSub WordSize.default})
+ prim = Prim.wordSub (WordSize.cpointer ())})
end
| SetExnStackSlot =>
(* ExnStack = *(uint* )(stackTop + offset); *)
@@ -574,7 +569,7 @@
(M.Statement.move
{dst = exnStackOp,
src = M.Operand.stackOffset {offset = linkOffset (),
- ty = Type.exnStack}})
+ ty = Type.exnStack ()}})
| SetHandler h =>
Vector.new1
(M.Statement.move
@@ -586,7 +581,7 @@
Vector.new1
(M.Statement.move
{dst = M.Operand.stackOffset {offset = linkOffset (),
- ty = Type.exnStack},
+ ty = Type.exnStack ()},
src = exnStackOp})
| _ => Error.bug (concat
["Backend.genStatement: strange statement: ",
@@ -596,14 +591,14 @@
Trace.trace ("Backend.genStatement",
R.Statement.layout o #1, Vector.layout M.Statement.layout)
genStatement
- val bugTransfer =
+ val bugTransfer = fn () =>
M.Transfer.CCall
{args = (Vector.new1
(globalVector
(WordXVector.fromString
"backend thought control shouldn't reach here"))),
frameInfo = NONE,
- func = Type.BuiltInCFunction.bug,
+ func = Type.BuiltInCFunction.bug (),
return = NONE}
val {get = labelInfo: Label.t -> {args: (Var.t * Type.t) vector},
set = setLabelInfo, ...} =
@@ -750,7 +745,7 @@
(liveNoFormals, [], fn (oper, ac) =>
case oper of
M.Operand.StackOffset (StackOffset.T {offset, ty}) =>
- if Type.isPointer ty
+ if Type.isObjptr ty
then offset :: ac
else ac
| _ => ac)
@@ -867,7 +862,7 @@
in
simple
(case (Vector.length cases, default) of
- (0, NONE) => bugTransfer
+ (0, NONE) => bugTransfer ()
| (1, NONE) =>
M.Transfer.Goto (#2 (Vector.sub (cases, 0)))
| (0, SOME dst) => M.Transfer.Goto dst
@@ -1104,7 +1099,7 @@
in
max
end))
- val maxFrameSize = Bytes.wordAlign maxFrameSize
+ val maxFrameSize = Bytes.alignWord32 maxFrameSize
val profileInfo = makeProfileInfo {frames = frameLabels}
in
Machine.Program.T
Modified: mlton/branches/on-20050822-x86_64-branch/mlton/backend/limit-check.fun
===================================================================
--- mlton/branches/on-20050822-x86_64-branch/mlton/backend/limit-check.fun 2007-02-19 22:35:19 UTC (rev 5267)
+++ mlton/branches/on-20050822-x86_64-branch/mlton/backend/limit-check.fun 2007-02-19 22:50:42 UTC (rev 5268)
@@ -100,7 +100,7 @@
fun bytesAllocated (s: t): Bytes.t =
case s of
- Object {size, ...} => Words.toBytes size
+ Object {size, ...} => size
| _ => Bytes.zero
end
@@ -160,7 +160,7 @@
ensureFree: Label.t -> Bytes.t) =
let
val {args, blocks, name, raises, returns, start} = Function.dest f
- val lessThan = Prim.wordLt (WordSize.default, {signed = false})
+ val lessThan = Prim.wordLt (WordSize.csize (), {signed = false})
val newBlocks = ref []
local
val r: Label.t option ref = ref NONE
@@ -218,7 +218,7 @@
(WordX.fromIntInf
(Bytes.toIntInf
(ensureFree (valOf return)),
- WordSize.default))
+ WordSize.csize ()))
| _ => z)),
func = func,
return = return}
@@ -343,7 +343,7 @@
then ignore (stackCheck
(true,
insert (Operand.word
- (WordX.zero WordSize.default))))
+ (WordX.zero (WordSize.csize ())))))
else
(* No limit check, just keep the block around. *)
List.push (newBlocks,
@@ -377,11 +377,11 @@
Statement.PrimApp
{args = Vector.new2 (Operand.Runtime LimitPlusSlop,
Operand.Runtime Frontier),
- dst = SOME (res, Type.defaultWord),
- prim = Prim.wordSub WordSize.default}
+ dst = SOME (res, Type.csize ()),
+ prim = Prim.wordSub (WordSize.csize ())}
val (statements, transfer) =
primApp (lessThan,
- Operand.Var {var = res, ty = Type.defaultWord},
+ Operand.Var {var = res, ty = Type.csize ()},
amount,
z)
val statements = Vector.concat [Vector.new1 s, statements]
@@ -389,10 +389,10 @@
if handlesSignals
then
frontierCheck (isFirst,
- Prim.wordEqual WordSize.default,
+ Prim.wordEqual (WordSize.csize ()),
Operand.Runtime Limit,
Operand.word (WordX.zero
- WordSize.default),
+ (WordSize.csize ())),
{collect = collect,
dontCollect = newBlock (false,
statements,
@@ -414,11 +414,11 @@
Operand.Runtime Limit,
Operand.Runtime Frontier,
insert (Operand.word
- (WordX.zero WordSize.default)))
+ (WordX.zero (WordSize.csize ()))))
else heapCheck (true,
Operand.word (WordX.fromIntInf
(Bytes.toIntInf bytes,
- WordSize.default))))
+ WordSize.csize ()))))
fun smallAllocation (): unit =
let
val b = blockCheckAmount {blockIndex = i}
@@ -454,18 +454,18 @@
(WordX.fromIntInf
(Word.toIntInf
(Bytes.toWord extraBytes),
- WordSize.default)),
+ WordSize.csize ())),
bytesNeeded),
dst = bytes,
overflow = allocTooLarge (),
- prim = Prim.wordAddCheck (WordSize.default,
+ prim = Prim.wordAddCheck (WordSize.csize (),
{signed = false}),
success = (heapCheck
(false,
Operand.Var
{var = bytes,
- ty = Type.defaultWord})),
- ty = Type.defaultWord})
+ ty = Type.csize ()})),
+ ty = Type.csize ()})
in
()
end
Modified: mlton/branches/on-20050822-x86_64-branch/mlton/backend/machine.fun
===================================================================
--- mlton/branches/on-20050822-x86_64-branch/mlton/backend/machine.fun 2007-02-19 22:35:19 UTC (rev 5267)
+++ mlton/branches/on-20050822-x86_64-branch/mlton/backend/machine.fun 2007-02-19 22:50:42 UTC (rev 5268)
@@ -11,13 +11,13 @@
open S
-structure PointerTycon = PointerTycon ()
+structure ObjptrTycon = ObjptrTycon ()
structure Runtime = Runtime ()
structure Scale = Scale ()
structure RepType = RepType (structure CFunction = CFunction
structure CType = CType
structure Label = Label
- structure PointerTycon = PointerTycon
+ structure ObjptrTycon = ObjptrTycon
structure Prim = Prim
structure RealSize = RealSize
structure Runtime = Runtime
@@ -124,7 +124,7 @@
fun new {isRoot, ty} =
let
- val isRoot = isRoot orelse not (Type.isPointer ty)
+ val isRoot = isRoot orelse not (Type.isObjptr ty)
val counter =
if isRoot
then memo (Type.toCType ty)
@@ -223,18 +223,18 @@
fn ArrayOffset {ty, ...} => ty
| Cast (_, ty) => ty
| Contents {ty, ...} => ty
- | File => Type.cPointer ()
- | Frontier => Type.defaultWord
- | GCState => Type.gcState
+ | File => Type.cpointer ()
+ | Frontier => Type.cpointer ()
+ | GCState => Type.gcState ()
| Global g => Global.ty g
| Label l => Type.label l
- | Line => Type.defaultWord
+ | Line => Type.cint ()
| Offset {ty, ...} => ty
| Real r => Type.real (RealX.size r)
| Register r => Register.ty r
| StackOffset s => StackOffset.ty s
- | StackTop => Type.defaultWord
- | Word w => Type.constant w
+ | StackTop => Type.cpointer ()
+ | Word w => Type.ofWordX w
fun layout (z: t): Layout.t =
let
@@ -387,20 +387,21 @@
let
datatype z = datatype Operand.t
fun bytes (b: Bytes.t): Operand.t =
- Word (WordX.fromIntInf (Bytes.toIntInf b, WordSize.default))
+ Word (WordX.fromIntInf (Bytes.toIntInf b, WordSize.csize ()))
in
Vector.new3
(Move {dst = Contents {oper = Frontier,
- ty = Type.defaultWord},
+ ty = Type.objptrHeader ()},
src = Word (WordX.fromIntInf (Word.toIntInf header,
- WordSize.default))},
+ WordSize.objptrHeader ()))},
+ (* CHECK; if objptr <> cpointer, need coercion here. *)
PrimApp {args = Vector.new2 (Frontier,
- bytes Runtime.normalHeaderSize),
+ bytes (Runtime.headerSize ())),
dst = SOME dst,
- prim = Prim.wordAdd WordSize.default},
- PrimApp {args = Vector.new2 (Frontier, bytes (Words.toBytes size)),
+ prim = Prim.wordAdd (WordSize.cpointer ())},
+ PrimApp {args = Vector.new2 (Frontier, bytes size),
dst = SOME Frontier,
- prim = Prim.wordAdd WordSize.default})
+ prim = Prim.wordAdd (WordSize.cpointer ())})
end
fun foldOperands (s, ac, f) =
@@ -792,7 +793,7 @@
size: Bytes.t} vector,
frameOffsets: Bytes.t vector vector,
handlesSignals: bool,
- intInfs: (Global.t * string) list,
+ intInfs: (Global.t * IntInf.t) list,
main: {chunkLabel: ChunkLabel.t,
label: Label.t},
maxFrameSize: Bytes.t,
@@ -950,7 +951,7 @@
andalso frameOffsetsIndex < Vector.length frameOffsets
andalso Bytes.<= (size, maxFrameSize)
andalso Bytes.<= (size, Runtime.maxFrameSize)
- andalso Bytes.isWordAligned size),
+ andalso Bytes.isWord32Aligned size),
fn () => Layout.record [("frameOffsetsIndex",
Int.layout frameOffsetsIndex),
("size", Bytes.layout size)]))
@@ -960,8 +961,8 @@
Err.check ("objectType",
fn () => ObjectType.isOk ty,
fn () => ObjectType.layout ty))
- fun tyconTy (pt: PointerTycon.t): ObjectType.t =
- Vector.sub (objectTypes, PointerTycon.index pt)
+ fun tyconTy (opt: ObjptrTycon.t): ObjectType.t =
+ Vector.sub (objectTypes, ObjptrTycon.index opt)
open Layout
fun globals (name, gs, isOk, layout) =
List.foreach
@@ -980,12 +981,12 @@
RealX.layout)
val _ =
globals ("intInf", intInfs,
- fn (t, _) => Type.isSubtype (t, Type.intInf),
- String.layout)
+ fn (t, _) => Type.isSubtype (t, Type.intInf ()),
+ IntInf.layout)
val _ =
globals ("vector", vectors,
fn (t, v) =>
- Type.equals (t, Type.ofWordVector v),
+ Type.equals (t, Type.ofWordXVector v),
WordXVector.layout)
(* Check for no duplicate labels. *)
local
@@ -1029,7 +1030,7 @@
(Type.arrayOffsetIsOk {base = Operand.ty base,
index = Operand.ty index,
offset = offset,
- pointerTy = tyconTy,
+ tyconTy = tyconTy,
result = ty,
scale = scale})))
| Cast (z, t) =>
@@ -1064,7 +1065,7 @@
| _ =>
Type.offsetIsOk {base = Operand.ty base,
offset = offset,
- pointerTy = tyconTy,
+ tyconTy = tyconTy,
result = ty})))
| Real _ => true
| Register r => Alloc.doesDefine (alloc, Live.Register r)
@@ -1086,7 +1087,7 @@
Bytes.equals
(size,
Bytes.+ (offset,
- Runtime.labelSize))
+ Runtime.labelSize ()))
end
in
case kind of
@@ -1134,7 +1135,7 @@
(zs, [], fn (z, liveOffsets) =>
case z of
Live.StackOffset (StackOffset.T {offset, ty}) =>
- if Type.isPointer ty
+ if Type.isObjptr ty
then offset :: liveOffsets
else liveOffsets
| _ => raise No)
Modified: mlton/branches/on-20050822-x86_64-branch/mlton/backend/machine.sig
===================================================================
--- mlton/branches/on-20050822-x86_64-branch/mlton/backend/machine.sig 2007-02-19 22:35:19 UTC (rev 5267)
+++ mlton/branches/on-20050822-x86_64-branch/mlton/backend/machine.sig 2007-02-19 22:50:42 UTC (rev 5268)
@@ -19,7 +19,7 @@
include MACHINE_STRUCTS
structure ObjectType: OBJECT_TYPE
- structure PointerTycon: POINTER_TYCON
+ structure ObjptrTycon: OBJPTR_TYCON
structure Runtime: RUNTIME
structure Switch: SWITCH
structure Type: REP_TYPE
@@ -27,7 +27,7 @@
sharing Atoms = Type
sharing Atoms = Switch
sharing ObjectType = Type.ObjectType
- sharing PointerTycon = ObjectType.PointerTycon = Type.PointerTycon
+ sharing ObjptrTycon = ObjectType.ObjptrTycon = Type.ObjptrTycon
sharing Runtime = ObjectType.Runtime = Type.Runtime
structure ChunkLabel: ID
@@ -142,7 +142,7 @@
(* Error if dsts and srcs aren't of same length. *)
val moves: {dsts: Operand.t vector,
srcs: Operand.t vector} -> t vector
- val object: {dst: Operand.t, header: word, size: Words.t} -> t vector
+ val object: {dst: Operand.t, header: word, size: Bytes.t} -> t vector
end
structure FrameInfo:
@@ -266,7 +266,7 @@
*)
frameOffsets: Bytes.t vector vector,
handlesSignals: bool,
- intInfs: (Global.t * string) list,
+ intInfs: (Global.t * IntInf.t) list,
main: {chunkLabel: ChunkLabel.t,
label: Label.t},
maxFrameSize: Bytes.t,
Modified: mlton/branches/on-20050822-x86_64-branch/mlton/backend/object-type.sig
===================================================================
--- mlton/branches/on-20050822-x86_64-branch/mlton/backend/object-type.sig 2007-02-19 22:35:19 UTC (rev 5267)
+++ mlton/branches/on-20050822-x86_64-branch/mlton/backend/object-type.sig 2007-02-19 22:50:42 UTC (rev 5268)
@@ -7,7 +7,7 @@
signature OBJECT_TYPE =
sig
- structure PointerTycon: POINTER_TYCON
+ structure ObjptrTycon: OBJPTR_TYCON
structure Runtime: RUNTIME
type ty
@@ -20,7 +20,7 @@
| Weak of ty (* in Weak t, must have Type.isPointer t *)
| WeakGone
- val basic: (PointerTycon.t * t) vector
+ val basic: unit -> (ObjptrTycon.t * t) vector
val isOk: t -> bool
val layout: t -> Layout.t
val toRuntime: t -> Runtime.RObjectType.t
Copied: mlton/branches/on-20050822-x86_64-branch/mlton/backend/objptr-tycon.fun (from rev 5147, mlton/branches/on-20050822-x86_64-branch/mlton/backend/pointer-tycon.fun)
===================================================================
--- mlton/branches/on-20050822-x86_64-branch/mlton/backend/pointer-tycon.fun 2007-02-06 17:01:55 UTC (rev 5147)
+++ mlton/branches/on-20050822-x86_64-branch/mlton/backend/objptr-tycon.fun 2007-02-19 22:50:42 UTC (rev 5268)
@@ -0,0 +1,63 @@
+(* Copyright (C) 2004-2005 Henry Cejtin, Matthew Fluet, Suresh
+ * Jagannathan, and Stephen Weeks.
+ *
+ * MLton is released under a BSD-style license.
+ * See the file MLton-LICENSE for details.
+ *)
+
+functor ObjptrTycon (S: OBJPTR_TYCON_STRUCTS): OBJPTR_TYCON =
+struct
+
+open S
+
+type int = Int.t
+
+datatype t = T of {index: int ref}
+
+local
+ fun make f (T r) = f r
+in
+ val index = ! o (make #index)
+end
+
+local
+ val c = Counter.new 0
+in
+ fun new () = T {index = ref (Counter.next c)}
+end
+
+fun setIndex (T {index = r}, i) = r := i
+
+fun fromIndex i = T {index = ref i}
+
+fun compare (opt, opt') = Int.compare (index opt, index opt')
+
+fun equals (opt, opt') = index opt = index opt'
+
+val op <= = fn (opt, opt') => index opt <= index opt'
+
+fun toString (opt: t): string =
+ concat ["opt_", Int.toString (index opt)]
+
+val layout = Layout.str o toString
+
+val stack = new ()
+val thread = new ()
+val weakGone = new ()
+
+local
+ val word8Vector = new ()
+ val word16Vector = new ()
+ val word32Vector = new ()
+ val word64Vector = new ()
+in
+ fun wordVector (b: Bits.t): t =
+ case Bits.toInt b of
+ 8 => word8Vector
+ | 16 => word16Vector
+ | 32 => word32Vector
+ | 64 => word64Vector
+ | _ => Error.bug "ObjptrTycon.wordVector"
+end
+
+end
Copied: mlton/branches/on-20050822-x86_64-branch/mlton/backend/objptr-tycon.sig (from rev 5147, mlton/branches/on-20050822-x86_64-branch/mlton/backend/pointer-tycon.sig)
===================================================================
--- mlton/branches/on-20050822-x86_64-branch/mlton/backend/pointer-tycon.sig 2007-02-06 17:01:55 UTC (rev 5147)
+++ mlton/branches/on-20050822-x86_64-branch/mlton/backend/objptr-tycon.sig 2007-02-19 22:50:42 UTC (rev 5268)
@@ -0,0 +1,35 @@
+(* Copyright (C) 2004-2005 Henry Cejtin, Matthew Fluet, Suresh
+ * Jagannathan, and Stephen Weeks.
+ *
+ * MLton is released under a BSD-style license.
+ * See the file MLton-LICENSE for details.
+ *)
+
+type int = Int.t
+
+signature OBJPTR_TYCON_STRUCTS =
+ sig
+ end
+
+signature OBJPTR_TYCON =
+ sig
+ include OBJPTR_TYCON_STRUCTS
+
+ type t
+
+ val <= : t * t -> bool
+ val compare: t * t -> Relation.t
+ val equals: t * t -> bool
+ val fromIndex: int -> t
+ val index: t -> int (* index into objectTypes array *)
+ val layout: t -> Layout.t
+ val new: unit -> t
+ val setIndex: t * int -> unit
+ val toString: t -> string
+
+ (* See gc/object.h. *)
+ val stack: t
+ val thread: t
+ val weakGone: t
+ val wordVector: Bits.t -> t
+ end
Modified: mlton/branches/on-20050822-x86_64-b
More information about the MLton-commit
mailing list