[MLton] cvs commit: added MLton.Pointer

sweeks@mlton.org sweeks@mlton.org
Mon, 1 Dec 2003 10:22:21 -0800


sweeks      03/12/01 10:22:20

  Modified:    basis-library/libs build
               basis-library/libs/basis-2002/top-level basis.sig
               basis-library/misc C.sml primitive.sml
               basis-library/mlton ffi.sig mlton.sig mlton.sml
               basis-library/posix error.sml file-sys.sml primitive.sml
                        proc-env.sml
               include  c-chunk.h
               mlton/ast word-size.fun word-size.sig
               mlton/atoms prim.fun prim.sig
               mlton/backend machine-atoms.fun machine-atoms.sig
                        machine.fun representation.fun rssa.fun
                        signal-check.fun ssa-to-rssa.fun
               mlton/codegen/c-codegen c-codegen.fun
               mlton/codegen/x86-codegen x86-mlton.fun
               mlton/ssa ssa-tree.fun ssa-tree.sig
  Added:       basis-library/mlton pointer.sig pointer.sml
  Log:
  MAIL added MLton.Pointer
  
  Added structure MLton.Pointer.  It has all the operations I proposed
  in my earlier mail except for phantom types.  I didn't put those in
  because they can now be done in user programs because the FFI looks
  under opaque types.
  
  Added get and set functions at all the types Int{8,16,32,64},
  Real{32,64}, Word{8,16,32,64}.  I made them slightly more general than
  before, treating the pointer as an array and allowing an array
  offset.
  
  	val getInt32: t * int -> Int32.int
  	val setInt32: t * int * Int32.int -> unit
  
  So, if in C we have "int *a" where a points to some array, then in SML
  we can do
  
  	val a = _import "a": MLton.Pointer.t;
  	val _ = MLton.Pointer.getInt32 (a, 13)
  
  You can follow a pointer by using offset 0.
  
  Adding get* and set* required a family of new Pointer_ primitives in
  the compiler.  These are implemented in SsaToRssa, which is when the
  ArrayOffset operand is first introduced.
  
  I went ahead and implemented MLton.Pointer.t as Word32.word, which
  made it easy to do some stuff without adding more primitives.
  Eliminating the built in pointer type also let me remove some code
  from the compiler.  If we decide that we don't like having the
  knowledge of the word size of pointers in the basis library, then it
  will be easy enough to add a couple of primitives and the primitive
  type.  Although if we do, I would recommend replacing the primitive
  type in the front end with the appropriate word size instead of
  pushing it all the way to the backend as we used to.
  
  Eliminating the CPointer type from Rssa and Machine did create more
  places for type unsafety in those ILs since we now must allow unsafe
  pointer get and set on Word32s.  I don't know how much of a loss this
  really is.

Revision  Changes    Path
1.27      +2 -0      mlton/basis-library/libs/build

Index: build
===================================================================
RCS file: /cvsroot/mlton/mlton/basis-library/libs/build,v
retrieving revision 1.26
retrieving revision 1.27
diff -u -r1.26 -r1.27
--- build	16 Nov 2003 14:21:08 -0000	1.26
+++ build	1 Dec 2003 18:22:16 -0000	1.27
@@ -199,6 +199,8 @@
 mlton/int-inf.sig
 mlton/platform.sig
 mlton/platform.sml
+mlton/pointer.sig
+mlton/pointer.sml
 mlton/proc-env.sig
 mlton/proc-env.sml
 mlton/profile.sig



1.25      +0 -1      mlton/basis-library/libs/basis-2002/top-level/basis.sig

Index: basis.sig
===================================================================
RCS file: /cvsroot/mlton/mlton/basis-library/libs/basis-2002/top-level/basis.sig,v
retrieving revision 1.24
retrieving revision 1.25
diff -u -r1.24 -r1.25
--- basis.sig	24 Nov 2003 02:57:32 -0000	1.24
+++ basis.sig	1 Dec 2003 18:22:16 -0000	1.25
@@ -541,7 +541,6 @@
    where type exn = exn
    where type int = int
    where type order = order
-   where type MLton.pointer = MLton.pointer
    where type real = real
    where type string = string
    where type substring = substring



1.5       +1 -1      mlton/basis-library/misc/C.sml

Index: C.sml
===================================================================
RCS file: /cvsroot/mlton/mlton/basis-library/misc/C.sml,v
retrieving revision 1.4
retrieving revision 1.5
diff -u -r1.4 -r1.5
--- C.sml	23 Jun 2003 04:25:55 -0000	1.4
+++ C.sml	1 Dec 2003 18:22:17 -0000	1.5
@@ -57,7 +57,7 @@
 	 struct
 	    open Prim.CSS
 
-	    val length = makeLength (sub, Primitive.Cpointer.isNull)
+	    val length = makeLength (sub, Primitive.Pointer.isNull)
 
 	    val toArrayOfLength =
 	       fn (css, n) => toArrayOfLength (css, CS.toString o sub, n)



1.88      +42 -10    mlton/basis-library/misc/primitive.sml

Index: primitive.sml
===================================================================
RCS file: /cvsroot/mlton/mlton/basis-library/misc/primitive.sml,v
retrieving revision 1.87
retrieving revision 1.88
diff -u -r1.87 -r1.88
--- primitive.sml	29 Nov 2003 09:33:24 -0000	1.87
+++ primitive.sml	1 Dec 2003 18:22:17 -0000	1.88
@@ -52,7 +52,6 @@
    end
 structure LargeInt = IntInf
 datatype list = datatype list
-type pointer = pointer (* C integer, not SML heap pointer *)
 
 structure Real32 =
    struct
@@ -97,6 +96,11 @@
 type real = Real.real
 type word = Word.word
 
+structure Pointer =
+   struct
+      type t = Word32.word
+   end
+   
 exception Bind = Bind
 exception Fail of string
 exception Match = Match
@@ -150,7 +154,7 @@
 	    (* char* *)
 	    structure CS =
 	       struct
-		  type t = pointer
+		  type t = Pointer.t
 
 		  val sub = _import "C_CS_sub": t * int -> char;
 		  val update =
@@ -163,7 +167,7 @@
 	    (* char** *)
 	    structure CSS =
 	       struct
-		  type t = pointer
+		  type t = Pointer.t
 		     
 		  val sub = _import "C_CSS_sub": t * int -> CS.t;
 	       end
@@ -191,11 +195,6 @@
 	    val commandName = fn () => _import "CommandLine_commandName": cstring;
 	 end
 
-      structure Cpointer =
-	 struct
-	    val isNull = _prim "Cpointer_isNull": pointer -> bool;
-	 end
-
       structure Date =
 	 struct
 	    type time = int
@@ -265,7 +264,6 @@
 	    val getInt32 = _import "MLton_FFI_getInt32": int -> Int32.int;
 	    val getInt64 = _import "MLton_FFI_getInt64": int -> Int64.int;
 	    val getOp = _import "MLton_FFI_getOp": unit -> int;
-	    val getPointer = fn z => _prim "FFI_getPointer": int -> 'a; z
 	    val getReal32 = _import "MLton_FFI_getReal32": int -> Real32.real;
 	    val getReal64 = _import "MLton_FFI_getReal64": int -> Real64.real;
 	    val getWord8 = _import "MLton_FFI_getWord8": int -> Word8.word;
@@ -276,7 +274,6 @@
 	    val setInt16 = _import "MLton_FFI_setInt16": Int16.int -> unit;
 	    val setInt32 = _import "MLton_FFI_setInt32": Int32.int -> unit;
 	    val setInt64 = _import "MLton_FFI_setInt64": Int64.int -> unit;
-	    val setPointer = fn z => _prim "FFI_setPointer": 'a -> unit; z
 	    val setReal32 = _import "MLton_FFI_setReal32": Real32.real -> unit;
 	    val setReal64 = _import "MLton_FFI_setReal64": Real64.real -> unit;
   	    val setWord8 = _import "MLton_FFI_setWord8": Word8.word -> unit;
@@ -720,6 +717,41 @@
 	       _import "PackReal64_update": word8 array * int * real -> unit;
 	    val updateRev =
 	       _import "PackReal64_updateRev": word8 array * int * real -> unit;
+	 end
+
+      structure Pointer =
+	 struct
+	    open Pointer
+
+	    val null: t = 0w0
+	    fun isNull p = p = null
+
+	    val getInt8 = _prim "Pointer_getInt8": t * int -> Int8.int;
+	    val getInt16 = _prim "Pointer_getInt16": t * int -> Int16.int;
+	    val getInt32 = _prim "Pointer_getInt32": t * int -> Int32.int;
+	    val getInt64 = _prim "Pointer_getInt64": t * int -> Int64.int;
+	    val getReal32 = _prim "Pointer_getReal32": t * int -> Real32.real;
+	    val getReal64 = _prim "Pointer_getReal64": t * int -> Real64.real;
+	    val getWord8 = _prim "Pointer_getWord8": t * int -> Word8.word;
+	    val getWord16 = _prim "Pointer_getWord16": t * int -> Word16.word;
+	    val getWord32 = _prim "Pointer_getWord32": t * int -> Word32.word;
+	    val getWord64 = _prim "Pointer_getWord64": t * int -> Word64.word;
+	    val setInt8 = _prim "Pointer_setInt8": t * int * Int8.int -> unit;
+	    val setInt16 = _prim "Pointer_setInt16": t * int * Int16.int -> unit;
+	    val setInt32 = _prim "Pointer_setInt32": t * int * Int32.int -> unit;
+	    val setInt64 = _prim "Pointer_setInt64": t * int * Int64.int -> unit;
+	    val setReal32 =
+	       _prim "Pointer_setReal32": t * int * Real32.real -> unit;
+	    val setReal64 =
+	       _prim "Pointer_setReal64": t * int * Real64.real -> unit;
+  	    val setWord8 =
+	       _prim "Pointer_setWord8": t * int * Word8.word -> unit;
+	    val setWord16 =
+	       _prim "Pointer_setWord16": t * int * Word16.word -> unit;
+	    val setWord32 =
+	       _prim "Pointer_setWord32": t * int * Word32.word -> unit;
+	    val setWord64 =
+	       _prim "Pointer_setWord64": t * int * Word64.word -> unit;
 	 end
 
       structure Ptrace =



1.3       +0 -2      mlton/basis-library/mlton/ffi.sig

Index: ffi.sig
===================================================================
RCS file: /cvsroot/mlton/mlton/basis-library/mlton/ffi.sig,v
retrieving revision 1.2
retrieving revision 1.3
diff -u -r1.2 -r1.3
--- ffi.sig	24 Jun 2003 20:14:21 -0000	1.2
+++ ffi.sig	1 Dec 2003 18:22:17 -0000	1.3
@@ -8,7 +8,6 @@
       val getInt16: int -> Int16.int
       val getInt32: int -> Int32.int
       val getInt64: int -> Int64.int
-      val getPointer: int -> 'a
       val getReal32: int -> Real32.real
       val getReal64: int -> Real64.real
       val getWord8: int -> Word8.word
@@ -21,7 +20,6 @@
       val setInt16: Int16.int -> unit
       val setInt32: Int32.int -> unit
       val setInt64: Int64.int -> unit
-      val setPointer: 'a -> unit
       val setReal32: Real32.real -> unit
       val setReal64: Real64.real -> unit
       val setWord8: Word8.word -> unit



1.28      +1 -2      mlton/basis-library/mlton/mlton.sig

Index: mlton.sig
===================================================================
RCS file: /cvsroot/mlton/mlton/basis-library/mlton/mlton.sig,v
retrieving revision 1.27
retrieving revision 1.28
diff -u -r1.27 -r1.28
--- mlton.sig	26 Jun 2003 19:17:30 -0000	1.27
+++ mlton.sig	1 Dec 2003 18:22:17 -0000	1.28
@@ -10,8 +10,6 @@
    
 signature MLTON =
    sig
-      type pointer
-      
       val cleanAtExit: unit -> unit
 (*      val deserialize: Word8Vector.vector -> 'a *)
       (* Pointer equality.  The usual caveats about lack of a well-defined
@@ -33,6 +31,7 @@
       structure IntInf: MLTON_INT_INF
       structure Itimer: MLTON_ITIMER
       structure Platform: MLTON_PLATFORM
+      structure Pointer: MLTON_POINTER
       structure ProcEnv: MLTON_PROC_ENV
       structure Process: MLTON_PROCESS
       structure Profile: MLTON_PROFILE



1.28      +1 -0      mlton/basis-library/mlton/mlton.sml

Index: mlton.sml
===================================================================
RCS file: /cvsroot/mlton/mlton/basis-library/mlton/mlton.sml,v
retrieving revision 1.27
retrieving revision 1.28
diff -u -r1.27 -r1.28
--- mlton.sml	6 Sep 2003 19:42:43 -0000	1.27
+++ mlton.sml	1 Dec 2003 18:22:17 -0000	1.28
@@ -55,6 +55,7 @@
 structure IntInf = IntInf
 structure Itimer = MLtonItimer
 structure Platform = MLtonPlatform
+structure Pointer = MLtonPointer
 structure ProcEnv = MLtonProcEnv
 structure Process = MLtonProcess
 structure Ptrace = MLtonPtrace



1.1                  mlton/basis-library/mlton/pointer.sig

Index: pointer.sig
===================================================================
signature MLTON_POINTER =
   sig
      type t

      val add: t * word -> t
      val diff: t * t -> word
      val getInt8: t * int -> Int8.int
      val getInt16: t * int -> Int16.int
      val getInt32: t * int -> Int32.int
      val getInt64: t * int -> Int64.int
      val getReal32: t * int -> Real32.real
      val getReal64: t * int -> Real64.real
      val getWord8: t * int -> Word8.word
      val getWord16: t * int -> Word16.word
      val getWord32: t * int -> Word32.word
      val getWord64: t * int -> Word64.word
      val isNull: t -> bool
      val null: t
      val setInt8: t * int * Int8.int -> unit
      val setInt16: t * int * Int16.int -> unit
      val setInt32: t * int * Int32.int -> unit
      val setInt64: t * int * Int64.int -> unit
      val setReal32: t * int * Real32.real -> unit
      val setReal64: t * int * Real64.real -> unit
      val setWord8: t * int * Word8.word -> unit
      val setWord16: t * int * Word16.word -> unit
      val setWord32: t * int * Word32.word -> unit
      val setWord64: t * int * Word64.word -> unit
      val sub: t * word -> t
   end



1.1                  mlton/basis-library/mlton/pointer.sml

Index: pointer.sml
===================================================================
structure MLtonPointer: MLTON_POINTER =
struct

open Primitive.Pointer

val add = Word.+
val diff = Word.-
val sub = Word.-
   
end



1.4       +1 -1      mlton/basis-library/posix/error.sml

Index: error.sml
===================================================================
RCS file: /cvsroot/mlton/mlton/basis-library/posix/error.sml,v
retrieving revision 1.3
retrieving revision 1.4
diff -u -r1.3 -r1.4
--- error.sml	24 Nov 2002 01:19:39 -0000	1.3
+++ error.sml	1 Dec 2003 18:22:17 -0000	1.4
@@ -27,7 +27,7 @@
 
       fun errorMsg (n: int) =
 	 let val cs = strerror n
-	 in if Primitive.Cpointer.isNull cs
+	 in if Primitive.Pointer.isNull cs
 	       then "Unknown error"
 	    else C.CS.toString cs
 	 end



1.9       +3 -3      mlton/basis-library/posix/file-sys.sml

Index: file-sys.sml
===================================================================
RCS file: /cvsroot/mlton/mlton/basis-library/posix/file-sys.sml,v
retrieving revision 1.8
retrieving revision 1.9
diff -u -r1.8 -r1.9
--- file-sys.sml	25 Sep 2003 01:43:26 -0000	1.8
+++ file-sys.sml	1 Dec 2003 18:22:17 -0000	1.9
@@ -53,7 +53,7 @@
 	    
 	 fun opendir s =
 	    let val d = Prim.opendir (String.nullTerm s)
-	    in if Primitive.Cpointer.isNull d
+	    in if Primitive.Pointer.isNull d
 		  then Error.error ()
 	       else DS (ref (SOME d))
 	    end
@@ -65,7 +65,7 @@
 		  let
 		     val _ = Error.clearErrno ()
 		     val cs = Prim.readdir d
-		  in if Primitive.Cpointer.isNull cs
+		  in if Primitive.Pointer.isNull cs
 			then if Error.getErrno () = 0
 				then NONE
 			     else Error.error ()
@@ -118,7 +118,7 @@
 	 fun extract a = extractToChar (a, #"\000")
       in
 	 fun getcwd () =
-	    if Primitive.Cpointer.isNull (Prim.getcwd (!buffer, !size))
+	    if Primitive.Pointer.isNull (Prim.getcwd (!buffer, !size))
 	       then (size := 2 * !size
 		     ; buffer := make ()
 		     ; getcwd ())



1.17      +1 -1      mlton/basis-library/posix/primitive.sml

Index: primitive.sml
===================================================================
RCS file: /cvsroot/mlton/mlton/basis-library/posix/primitive.sml,v
retrieving revision 1.16
retrieving revision 1.17
diff -u -r1.16 -r1.17
--- primitive.sml	25 Sep 2003 01:43:26 -0000	1.16
+++ primitive.sml	1 Dec 2003 18:22:17 -0000	1.17
@@ -366,7 +366,7 @@
 
 	    structure Dirstream =
 	       struct
-		  type dirstream = pointer
+		  type dirstream = Pointer.t
 
 		  val closedir =
 		     _import "Posix_FileSys_Dirstream_closedir": dirstream -> int;



1.6       +3 -3      mlton/basis-library/posix/proc-env.sml

Index: proc-env.sml
===================================================================
RCS file: /cvsroot/mlton/mlton/basis-library/posix/proc-env.sml,v
retrieving revision 1.5
retrieving revision 1.6
diff -u -r1.5 -r1.6
--- proc-env.sml	22 Sep 2003 19:25:30 -0000	1.5
+++ proc-env.sml	1 Dec 2003 18:22:17 -0000	1.6
@@ -47,7 +47,7 @@
 
       fun getlogin () =
 	 let val cs = Prim.getlogin ()
-	 in if Primitive.Cpointer.isNull cs
+	 in if Primitive.Pointer.isNull cs
 	       then raise (Error.SysErr ("no login name", NONE))
 	    else CS.toString cs
 	 end
@@ -110,7 +110,7 @@
 
       fun getenv name =
 	 let val cs = Prim.getenv (String.nullTerm name)
-	 in if Primitive.Cpointer.isNull cs
+	 in if Primitive.Pointer.isNull cs
 	       then NONE
 	    else SOME (CS.toString cs)
 	 end
@@ -121,7 +121,7 @@
 
       fun ttyname (FD n) =
 	 let val cs = Prim.ttyname n
-	 in if Primitive.Cpointer.isNull cs
+	 in if Primitive.Pointer.isNull cs
 	       then Error.error ()
 	    else CS.toString cs
 	 end



1.17      +0 -6      mlton/include/c-chunk.h

Index: c-chunk.h
===================================================================
RCS file: /cvsroot/mlton/mlton/include/c-chunk.h,v
retrieving revision 1.16
retrieving revision 1.17
diff -u -r1.16 -r1.17
--- c-chunk.h	29 Nov 2003 09:33:24 -0000	1.16
+++ c-chunk.h	1 Dec 2003 18:22:17 -0000	1.17
@@ -197,12 +197,6 @@
 	} while (0)
 
 /* ------------------------------------------------- */
-/*                     Cpointer                      */
-/* ------------------------------------------------- */
-
-#define Cpointer_isNull(x) (NULL == (void*)(x))
-
-/* ------------------------------------------------- */
 /*                        Int                        */
 /* ------------------------------------------------- */
 



1.4       +2 -0      mlton/mlton/ast/word-size.fun

Index: word-size.fun
===================================================================
RCS file: /cvsroot/mlton/mlton/mlton/ast/word-size.fun,v
retrieving revision 1.3
retrieving revision 1.4
diff -u -r1.3 -r1.4
--- word-size.fun	13 Oct 2003 18:48:36 -0000	1.3
+++ word-size.fun	1 Dec 2003 18:22:18 -0000	1.4
@@ -9,6 +9,8 @@
 
 val default = W32
 
+fun pointer () = W32
+
 val max: t -> LargeWord.t =
    fn W8 => Word.toLarge 0wxFF
     | W16 => Word.toLarge 0wxFFFF



1.4       +1 -0      mlton/mlton/ast/word-size.sig

Index: word-size.sig
===================================================================
RCS file: /cvsroot/mlton/mlton/mlton/ast/word-size.sig,v
retrieving revision 1.3
retrieving revision 1.4
diff -u -r1.3 -r1.4
--- word-size.sig	13 Oct 2003 18:48:36 -0000	1.3
+++ word-size.sig	1 Dec 2003 18:22:18 -0000	1.4
@@ -19,6 +19,7 @@
       val equals: t * t -> bool
       val max: t -> LargeWord.t
       val memoize: (t -> 'a) -> t -> 'a
+      val pointer: unit -> t
       val size: t -> int
       val toString: t -> string
    end



1.66      +23 -9     mlton/mlton/atoms/prim.fun

Index: prim.fun
===================================================================
RCS file: /cvsroot/mlton/mlton/mlton/atoms/prim.fun,v
retrieving revision 1.65
retrieving revision 1.66
diff -u -r1.65 -r1.66
--- prim.fun	10 Oct 2003 00:01:31 -0000	1.65
+++ prim.fun	1 Dec 2003 18:22:18 -0000	1.66
@@ -46,7 +46,6 @@
        | Array_update (* backend *)
        | C_CS_charArrayToWord8Array (* type inference *)
        | Char_toWord8 (* type inference *)
-       | Cpointer_isNull (* codegen *)
        | Exn_extra (* implement exceptions *)
        | Exn_keepHistory (* a compile-time boolean *)
        | Exn_name (* implement exceptions *)
@@ -56,8 +55,6 @@
        | FFI of CFunction.t (* ssa to rssa *)
        | FFI_Symbol of {name: string,
 			ty: CType.t} (* codegen *)
-       | FFI_getPointer (* ssa to rssa *)
-       | FFI_setPointer (* ssa to rssa *)
        | GC_collect (* ssa to rssa *)
        | GC_pack (* ssa to rssa *)
        | GC_unpack (* ssa to rssa *)
@@ -123,6 +120,12 @@
        | MLton_serialize (* unused *)
        | MLton_size (* ssa to rssa *)
        | MLton_touch (* backend *)
+       | Pointer_getInt of IntSize.t (* backend *)
+       | Pointer_getReal of RealSize.t (* backend *)
+       | Pointer_getWord of WordSize.t (* backend *)
+       | Pointer_setInt of IntSize.t (* backend *)
+       | Pointer_setReal of RealSize.t (* backend *)
+       | Pointer_setWord of WordSize.t (* backend *)
        | Real_Math_acos of RealSize.t (* codegen *)
        | Real_Math_asin of RealSize.t (* codegen *)
        | Real_Math_atan of RealSize.t (* codegen *)
@@ -265,7 +268,7 @@
 	   (Int_subCheck, SideEffect, "subCheck")],
 	  fn (makeName, kind, str) =>
 	  (makeName s, kind, concat ["Int", IntSize.toString s, "_", str]))
-
+ 
       fun reals (s: RealSize.t) =
 	 List.map
 	 ([(Real_Math_acos, Functional, "Math_acos"),
@@ -336,15 +339,12 @@
 	  (C_CS_charArrayToWord8Array, DependsOnState,
 	   "C_CS_charArrayToWord8Array"),
 	  (Char_toWord8, Functional, "Char_toWord8"),
-	  (Cpointer_isNull, Functional, "Cpointer_isNull"),
 	  (Exn_extra, Functional, "Exn_extra"),
 	  (Exn_name, Functional, "Exn_name"),
 	  (Exn_setExtendExtra, SideEffect, "Exn_setExtendExtra"),
 	  (Exn_setInitExtra, SideEffect, "Exn_setInitExtra"),
 	  (Exn_setTopLevelHandler, SideEffect, "Exn_setTopLevelHandler"),
 	  (Exn_setTopLevelHandler, SideEffect, "Exn_setTopLevelHandler"),
-	  (FFI_getPointer, DependsOnState, "FFI_getPointer"),
-	  (FFI_setPointer, SideEffect, "FFI_setPointer"),
 	  (GC_collect, SideEffect, "GC_collect"),
 	  (GC_pack, SideEffect, "GC_pack"),
 	  (GC_unpack, SideEffect, "GC_unpack"),
@@ -436,6 +436,22 @@
 			   coerces (Word_toWord, word, word),
 			   coercesX (Word_toWordX, word, word)]
 	   end
+	@ let
+	     fun doit (name, all, toString, get, set) =
+		List.concatMap
+		(all, fn s =>
+		 [(get s, DependsOnState,
+		   concat ["Pointer_get", name, toString s]),
+		  (set s, SideEffect,
+		   concat ["Pointer_set", name, toString s])])
+	  in
+	     List.concat [doit ("Int", IntSize.all, IntSize.toString,
+				Pointer_getInt, Pointer_setInt),
+			  doit ("Real", RealSize.all, RealSize.toString,
+				Pointer_getReal, Pointer_setReal),
+			  doit ("Word", WordSize.all, WordSize.toString,
+				Pointer_getWord, Pointer_setWord)]
+	  end
 	 
       fun toString n =
 	 case n of
@@ -606,8 +622,6 @@
        | Exn_extra => one result
        | Exn_setExtendExtra => one (#2 (deArrow (arg 0)))
        | Exn_setInitExtra => one (arg 0)
-       | FFI_getPointer => one result
-       | FFI_setPointer => one (arg 0)
        | MLton_bogus => one result
        | MLton_deserialize => one result
        | MLton_eq => one (arg 0)



1.50      +6 -3      mlton/mlton/atoms/prim.sig

Index: prim.sig
===================================================================
RCS file: /cvsroot/mlton/mlton/mlton/atoms/prim.sig,v
retrieving revision 1.49
retrieving revision 1.50
diff -u -r1.49 -r1.50
--- prim.sig	10 Oct 2003 00:01:31 -0000	1.49
+++ prim.sig	1 Dec 2003 18:22:18 -0000	1.50
@@ -37,7 +37,6 @@
 	     | Array_update (* backend *)
 	     | C_CS_charArrayToWord8Array (* type inference *)
 	     | Char_toWord8 (* type inference *)
-	     | Cpointer_isNull (* codegen *)
 	     | Exn_extra (* implement exceptions *)
 	     | Exn_keepHistory (* a compile-time boolean *)
 	     | Exn_name (* implement exceptions *)
@@ -47,8 +46,6 @@
 	     | FFI of CFunction.t (* ssa to rssa *)
 	     | FFI_Symbol of {name: string,
 			      ty: CType.t} (* codegen *)
-	     | FFI_getPointer (* ssa to rssa *)
-	     | FFI_setPointer (* ssa to rssa *)
 	     | GC_collect (* ssa to rssa *)
 	     | GC_pack (* ssa to rssa *)
 	     | GC_unpack (* ssa to rssa *)
@@ -114,6 +111,12 @@
 	     | MLton_serialize (* unused *)
 	     | MLton_size (* ssa to rssa *)
 	     | MLton_touch (* backend *)
+	     | Pointer_getInt of IntSize.t (* backend *)
+	     | Pointer_getReal of RealSize.t (* backend *)
+	     | Pointer_getWord of WordSize.t (* backend *)
+	     | Pointer_setInt of IntSize.t (* backend *)
+	     | Pointer_setReal of RealSize.t (* backend *)
+	     | Pointer_setWord of WordSize.t (* backend *)
 	     | Real_Math_acos of RealSize.t (* codegen *)
 	     | Real_Math_asin of RealSize.t (* codegen *)
 	     | Real_Math_atan of RealSize.t (* codegen *)



1.11      +15 -21    mlton/mlton/backend/machine-atoms.fun

Index: machine-atoms.fun
===================================================================
RCS file: /cvsroot/mlton/mlton/mlton/backend/machine-atoms.fun,v
retrieving revision 1.10
retrieving revision 1.11
diff -u -r1.10 -r1.11
--- machine-atoms.fun	19 Jul 2003 01:23:26 -0000	1.10
+++ machine-atoms.fun	1 Dec 2003 18:22:18 -0000	1.11
@@ -55,8 +55,7 @@
 structure TypeAndMemChunk =
    struct
       datatype ty =
-	 CPointer
-       | EnumPointers of {enum: int vector,
+	 EnumPointers of {enum: int vector,
 			  pointers: PointerTycon.t vector}
        | ExnStack
        | Int of IntSize.t
@@ -76,8 +75,7 @@
 	    open Layout
 	 in
 	    case t of
-	       CPointer => str "cpointer"
-	     | EnumPointers {enum, pointers} => 
+	       EnumPointers {enum, pointers} => 
 		  if 0 = Vector.length enum
 		     andalso 1 = Vector.length pointers
 		     then PointerTycon.layout (Vector.sub (pointers, 0))
@@ -105,8 +103,7 @@
 
       fun equalsTy (t, t'): bool =
 	 case (t, t') of
-	    (CPointer, CPointer) => true
-	  | (EnumPointers {enum = e, pointers = p},
+	    (EnumPointers {enum = e, pointers = p},
 	     EnumPointers {enum = e', pointers = p'}) =>
 	       e = e'
 	       andalso (MLton.eq (p, p')
@@ -133,8 +130,7 @@
 	 val double: int = 8
       in
 	 val size =
-	    fn CPointer => word
-	     | EnumPointers _ => word
+	    fn EnumPointers _ => word
 	     | ExnStack => word
 	     | Int s => IntSize.bytes s
 	     | IntInf => word
@@ -146,8 +142,7 @@
 
       fun isOkTy (t: ty): bool =
 	 case t of
-	    CPointer => true
-	  | EnumPointers {enum, pointers} =>
+	    EnumPointers {enum, pointers} =>
 	       Vector.isSorted (enum, op <=)
 	       andalso Vector.isSorted (pointers, PointerTycon.<=)
 	       andalso (0 = Vector.length pointers
@@ -220,7 +215,7 @@
 
       val bool = EnumPointers {enum = Vector.new2 (0, 1),
 			       pointers = Vector.new0 ()}
-      val cpointer = CPointer
+      fun cPointer () = Word (WordSize.pointer ())
       val defaultInt = Int IntSize.default
       val defaultWord = Word WordSize.default
       val exnStack = ExnStack
@@ -230,6 +225,11 @@
       val real = Real
       val word = Word
 
+      fun isCPointer t =
+	 case t of
+	    Word s => WordSize.equals (s, WordSize.pointer ())
+	  | _ => false
+
       fun pointer pt =
 	 EnumPointers {enum = Vector.new0 (),
 		       pointers = Vector.new1 pt}
@@ -263,19 +263,18 @@
       in
 	 val fromCType: CType.t -> t =
 	    fn C.Int s => int s
-	     | C.Pointer => cpointer
+	     | C.Pointer => cPointer ()
 	     | C.Real s => real s
 	     | C.Word s => word s
 
 	 val toCType: t -> CType.t =
-	    fn CPointer => C.pointer
-	     | EnumPointers {enum, pointers} =>
+	    fn EnumPointers {enum, pointers} =>
 		  if 0 = Vector.length pointers
 		     then C.defaultInt
 		  else C.pointer
 	     | ExnStack => C.defaultWord
 	     | Int s => C.Int s
-	     | IntInf => C.Pointer
+	     | IntInf => C.pointer
 	     | Label _ => C.defaultWord
 	     | MemChunk _ => C.pointer
 	     | Real s => C.Real s
@@ -484,12 +483,7 @@
       andalso Type.size from = Type.size to
       andalso
       case from of
-	 CPointer =>
-	    (case to of
-		Int _ => true
-	      | Word _ => true
-	      | _ => false)
-       | EnumPointers (ep as {enum, pointers}) =>
+	 EnumPointers (ep as {enum, pointers}) =>
 	    (case to of
 		EnumPointers ep' => castEnumIsOk (ep, ep')
 	      | IntInf =>



1.13      +3 -3      mlton/mlton/backend/machine-atoms.sig

Index: machine-atoms.sig
===================================================================
RCS file: /cvsroot/mlton/mlton/mlton/backend/machine-atoms.sig,v
retrieving revision 1.12
retrieving revision 1.13
diff -u -r1.12 -r1.13
--- machine-atoms.sig	19 Jul 2003 01:23:26 -0000	1.12
+++ machine-atoms.sig	1 Dec 2003 18:22:18 -0000	1.13
@@ -54,12 +54,11 @@
       structure Type:
 	 sig
 	    datatype t =
-	       CPointer
 	     (* The ints in an enum are in increasing order without dups.
 	      * The pointers are in increasing order (of index in objectTypes
 	      * vector) without dups.
 	      *)
-	     | EnumPointers of {enum: int vector,
+	       EnumPointers of {enum: int vector,
 				pointers: PointerTycon.t vector}
 	     | ExnStack
 	     | Int of IntSize.t
@@ -72,7 +71,7 @@
 	    val align: t * int -> int       (* align an address *)
 	    val bool: t
 	    val containsPointer: t * PointerTycon.t -> bool
-	    val cpointer: t
+	    val cPointer: unit -> t
 	    val dePointer: t -> PointerTycon.t option
 	    val defaultInt: t
 	    val defaultWord: t
@@ -81,6 +80,7 @@
 	    val fromCType: CType.t -> t
 	    val int: IntSize.t -> t
 	    val intInf: t
+	    val isCPointer: t -> bool
 	    val isPointer: t -> bool
 	    val isReal: t -> bool
 	    val label: Label.t -> t



1.52      +7 -10     mlton/mlton/backend/machine.fun

Index: machine.fun
===================================================================
RCS file: /cvsroot/mlton/mlton/mlton/backend/machine.fun,v
retrieving revision 1.51
retrieving revision 1.52
diff -u -r1.51 -r1.52
--- machine.fun	19 Jul 2003 01:23:26 -0000	1.51
+++ machine.fun	1 Dec 2003 18:22:18 -0000	1.52
@@ -251,9 +251,9 @@
        fn ArrayOffset {ty, ...} => ty
 	| Cast (_, ty) => ty
 	| Contents {ty, ...} => ty
-	| File => Type.cpointer
+	| File => Type.cPointer ()
 	| Frontier => Type.defaultWord
-	| GCState => Type.cpointer
+	| GCState => Type.cPointer ()
 	| Global g => Global.ty g
 	| Int i => Type.int (IntX.size i)
 	| Label l => Type.label l
@@ -978,8 +978,7 @@
 				tyconTy = tyconTy}))
 		      | Contents {oper, ...} =>
 			   (checkOperand (oper, alloc)
-			    ; Type.equals (Operand.ty oper,
-					   Type.cpointer))
+			    ; Type.isCPointer (Operand.ty oper))
 		      | File => true
 		      | Frontier => true
 		      | GCState => true
@@ -1038,8 +1037,7 @@
 	       Type.equals (Operand.ty index, Type.defaultInt)
 	       andalso
 	       case Operand.ty base of
-		  Type.CPointer => true (* needed for card marking *)
-		| Type.EnumPointers {enum, pointers} =>
+		  Type.EnumPointers {enum, pointers} =>
 		     0 = Vector.length enum
 		     andalso
 		     Vector.forall
@@ -1062,7 +1060,7 @@
 					 Type.equals (ty', Type.word W8)))
 			    end
 		       | _ => false)
-		| _ => false
+		| t => Type.isCPointer t
 	    and offsetIsOk {base, offset, ty} =
 	       let
 		  fun memChunkIsOk (MemChunk.T {components, ...}) =
@@ -1074,8 +1072,7 @@
 				  
 	       in
 		  case Operand.ty base of
-		     Type.CPointer => true
-		   | Type.EnumPointers {enum, pointers} =>
+		     Type.EnumPointers {enum, pointers} =>
 			0 = Vector.length enum
 			andalso
 			((* Array_toVector header update. *)
@@ -1091,7 +1088,7 @@
 			     ObjectType.Normal m => memChunkIsOk m
 			   | _ => false))
 		   | Type.MemChunk m => memChunkIsOk m
-		   | _ => false
+		   | t => Type.isCPointer t
 	       end
 	    fun checkOperands (v, a) =
 	       Vector.foreach (v, fn z => checkOperand (z, a))



1.19      +0 -1      mlton/mlton/backend/representation.fun

Index: representation.fun
===================================================================
RCS file: /cvsroot/mlton/mlton/mlton/backend/representation.fun,v
retrieving revision 1.18
retrieving revision 1.19
diff -u -r1.18 -r1.19
--- representation.fun	9 Oct 2003 18:17:32 -0000	1.18
+++ representation.fun	1 Dec 2003 18:22:19 -0000	1.19
@@ -542,7 +542,6 @@
 	       | Datatype tycon => convertDatatype tycon
 	       | Int s => SOME (R.Type.int s)
 	       | IntInf => SOME R.Type.intInf
-	       | Pointer => SOME R.Type.cpointer
 	       | PreThread => SOME R.Type.thread
 	       | Real s => SOME (R.Type.real s)
 	       | Ref t =>



1.37      +4 -5      mlton/mlton/backend/rssa.fun

Index: rssa.fun
===================================================================
RCS file: /cvsroot/mlton/mlton/mlton/backend/rssa.fun,v
retrieving revision 1.36
retrieving revision 1.37
diff -u -r1.36 -r1.37
--- rssa.fun	12 Sep 2003 01:22:56 -0000	1.36
+++ rssa.fun	1 Dec 2003 18:22:19 -0000	1.37
@@ -61,8 +61,8 @@
 		   | Word8Vector _ => Type.word8Vector
 	       end
 	  | EnsuresBytesFree => Type.word WordSize.default
-	  | File => Type.cpointer
-	  | GCState => Type.cpointer
+	  | File => Type.cPointer ()
+	  | GCState => Type.cPointer ()
 	  | Line => Type.int IntSize.default
 	  | Offset {ty, ...} => ty
 	  | PointerTycon _ => Type.word WordSize.default
@@ -1057,8 +1057,7 @@
 		  Type.equals (Operand.ty index, Type.defaultInt)
 		  andalso
 		  case Operand.ty base of
-		     Type.CPointer => true (* needed for card marking *)
-		   | Type.EnumPointers {enum, pointers} =>
+		     Type.EnumPointers {enum, pointers} =>
 			0 = Vector.length enum
 			andalso
 			Vector.forall
@@ -1081,7 +1080,7 @@
 					    Type.equals (ty', Type.word W8)))
 			       end
 			  | _ => false)
-		   | _ => false
+		   | t => Type.isCPointer t
 	       end
 	    and offsetIsOk {base, offset, ty} =
 	       let



1.18      +3 -4      mlton/mlton/backend/signal-check.fun

Index: signal-check.fun
===================================================================
RCS file: /cvsroot/mlton/mlton/mlton/backend/signal-check.fun,v
retrieving revision 1.17
retrieving revision 1.18
diff -u -r1.17 -r1.18
--- signal-check.fun	23 Jun 2003 04:58:57 -0000	1.17
+++ signal-check.fun	1 Dec 2003 18:22:20 -0000	1.18
@@ -78,10 +78,9 @@
 	    val compare =
 	       Vector.new1
 	       (Statement.PrimApp
-		{args = Vector.new2 (Operand.Cast
-				     (Operand.Runtime Runtime.GCField.Limit,
-				      Type.defaultWord),
-				     Operand.word (WordX.zero WordSize.default)),
+		{args = (Vector.new2
+			 (Operand.Runtime Runtime.GCField.Limit,
+			  Operand.word (WordX.zero (WordSize.pointer ())))),
 		 dst = SOME (res, Type.bool),
 		 prim = Prim.eq})
 	    val compareTransfer =



1.52      +37 -36    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.51
retrieving revision 1.52
diff -u -r1.51 -r1.52
--- ssa-to-rssa.fun	29 Nov 2003 09:59:36 -0000	1.51
+++ ssa-to-rssa.fun	1 Dec 2003 18:22:20 -0000	1.52
@@ -844,8 +844,7 @@
 	    val c = Operand.Const
 	 in
 	    case t of
-	       Type.CPointer => Error.bug "bogus CPointer"
-	     | Type.EnumPointers (ep as {enum, ...})  =>
+	       Type.EnumPointers (ep as {enum, ...})  =>
 		  Operand.Cast (Operand.int (IntX.one IntSize.default), t)
 	     | Type.ExnStack => Error.bug "bogus ExnStack"
 	     | Type.Int s => c (Const.int (IntX.zero s))
@@ -1148,6 +1147,16 @@
 				end
 			else add (Move {dst = arrayOffset ty,
 					src = varOp (a 2)})
+		     fun pointerGet ty =
+			move (ArrayOffset {base = varOp (a 0),
+					   index = varOp (a 1),
+					   ty = ty})
+		     fun pointerSet ty =
+			add (Move {dst = ArrayOffset {base = varOp (a 0),
+						      index = varOp (a 1),
+						      ty = ty},
+				   src = varOp (a 2)})
+			      
 		     fun refAssign (ty, src) =
 		        let
 			   val addr = varOp (a 0)
@@ -1200,10 +1209,6 @@
 					NONE => none ()
 				      | SOME ty => arrayUpdate ty)
 			       | FFI f => simpleCCall f
-			       | FFI_getPointer =>
-				    simpleCCall CFunction.getPointer
-			       | FFI_setPointer =>
-				    simpleCCall CFunction.setPointer
 			       | GC_collect =>
 				    ccall
 				    {args = (Vector.new5
@@ -1312,6 +1317,12 @@
 					NONE => move (Operand.bool true)
 				      | SOME _ => normal ())
 			       | MLton_size => simpleCCall CFunction.size
+			       | Pointer_getInt s => pointerGet (Type.Int s)
+			       | Pointer_getReal s => pointerGet (Type.Real s)
+			       | Pointer_getWord s => pointerGet (Type.Word s)
+			       | Pointer_setInt s => pointerSet (Type.Int s)
+			       | Pointer_setReal s => pointerSet (Type.Real s)
+			       | Pointer_setWord s => pointerSet (Type.Word s)
 			       | Ref_assign =>
 				    (case targ () of
 					NONE => none ()
@@ -1337,34 +1348,26 @@
 				    split
 				    (Vector.new0 (), Kind.Jump, ss, fn l =>
 				     let
-					fun doit (dst, prim, a, b) =
-					   let
-					      val tmp = Var.newNoname ()
-					   in
-					      Vector.new2
-					      (Statement.PrimApp
-					       {args = Vector.new2 (a, b),
-						dst = SOME (tmp,
-							    Type.defaultWord),
-						prim = prim},
-					       Statement.Move
-					       {dst = (Operand.Cast
-						       (Operand.Runtime dst,
-							Type.defaultWord)),
-						src = (Operand.Var
-						       {var = tmp,
-							ty = Type.defaultWord})})
-					   end
 					datatype z = datatype GCField.t
+					val tmp = Var.newNoname ()
+					val size = WordSize.pointer ()
+					val ty = Type.cPointer ()
 					val statements =
-					   doit (Limit,
-						 Prim.wordSub WordSize.default,
-						 Operand.Runtime LimitPlusSlop,
-						 Operand.word
-						 (WordX.make
-						  (LargeWord.fromInt
-						   Runtime.limitSlop,
-						   WordSize.default)))
+					   Vector.new2
+					   (Statement.PrimApp
+					    {args = (Vector.new2
+						     (Operand.Runtime LimitPlusSlop,
+						      Operand.word
+						      (WordX.make
+						       (LargeWord.fromInt
+							Runtime.limitSlop,
+							size)))),
+					     dst = SOME (tmp, ty),
+					     prim = Prim.wordSub size},
+					    Statement.Move
+					    {dst = Operand.Runtime Limit,
+					     src = Operand.Var {var = tmp,
+								ty = ty}})
 					val l' =
 					   newBlock
 					   {args = Vector.new0 (),
@@ -1394,12 +1397,10 @@
 					val statements =
 					   Vector.new1
 					   (Statement.Move
-					    {dst = (Operand.Cast
-						    (Operand.Runtime Limit,
-						     Type.defaultWord)),
+					    {dst = Operand.Runtime Limit,
 					     src =
 					     Operand.word
-					     (WordX.zero WordSize.default)})
+					     (WordX.zero (WordSize.pointer ()))})
 					val l'' =
 					   newBlock
 					   {args = Vector.new0 (),



1.71      +1 -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.70
retrieving revision 1.71
diff -u -r1.70 -r1.71
--- c-codegen.fun	29 Nov 2003 09:33:24 -0000	1.70
+++ c-codegen.fun	1 Dec 2003 18:22:20 -0000	1.71
@@ -422,8 +422,7 @@
       in
 	 fun toC (t: t): string =
 	    case t of
-	       CPointer => pointer
-	     | EnumPointers {pointers, ...} =>
+	       EnumPointers {pointers, ...} =>
 		  if 0 = Vector.length pointers
 		     then int I32
 		  else pointer



1.53      +1 -20     mlton/mlton/codegen/x86-codegen/x86-mlton.fun

Index: x86-mlton.fun
===================================================================
RCS file: /cvsroot/mlton/mlton/mlton/codegen/x86-codegen/x86-mlton.fun,v
retrieving revision 1.52
retrieving revision 1.53
diff -u -r1.52 -r1.53
--- x86-mlton.fun	21 Oct 2003 19:00:41 -0000	1.52
+++ x86-mlton.fun	1 Dec 2003 18:22:20 -0000	1.53
@@ -632,26 +632,7 @@
 	AppendList.appends
 	[comment_begin,
 	 (case Prim.name prim of
-	       Cpointer_isNull 
-	     => let
-		  val (dst,dstsize) = getDst1 ()
-		  val (src,srcsize) = getSrc1 ()
-		in
-		  AppendList.fromList
-		  [Block.mkBlock'
-		   {entry = NONE,
-		    statements 
-		    = [Assembly.instruction_cmp
-		       {src1 = src,
-			src2 = Operand.immediate_const_int 0,
-			size = srcsize},
-		       Assembly.instruction_setcc
-		       {condition = Instruction.E,
-			dst = dst,
-			size = dstsize}],
-		    transfer = NONE}]
-		end
-	     | FFI_Symbol {name, ...}
+	     FFI_Symbol {name, ...}
 	     => let
 		   val (dst,dstsize) = getDst1 ()
 		   val memloc



1.61      +0 -3      mlton/mlton/ssa/ssa-tree.fun

Index: ssa-tree.fun
===================================================================
RCS file: /cvsroot/mlton/mlton/mlton/ssa/ssa-tree.fun,v
retrieving revision 1.60
retrieving revision 1.61
diff -u -r1.60 -r1.61
--- ssa-tree.fun	9 Oct 2003 18:17:34 -0000	1.60
+++ ssa-tree.fun	1 Dec 2003 18:22:20 -0000	1.61
@@ -29,7 +29,6 @@
 	| Datatype of Tycon.t
 	| Int of IntSize.t
 	| IntInf
-	| Pointer
 	| PreThread
 	| Real of RealSize.t
 	| Ref of t
@@ -58,7 +57,6 @@
 	    @ List.map (Tycon.ints, fn (t, s) =>
 			(t, nullary (Int s)))
 	    @ [(Tycon.intInf, nullary IntInf),
-	       (Tycon.pointer, nullary Pointer),
 	       (Tycon.preThread, nullary PreThread)]
 	    @ List.map (Tycon.reals, fn (t, s) =>
 			(t, nullary (Real s)))
@@ -94,7 +92,6 @@
 	       | Datatype t => Tycon.layout t
 	       | Int s => str (concat ["int", IntSize.toString s])
 	       | IntInf => str "IntInf.int"
-	       | Pointer => str "pointer"
 	       | PreThread => str "preThread"
 	       | Real s => str (concat ["real", RealSize.toString s])
 	       | Ref t => seq [layout t, str " ref"]



1.49      +0 -1      mlton/mlton/ssa/ssa-tree.sig

Index: ssa-tree.sig
===================================================================
RCS file: /cvsroot/mlton/mlton/mlton/ssa/ssa-tree.sig,v
retrieving revision 1.48
retrieving revision 1.49
diff -u -r1.48 -r1.49
--- ssa-tree.sig	23 Jun 2003 04:58:59 -0000	1.48
+++ ssa-tree.sig	1 Dec 2003 18:22:20 -0000	1.49
@@ -65,7 +65,6 @@
 	     | Datatype of Tycon.t
 	     | Int of IntSize.t
 	     | IntInf
-	     | Pointer
 	     | PreThread
 	     | Real of RealSize.t
 	     | Ref of t