Mate/Strings.hs

   1 {-# LANGUAGE CPP #-}
   2 {-# LANGUAGE OverloadedStrings #-}
   3 #include "debug.h"
   4 module Mate.Strings (
   5   getUniqueStringAddr
   6   ) where
   7
   8 import Data.Word
   9 import qualified Data.Map as M
  10 import qualified Data.ByteString.Lazy as B
  11 import qualified Data.ByteString.Internal as BI
  12 #ifdef DEBUG
  13 import Text.Printf
  14 #endif
  15
  16 import JVM.ClassFile
  17
  18 import Foreign
  19 import Foreign.C.Types
  20
  21 import Mate.Types
  22 import Mate.NativeSizes
  23 import Mate.ClassPool
  24 import Mate.Debug
  25 import Mate.GarbageAlloc
  26
  27
  28 getUniqueStringAddr :: B.ByteString -> IO NativeWord
  29 getUniqueStringAddr str = do
  30   smap <- getStringMap
  31   case M.lookup str smap of
  32     Nothing -> do
  33       addr <- allocateJavaString str
  34       setStringMap $ M.insert str addr smap
  35       return addr
  36     Just addr -> return addr
  37
  38 allocateJavaString :: B.ByteString -> IO NativeWord
  39 allocateJavaString str = do
  40   {- we have to build a java object layout here, where String object looks like
  41    -
  42    -  this -+
  43    -        |
  44    -        v
  45    -  +-------------+-------+-------+----------------+--------+
  46    -  | MethodTable | value | count | cachedhashcode | offset |
  47    -  +-------------+-------+-------+----------------+--------+
  48    -        |           |
  49    -        |           +------------+
  50    -        v                        v
  51    -  java/lang/String           +--------+--------+--------+-----+------------------+
  52    -                             | length | str[0] | str[1] | ... | str [length - 1] |
  53    -                             +--------+--------+--------+-----+------------------+
  54    -  all cells are 32bit wide, except str[i] of course (they're 8bit [but
  55    -  should be 16bit, TODO]).
  56    -}
  57   -- build object layout
  58   fsize <- getObjectSize "java/lang/String"
  59   printfStr "string: fsize: %d (should be 4 * 5)\n" fsize
  60   tblptr <- mallocObjectUnmanaged $ fromIntegral fsize
  61   let ptr = intPtrToPtr (fromIntegral tblptr) :: Ptr CPtrdiff
  62   mtbl <- getMethodTable "java/lang/String"
  63   poke ptr $ fromIntegral mtbl
  64
  65   -- build array layout
  66   let strlen = fromIntegral $ B.length str
  67   -- (+1) for \0, (+4) for length
  68   newstr <- mallocStringUnmanaged (strlen + 5) --[TODO hs,bernhard: should be managed right?]
  69   BI.memset newstr 0 (fromIntegral $ strlen + 5)
  70   arr <- newArray ((map fromIntegral $ B.unpack str) :: [Word8])
  71   copyBytes (plusPtr newstr 4) arr strlen
  72   printfStr "new str ptr: (%s)@%d\n" (toString str) strlen
  73
  74   let newstr_length = castPtr newstr :: Ptr CPtrdiff
  75   poke newstr_length $ fromIntegral strlen
  76
  77   -- set value pointer
  78   poke (plusPtr ptr 4) (fromIntegral (ptrToIntPtr newstr) :: CPtrdiff)
  79   -- set count field
  80   poke (plusPtr ptr 8) (fromIntegral strlen :: CPtrdiff)
  81   -- set hash code (TODO)
  82   poke (plusPtr ptr 12) (0 :: CPtrdiff)
  83   -- set offset
  84   poke (plusPtr ptr 16) (0 :: CPtrdiff)
  85
  86   return $ fromIntegral tblptr