2 {-# LANGUAGE OverloadedStrings #-}
3 {-# LANGUAGE ForeignFunctionInterface #-}
10 import qualified Data.Map as M
11 import qualified Data.ByteString.Lazy as B
12 import qualified Data.ByteString.Internal as BI
18 import Foreign.Marshal.Utils
19 import Foreign.Marshal.Array
23 import Mate.GarbageAlloc
26 getUniqueStringAddr :: B.ByteString -> IO Word32
27 getUniqueStringAddr str = do
28 smap <- get_stringsmap >>= ptr2stringsmap
29 case M.lookup str smap of
31 addr <- allocateJavaString str
32 let smap' = M.insert str addr smap
33 stringsmap2ptr smap' >>= set_stringsmap
35 Just addr -> return addr
37 allocateJavaString :: B.ByteString -> IO Word32
38 allocateJavaString str = do
39 -- TODO(bernhard): is this also true for UTF8 stuff?
40 let strlen = fromIntegral $ B.length str
41 arr <- newArray $ ((map fromIntegral $ B.unpack str) :: [Word8])
43 newstr <- mallocString (strlen + 1)
44 BI.memset newstr 0 (fromIntegral $ strlen + 1)
45 copyBytes newstr arr strlen
46 let w32_ptr = fromIntegral $ ptrToIntPtr newstr
47 printfStr "new str ptr: 0x%08x (%s)@%d\n" w32_ptr (toString str) strlen