basis-library/mlton/pointer.sml

   1 (* Copyright (C) 2010 Matthew Fluet.
   2  * Copyright (C) 2003-2008 Henry Cejtin, Matthew Fluet, Suresh
   3  *    Jagannathan, and Stephen Weeks.
   4  *
   5  * MLton is released under a BSD-style license.
   6  * See the file MLton-LICENSE for details.
   7  *)
   8
   9 structure MLtonPointer: MLTON_POINTER_EXTRA =
  10 struct
  11
  12 open Primitive.MLton.Pointer
  13
  14 val sizeofPointer =
  15    Word.div (Word.fromInt C_Size.wordSize, 0w8)
  16
  17 val add = fn (p, t) =>
  18    add (p, C_Ptrdiff.fromLarge (Word.toLargeIntX t))
  19 val sub = fn (p, t) =>
  20    sub (p, C_Ptrdiff.fromLarge (Word.toLargeIntX t))
  21 val diff = fn (p, p') =>
  22    Word.fromLargeInt (C_Ptrdiff.toLarge (diff (p, p')))
  23
  24 local
  25    fun wrap f (p, i) =
  26       f (p, C_Ptrdiff.fromInt i)
  27 in
  28    val getCPointer = wrap getCPointer
  29    val getInt8 = wrap getInt8
  30    val getInt16 = wrap getInt16
  31    val getInt32 = wrap getInt32
  32    val getInt64 = wrap getInt64
  33    val getObjptr = fn (p, i) => (wrap getObjptr) (p, i)
  34    val getReal32 = wrap getReal32
  35    val getReal64 = wrap getReal64
  36    val getWord8 = wrap getWord8
  37    val getWord16 = wrap getWord16
  38    val getWord32 = wrap getWord32
  39    val getWord64 = wrap getWord64
  40 end
  41 val getPointer = getCPointer
  42
  43 local
  44    fun wrap f (p, i, x) =
  45       f (p, C_Ptrdiff.fromInt i, x)
  46 in
  47    val setCPointer = wrap setCPointer
  48    val setInt8 = wrap setInt8
  49    val setInt16 = wrap setInt16
  50    val setInt32 = wrap setInt32
  51    val setInt64 = wrap setInt64
  52    val setObjptr = fn (p, i, x) => (wrap setObjptr) (p, i, x)
  53    val setReal32 = wrap setReal32
  54    val setReal64 = wrap setReal64
  55    val setWord8 = wrap setWord8
  56    val setWord16 = wrap setWord16
  57    val setWord32 = wrap setWord32
  58    val setWord64 = wrap setWord64
  59 end
  60 val setPointer = setCPointer
  61
  62 end