Mate/Strings.hs

   1 {-# LANGUAGE OverloadedStrings #-}
   2 module Mate.Strings (
   3   getUniqueStringAddr
   4   ) where
   5
   6 import Data.Word
   7 import qualified Data.Map as M
   8 import qualified Data.ByteString.Lazy as B
   9 import qualified Data.ByteString.Internal as BI
  10
  11 import JVM.ClassFile
  12
  13 import Foreign
  14 import Foreign.C.Types
  15
  16 import Mate.Types
  17 import Mate.NativeSizes
  18 import Mate.ClassPool
  19 import Mate.Debug
  20 import Mate.GarbageAlloc
  21
  22
  23 getUniqueStringAddr :: B.ByteString -> IO NativeWord
  24 getUniqueStringAddr str = do
  25   smap <- getStringMap
  26   case M.lookup str smap of
  27     Nothing -> do
  28       addr <- allocateJavaString str
  29       setStringMap $ M.insert str addr smap
  30       return addr
  31     Just addr -> return addr
  32
  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
  36    -
  37    -  this -+
  38    -        |
  39    -        v
  40    -  +-------------+---------+-------+-------+----------------+--------+
  41    -  | MethodTable | GC Data | value | count | cachedhashcode | offset |
  42    -  +-------------+---------+-------+-------+----------------+--------+
  43    -        |                     |
  44    -        |                     +--+
  45    -        v                        v
  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]).
  51    -}
  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
  59
  60   -- build array layout
  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
  68
  69   let newstr_length = castPtr newstr :: Ptr CPtrdiff
  70   poke newstr_length $ fromIntegral strlen
  71
  72   -- set GC Data (TODO)
  73   poke (plusPtr ptr 0x4) (0 :: CPtrdiff)
  74   -- set value pointer
  75   poke (plusPtr ptr 0x8) (fromIntegral (ptrToIntPtr newstr) :: CPtrdiff)
  76   -- set count field
  77   poke (plusPtr ptr 0xc) (fromIntegral strlen :: CPtrdiff)
  78   -- set hash code (TODO)
  79   poke (plusPtr ptr 0x10) (0 :: CPtrdiff)
  80   -- set offset
  81   poke (plusPtr ptr 0x14) (0 :: CPtrdiff)
  82
  83   return $ fromIntegral tblptr