-{-# LANGUAGE CPP #-}
{-# LANGUAGE OverloadedStrings #-}
-#include "debug.h"
module Mate.Strings (
getUniqueStringAddr
) where
import qualified Data.Map as M
import qualified Data.ByteString.Lazy as B
import qualified Data.ByteString.Internal as BI
-#ifdef DEBUG
-import Text.Printf
-#endif
-import Foreign.Ptr
-import Foreign.Marshal.Utils
-import Foreign.Marshal.Array
+import JVM.ClassFile
+
+import Foreign
+import Foreign.C.Types
import Mate.Types
+import Mate.NativeSizes
+import Mate.ClassPool
import Mate.Debug
import Mate.GarbageAlloc
-getUniqueStringAddr :: B.ByteString -> IO Word32
+getUniqueStringAddr :: B.ByteString -> IO NativeWord
getUniqueStringAddr str = do
- smap <- get_stringsmap >>= ptr2stringsmap
+ smap <- getStringMap
case M.lookup str smap of
Nothing -> do
addr <- allocateJavaString str
- let smap' = M.insert str addr smap
- stringsmap2ptr smap' >>= set_stringsmap
+ setStringMap $ M.insert str addr smap
return addr
Just addr -> return addr
-allocateJavaString :: B.ByteString -> IO Word32
+allocateJavaString :: B.ByteString -> IO NativeWord
allocateJavaString str = do
- -- TODO(bernhard): is this also true for UTF8 stuff?
+ {- we have to build a java object layout here, where String object looks like
+ -
+ - this -+
+ - |
+ - v
+ - +-------------+---------+-------+-------+----------------+--------+
+ - | MethodTable | GC Data | value | count | cachedhashcode | offset |
+ - +-------------+---------+-------+-------+----------------+--------+
+ - | |
+ - | +--+
+ - v v
+ - java/lang/String +--------+--------+--------+-----+------------------+
+ - | length | str[0] | str[1] | ... | str [length - 1] |
+ - +--------+--------+--------+-----+------------------+
+ - all cells are 32bit wide, except str[i] of course (they're 8bit [but
+ - should be 16bit, TODO]).
+ -}
+ -- build object layout
+ fsize <- getObjectSize "java/lang/String"
+ printfStr $ printf "string: fsize: %d (should be 4 * 6)\n" fsize
+ tblptr <- mallocObjectUnmanaged $ fromIntegral fsize
+ let ptr = intPtrToPtr (fromIntegral tblptr) :: Ptr CPtrdiff
+ mtbl <- getMethodTable "java/lang/String"
+ poke ptr $ fromIntegral mtbl
+
+ -- build array layout
let strlen = fromIntegral $ B.length str
+ -- (+1) for \0, (+4) for length
+ newstr <- mallocStringUnmanaged (strlen + 5) --[TODO hs,bernhard: should be managed right?]
+ BI.memset newstr 0 (fromIntegral $ strlen + 5)
arr <- newArray ((map fromIntegral $ B.unpack str) :: [Word8])
- -- (+1) for \0
- newstr <- mallocString (strlen + 1)
- BI.memset newstr 0 (fromIntegral $ strlen + 1)
- copyBytes newstr arr strlen
- let w32_ptr = fromIntegral $ ptrToIntPtr newstr
- printfStr "new str ptr: 0x%08x (%s)@%d\n" w32_ptr (toString str) strlen
- return w32_ptr
+ copyBytes (plusPtr newstr 4) arr strlen
+ printfStr $ printf "new str ptr: (%s)@%d\n" (toString str) strlen
+
+ let newstr_length = castPtr newstr :: Ptr CPtrdiff
+ poke newstr_length $ fromIntegral strlen
+
+ -- set GC Data (TODO)
+ poke (plusPtr ptr 0x4) (0 :: CPtrdiff)
+ -- set value pointer
+ poke (plusPtr ptr 0x8) (fromIntegral (ptrToIntPtr newstr) :: CPtrdiff)
+ -- set count field
+ poke (plusPtr ptr 0xc) (fromIntegral strlen :: CPtrdiff)
+ -- set hash code (TODO)
+ poke (plusPtr ptr 0x10) (0 :: CPtrdiff)
+ -- set offset
+ poke (plusPtr ptr 0x14) (0 :: CPtrdiff)
+
+ return $ fromIntegral tblptr