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
22 import Mate.NativeSizes
25 import Mate.GarbageAlloc
28 getUniqueStringAddr :: B.ByteString -> IO NativeWord
29 getUniqueStringAddr str = do
31 case M.lookup str smap of
33 addr <- allocateJavaString str
34 setStringMap $ M.insert str addr smap
36 Just addr -> return addr
38 allocateJavaString :: B.ByteString -> IO NativeWord
39 allocateJavaString str = do
40 {- we have to build a java object layout here, where String object looks like
45 - +-------------+-------+-------+----------------+--------+
46 - | MethodTable | value | count | cachedhashcode | offset |
47 - +-------------+-------+-------+----------------+--------+
51 - java/lang/String +--------+--------+--------+-----+------------------+
52 - | length | str[0] | str[1] | ... | str [length - 1] |
53 - +--------+--------+--------+-----+------------------+
54 - all cells are 32bit wide, except str[i] of course (they're 8bit [but
55 - should be 16bit, TODO]).
57 -- build object layout
58 fsize <- getObjectSize "java/lang/String"
59 printfStr "string: fsize: %d (should be 4 * 5)\n" fsize
60 tblptr <- mallocObjectUnmanaged $ fromIntegral fsize
61 let ptr = intPtrToPtr (fromIntegral tblptr) :: Ptr CPtrdiff
62 mtbl <- getMethodTable "java/lang/String"
63 poke ptr $ fromIntegral mtbl
66 let strlen = fromIntegral $ B.length str
67 -- (+1) for \0, (+4) for length
68 newstr <- mallocStringUnmanaged (strlen + 5) --[TODO hs,bernhard: should be managed right?]
69 BI.memset newstr 0 (fromIntegral $ strlen + 5)
70 arr <- newArray ((map fromIntegral $ B.unpack str) :: [Word8])
71 copyBytes (plusPtr newstr 4) arr strlen
72 printfStr "new str ptr: (%s)@%d\n" (toString str) strlen
74 let newstr_length = castPtr newstr :: Ptr CPtrdiff
75 poke newstr_length $ fromIntegral strlen
78 poke (plusPtr ptr 4) (fromIntegral (ptrToIntPtr newstr) :: CPtrdiff)
80 poke (plusPtr ptr 8) (fromIntegral strlen :: CPtrdiff)
81 -- set hash code (TODO)
82 poke (plusPtr ptr 12) (0 :: CPtrdiff)
84 poke (plusPtr ptr 16) (0 :: CPtrdiff)
86 return $ fromIntegral tblptr