2 {-# LANGUAGE OverloadedStrings #-}
9 import qualified Data.Map as M
10 import qualified Data.ByteString.Lazy as B
11 import qualified Data.ByteString.Internal as BI
19 import Foreign.C.Types
24 import Mate.GarbageAlloc
27 getUniqueStringAddr :: B.ByteString -> IO Word32
28 getUniqueStringAddr str = do
30 case M.lookup str smap of
32 addr <- allocateJavaString str
33 setStringMap $ M.insert str addr smap
35 Just addr -> return addr
37 allocateJavaString :: B.ByteString -> IO Word32
38 allocateJavaString str = do
39 {- we have to build a java object layout here, where String object looks like
44 - +-------------+-------+-------+----------------+--------+
45 - | MethodTable | value | count | cachedhashcode | offset |
46 - +-------------+-------+-------+----------------+--------+
50 - java/lang/String +--------+--------+--------+-----+------------------+
51 - | length | str[0] | str[1] | ... | str [length - 1] |
52 - +--------+--------+--------+-----+------------------+
53 - all cells are 32bit wide, except str[i] of course (they're 8bit [but
54 - should be 16bit, TODO]).
56 -- build object layout
57 fsize <- getObjectSize "java/lang/String"
58 printfStr "string: fsize: %d (should be 4 * 5)\n" fsize
59 tblptr <- mallocObject $ fromIntegral fsize
60 let ptr = intPtrToPtr (fromIntegral tblptr) :: Ptr CUInt
61 mtbl <- getMethodTable "java/lang/String"
62 poke ptr $ fromIntegral mtbl
65 let strlen = (fromIntegral $ B.length str)
66 -- (+1) for \0, (+4) for length
67 newstr <- mallocString (strlen + 5)
68 BI.memset newstr 0 (fromIntegral $ strlen + 5)
69 arr <- newArray ((map fromIntegral $ B.unpack str) :: [Word8])
70 copyBytes (plusPtr newstr 4) arr strlen
71 printfStr "new str ptr: (%s)@%d\n" (toString str) strlen
73 let newstr_length = castPtr newstr :: Ptr CUInt
74 poke newstr_length $ fromIntegral strlen
77 poke (plusPtr ptr 4) (fromIntegral (ptrToIntPtr newstr) :: CUInt)
79 poke (plusPtr ptr 8) (fromIntegral strlen :: CUInt)
80 -- set hash code (TODO)
81 poke (plusPtr ptr 12) (0 :: CUInt)
83 poke (plusPtr ptr 16) (0 :: CUInt)
85 return $ fromIntegral tblptr