X-Git-Url: http://wien.tomnetworks.com/gitweb/?a=blobdiff_plain;f=Mate%2FStrings.hs;h=2f7504ac2aa4a24daf2db17fb1081273b49004a9;hb=ccc1ff2921984cfd36595e935e3634842fa2cb7d;hp=f1762b0a5ae1e9790639b69857ebf9bc5e9f9e82;hpb=4c504fbb0b276782af6cd250e5e9fd4fdcc26967;p=mate.git diff --git a/Mate/Strings.hs b/Mate/Strings.hs index f1762b0..2f7504a 100644 --- a/Mate/Strings.hs +++ b/Mate/Strings.hs @@ -15,16 +15,17 @@ import Text.Printf import JVM.ClassFile -import Foreign.Ptr -import Foreign.Marshal.Utils -import Foreign.Marshal.Array +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 <- getStringMap case M.lookup str smap of @@ -34,15 +35,52 @@ getUniqueStringAddr str = do 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 | 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 "string: fsize: %d (should be 4 * 5)\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 "new str ptr: (%s)@%d\n" (toString str) strlen + + let newstr_length = castPtr newstr :: Ptr CPtrdiff + poke newstr_length $ fromIntegral strlen + + -- set value pointer + poke (plusPtr ptr 4) (fromIntegral (ptrToIntPtr newstr) :: CPtrdiff) + -- set count field + poke (plusPtr ptr 8) (fromIntegral strlen :: CPtrdiff) + -- set hash code (TODO) + poke (plusPtr ptr 12) (0 :: CPtrdiff) + -- set offset + poke (plusPtr ptr 16) (0 :: CPtrdiff) + + return $ fromIntegral tblptr