X-Git-Url: http://wien.tomnetworks.com/gitweb/?a=blobdiff_plain;f=Mate%2FStrings.hs;h=254adb2283628f8e65d255d0f605350c5cc3dd7e;hb=d52e9acb9411a9d8386ec95aa9952edb950c65b2;hp=74a0e1765ac13302428da694bc44970b18b7d58c;hpb=b3427c38e5e0b38e44df820e03cabf91613be1ce;p=mate.git

diff --git a/Mate/Strings.hs b/Mate/Strings.hs
index 74a0e17..254adb2 100644
--- a/Mate/Strings.hs
+++ b/Mate/Strings.hs
@@ -1,6 +1,4 @@
-{-# LANGUAGE CPP #-}
 {-# LANGUAGE OverloadedStrings #-}
-#include "debug.h"
 module Mate.Strings (
   getUniqueStringAddr
   ) where
@@ -9,39 +7,77 @@ import Data.Word
 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