Home My Page Projects Code Snippets Project Openings 3D graphics for Standard ML
Summary Activity SCM

SCM Repository

[sml3d] View of /trunk/sml3d/src/raw-data/c-alloc.sml
ViewVC logotype

View of /trunk/sml3d/src/raw-data/c-alloc.sml

Parent Directory Parent Directory | Revision Log Revision Log


Revision 659 - (download) (annotate)
Sat Jan 2 04:50:37 2010 UTC (10 years ago) by jhr
File size: 5452 byte(s)
  Factor out support for low-level C data into separate library.  This library
  is used by both the OpenCL and OpenGL libraries.
(* c-alloc.sml
 *
 * COPYRIGHT (c) 2008 John Reppy (http://www.cs.uchicago.edu/~jhr)
 * All rights reserved.
 *
 * Support for managing data in the C heap.  We provide both an interface
 * to malloc/free and support for traced pointers.
 *)

signature C_ALLOC =
  sig

  (* C pointer type *)
    type c_pointer = MLton.Pointer.t

    exception NoMemory
    exception FreeObject

  (* allocate an object; raise Size on 0 and NoMemory if it cannot
   * allocate memory.
   *)
    val malloc : C_Size.word -> c_pointer

  (* free an object *)
    val free : c_pointer -> unit

  (* a handle on a C allocated memory object *)
    type c_object

  (* allocate/delete an object *)
    val new : C_Size.word -> c_object
    val delete : c_object -> unit

  (* return the result of applying the second argument to the pointer to
   * the first argument.  If the object has been freed, then the FreeObject
   * exception is raised.
   *)
    val withCObj : (c_object * (c_pointer -> 'a)) -> 'a

  (* explicit reference counting operations on C objects.  If a C object is
   * passed to a C function that keeps it in some data structure, then its
   * count needs to be recorded.
   *)
    val retain : c_object -> c_pointer
    val release : c_object -> unit

 (* operations lifted from MLton.Pointer *)
    val getInt8 : c_object * int -> Int8.int
    val getInt16 : c_object * int -> Int16.int
    val getInt32 : c_object * int -> Int32.int
    val getInt64 : c_object * int -> Int64.int
    val getReal32 : c_object * int -> Real32.real
    val getReal64 : c_object * int -> Real64.real
    val getWord8 : c_object * int -> Word8.word
    val getWord16 : c_object * int -> Word16.word
    val getWord32 : c_object * int -> Word32.word
    val getWord64 : c_object * int -> Word64.word

    val setInt8 : c_object * int * Int8.int -> unit
    val setInt16 : c_object * int * Int16.int -> unit
    val setInt32 : c_object * int * Int32.int -> unit
    val setInt64 : c_object * int * Int64.int -> unit
    val setReal32 : c_object * int * Real32.real -> unit
    val setReal64 : c_object * int * Real64.real -> unit
    val setWord8 : c_object * int * Word8.word -> unit
    val setWord16 : c_object * int * Word16.word -> unit
    val setWord32 : c_object * int * Word32.word -> unit
    val setWord64 : c_object * int * Word64.word -> unit

  end

structure CAlloc :> C_ALLOC = struct

    structure Ptr = MLton.Pointer
    structure Final = MLton.Finalizable

  (* C pointer type *)
    type c_pointer = MLton.Pointer.t

    type c_object = {cnt : int ref, data : c_pointer ref} Final.t

  (* C memory allocation functions.  Note that on MinGW, these functions use
   * the "cdecl" calling convention.
   *)
    val primMalloc = _import "malloc" cdecl : C_Size.word -> Ptr.t;
    val primFree = _import "free" cdecl : Ptr.t -> unit;

    exception NoMemory
    exception FreeObject

    fun malloc 0w0 = raise Size
      | malloc sz = let
	  val ptr = primMalloc sz
	  in
	    if Ptr.null = ptr
	      then raise NoMemory
	      else ptr
	  end

    fun free ptr = if (Ptr.null = ptr) then () else primFree ptr

    fun freeMem {cnt, data} = if (!cnt > 0) orelse (Ptr.null = !data)
	  then raise FreeObject
	  else (primFree(!data); data := Ptr.null)

    fun delete obj = Final.withValue (obj, freeMem)

    fun new sz = let
	  val obj = Final.new {cnt = ref 0, data = ref(malloc sz)}
	  in
	    Final.addFinalizer (obj, freeMem);
	    obj
	  end

    fun withCObj (obj, f) = let
	  fun f' {cnt, data = ref ptr} = if (Ptr.null = ptr) then raise FreeObject else f ptr
	  in
	    Final.withValue(obj, f')
	  end

  (* explicit reference counting operations on C objects.  If a C object is
   * passed to a C function that keeps it in some data structure, then its
   * count needs to be recorded.
   *)
    fun retain cObj = Final.withValue (cObj, fn {cnt, data} => (cnt := !cnt + 1; !data))
    fun release cObj = Final.withValue (cObj, fn {cnt, data} => cnt := !cnt - 1)

    fun getInt8 (obj, i) = withCObj(obj, fn p => Ptr.getInt8(p, i))
    fun getInt16 (obj, i) = withCObj(obj, fn p => Ptr.getInt16(p, i))
    fun getInt32 (obj, i) = withCObj(obj, fn p => Ptr.getInt32(p, i))
    fun getInt64 (obj, i) = withCObj(obj, fn p => Ptr.getInt64(p, i))
    fun getReal32 (obj, i) = withCObj(obj, fn p => Ptr.getReal32(p, i))
    fun getReal64 (obj, i) = withCObj(obj, fn p => Ptr.getReal64(p, i))
    fun getWord8 (obj, i) = withCObj(obj, fn p => Ptr.getWord8(p, i))
    fun getWord16 (obj, i) = withCObj(obj, fn p => Ptr.getWord16(p, i))
    fun getWord32 (obj, i) = withCObj(obj, fn p => Ptr.getWord32(p, i))
    fun getWord64 (obj, i) = withCObj(obj, fn p => Ptr.getWord64(p, i))

    fun setInt8 (obj, i, v) = withCObj(obj, fn p => Ptr.setInt8(p, i, v))
    fun setInt16 (obj, i, v) = withCObj(obj, fn p => Ptr.setInt16(p, i, v))
    fun setInt32 (obj, i, v) = withCObj(obj, fn p => Ptr.setInt32(p, i, v))
    fun setInt64 (obj, i, v) = withCObj(obj, fn p => Ptr.setInt64(p, i, v))
    fun setReal32 (obj, i, v) = withCObj(obj, fn p => Ptr.setReal32(p, i, v))
    fun setReal64 (obj, i, v) = withCObj(obj, fn p => Ptr.setReal64(p, i, v))
    fun setWord8 (obj, i, v) = withCObj(obj, fn p => Ptr.setWord8(p, i, v))
    fun setWord16 (obj, i, v) = withCObj(obj, fn p => Ptr.setWord16(p, i, v))
    fun setWord32 (obj, i, v) = withCObj(obj, fn p => Ptr.setWord32(p, i, v))
    fun setWord64 (obj, i, v) = withCObj(obj, fn p => Ptr.setWord64(p, i, v))

  end

root@smlnj-gforge.cs.uchicago.edu
ViewVC Help
Powered by ViewVC 1.0.0