module MMalloc ( attach, sync, detach, maxkeys, setkey, getkey, mmalloc,
                 mrealloc, mcalloc, mfree, mmemalign, mvalloc, mmcheck, mmstats ) where
import Posix
import PosixUtil	-- need this for fdToInt - why ?
import StdDIS
import PosixDIS

%#include <mmalloc.h>
%#include <assert.h>

newtype MallocDescriptor = MallocDescriptor Addr
%dis mallocDescriptor x = MallocDescriptor (addr x)

type SizeT = Int
%dis sizeT x = int x

type Alignment = Int
%dis alignment x = int x

data Stats = Stats { bytesTotal, chunksUsed, bytesUsed, chunksFree, bytesFree :: SizeT }

%dis stats s =
%   declare {struct mstats} s in
%   Stats (sizeT {%s.bytes_total}) (sizeT {%s.chunks_used}) (sizeT {%s.bytes_used}) (sizeT {%s.chunks_free}) (sizeT {%s.bytes_free})

%prefix mmalloc_

-- possibly we should use mmalloc_errno, but the mmalloc info says "This function is not yet implemented"
%C const char* mmalloc_strerror(void* md) {
%     return "mmalloc: error";
%  }

---the main interface-------------------------------------------------------------------------------------------------
%fun mmalloc_attach :: Fd -> Addr -> IO MallocDescriptor
%code void* res1 = mmalloc_attach(arg1, arg2);
%fail { res1 == 0 } { "mmalloc: could not attach" }
%result (mallocDescriptor {res1})

%fun mmalloc_sync :: MallocDescriptor -> IO ()
%code void* res1 = mmalloc_sync(arg1);
%fail { res1 != 0 } { mmalloc_strerror(arg1) }

%fun mmalloc_detach :: MallocDescriptor -> IO ()
%code void* res1 = mmalloc_detach(arg1);
%fail { res1 != 0 } { mmalloc_strerror(arg1) }

%fun maxkeys :: Int
%code ;
%result (int {MMALLOC_KEYS})

%fun mmalloc_setkey :: MallocDescriptor -> Int -> Addr -> IO ()
%code int res1;
%     assert(0 <= arg2 && arg2 < MMALLOC_KEYS);
%     res1 = mmalloc_setkey(arg1, arg2, arg3);
%fail { res1 == 0 } { mmalloc_strerror(arg1) }

%fun mmalloc_getkey :: MallocDescriptor -> Int -> IO Addr
%code void* res1 = mmalloc_getkey(arg1, arg2);
%     assert(0 <= arg2 && arg2 < MMALLOC_KEYS);
%     res1 = mmalloc_getkey(arg1, arg2);
%fail { res1 == 0 } { mmalloc_strerror(arg1) }
%result (addr {res1})

%fun mmalloc :: MallocDescriptor -> SizeT -> IO Addr
%code void* res1 = mmalloc(arg1, arg2);
%fail { res1 == 0 } { mmalloc_strerror(arg1) }
%result (addr {res1})

%fun mrealloc :: MallocDescriptor -> Addr -> SizeT -> IO Addr
%code void* res1 = mmalloc_setkey(arg1, arg2, arg3);
%fail { res1 == 0 } { mmalloc_strerror(arg1) }
%result (addr {res1})

%fun mcalloc :: MallocDescriptor -> Int -> SizeT -> IO Addr
%code void* res1 = mcalloc(arg1, arg2, arg3);
%fail { res1 == 0 } { mmalloc_strerror(arg1) }
%result (addr {res1})

%fun mfree :: MallocDescriptor -> Addr -> IO ()

%fun mmemalign :: MallocDescriptor -> Alignment -> SizeT -> IO Addr
%code void* res1 = mmemalign(arg1, arg2, arg3);
%fail { res1 == 0 } { mmalloc_strerror(arg1) }

%fun mvalloc :: MallocDescriptor -> SizeT -> IO Addr
%code void* res1 = mvalloc(arg1, arg2);
%fail { res1 == 0 } { mmalloc_strerror(arg1) }

---more obscure stuff-------------------------------------------------------------------------------------------------
-- /* Activate a standard collection of debugging hooks.  */
%fun mmcheck :: MallocDescriptor -> Addr -> IO ()
%code int res1 = mmcheck(arg1, arg2);
%fail { res1 == 0 } { mmalloc_strerror(arg1) }

-- /* Pick up the current statistics. (see FIXME elsewhere) */
%fun mmstats :: MallocDescriptor -> IO Stats

-- not yet implemented by mmalloc (circa 1996)
-- int mmalloc_errno (void *md);
-- int mmtrace (void);