lib/mlnlffi-lib/memory/memalloc-unix.sml

   1 (* memalloc-unix.sml
   2  * 2005 Matthew Fluet (mfluet@acm.org)
   3  *  Adapted for MLton.
   4  *)
   5
   6 (* memalloc-a4-unix.sml
   7  *
   8  *   Memory allocation (via malloc) for Unix.
   9  *   Size of address: 4 bytes.
  10  *
  11  * Copyright (c) 2004 by The Fellowship of SML/NJ
  12  *
  13  * Author: Matthias Blume (blume@tti-c.org)
  14  *)
  15 structure CMemAlloc : CMEMALLOC = struct
  16
  17     exception OutOfMemory
  18
  19     structure Ptr = MLton.Pointer
  20
  21     type addr = Ptr.t
  22     type addr' = addr
  23
  24 (*
  25     structure DL = DynLinkage
  26
  27     fun main's s = DL.lib_symbol (DL.main_lib, s)
  28     val malloc_h = main's "malloc"
  29     val free_h = main's "free"
  30
  31     fun sys_malloc (n : C_Size.word) =
  32         let val w_p = _import * : MLton.Pointer.t -> C_Size.word -> addr;
  33             val a = w_p (DL.addr malloc_h) n
  34         in if a = Ptr.null then raise OutOfMemory else a
  35         end
  36
  37     fun sys_free (a : addr) =
  38         let val p_u = _import * : MLton.Pointer.t -> addr -> unit;
  39         in p_u (DL.addr free_h) a
  40         end
  41 *)
  42
  43     fun sys_malloc (n : C_Size.word) =
  44         let val w_p = _import "malloc" : C_Size.word -> addr;
  45             val a = w_p n
  46         in if a = Ptr.null then raise OutOfMemory else a
  47         end
  48
  49     fun sys_free (a : addr) =
  50         let val p_u = _import "free" : addr -> unit;
  51         in p_u a
  52         end
  53
  54     fun alloc bytes = sys_malloc (C_Size.fromLarge (Word.toLarge bytes))
  55     fun free a = sys_free a
  56 end