1 {-# LANGUAGE OverloadedStrings #-}
7 import qualified Data.Map as M
8 import qualified Data.ByteString.Lazy as B
9 import qualified Data.ByteString.Internal as BI
14 import Foreign.C.Types
17 import Mate.NativeSizes
20 import Mate.GarbageAlloc
23 getUniqueStringAddr :: B.ByteString -> IO NativeWord
24 getUniqueStringAddr str = do
26 case M.lookup str smap of
28 addr <- allocateJavaString str
29 setStringMap $ M.insert str addr smap
31 Just addr -> return addr
33 allocateJavaString :: B.ByteString -> IO NativeWord
34 allocateJavaString str = do
35 {- we have to build a java object layout here, where String object looks like
40 - +-------------+---------+-------+-------+----------------+--------+
41 - | MethodTable | GC Data | value | count | cachedhashcode | offset |
42 - +-------------+---------+-------+-------+----------------+--------+
46 - java/lang/String +--------+--------+--------+-----+------------------+
47 - | length | str[0] | str[1] | ... | str [length - 1] |
48 - +--------+--------+--------+-----+------------------+
49 - all cells are 32bit wide, except str[i] of course (they're 8bit [but
50 - should be 16bit, TODO]).
52 -- build object layout
53 fsize <- getObjectSize "java/lang/String"
54 printfStr $ printf "string: fsize: %d (should be 4 * 6)\n" fsize
55 tblptr <- mallocObjectUnmanaged $ fromIntegral fsize
56 let ptr = intPtrToPtr (fromIntegral tblptr) :: Ptr CPtrdiff
57 mtbl <- getMethodTable "java/lang/String"
58 poke ptr $ fromIntegral mtbl
61 let strlen = fromIntegral $ B.length str
62 -- (+1) for \0, (+4) for length
63 newstr <- mallocStringUnmanaged (strlen + 5) --[TODO hs,bernhard: should be managed right?]
64 BI.memset newstr 0 (fromIntegral $ strlen + 5)
65 arr <- newArray ((map fromIntegral $ B.unpack str) :: [Word8])
66 copyBytes (plusPtr newstr 4) arr strlen
67 printfStr $ printf "new str ptr: (%s)@%d\n" (toString str) strlen
69 let newstr_length = castPtr newstr :: Ptr CPtrdiff
70 poke newstr_length $ fromIntegral strlen
73 poke (plusPtr ptr 0x4) (0 :: CPtrdiff)
75 poke (plusPtr ptr 0x8) (fromIntegral (ptrToIntPtr newstr) :: CPtrdiff)
77 poke (plusPtr ptr 0xc) (fromIntegral strlen :: CPtrdiff)
78 -- set hash code (TODO)
79 poke (plusPtr ptr 0x10) (0 :: CPtrdiff)
81 poke (plusPtr ptr 0x14) (0 :: CPtrdiff)
83 return $ fromIntegral tblptr