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.ClassPool
  23 import Mate.Debug
  24 import Mate.GarbageAlloc
  25
  26
  27 getUniqueStringAddr :: B.ByteString -> IO Word32
  28 getUniqueStringAddr str = do
  29   smap <- getStringMap
  30   case M.lookup str smap of
  31     Nothing -> do
  32       addr <- allocateJavaString str
  33       setStringMap $ M.insert str addr smap
  34       return addr
  35     Just addr -> return addr
  36
  37 allocateJavaString :: B.ByteString -> IO Word32
  38 allocateJavaString str = do
  39   {- we have to build a java object layout here, where String object looks like
  40    -
  41    -  this -+
  42    -        |
  43    -        v
  44    -  +-------------+-------+-------+----------------+--------+
  45    -  | MethodTable | value | count | cachedhashcode | offset |
  46    -  +-------------+-------+-------+----------------+--------+
  47    -        |           |
  48    -        |           +------------+
  49    -        v                        v
  50    -  java/lang/String           +--------+--------+--------+-----+------------------+
  51    -                             | length | str[0] | str[1] | ... | str [length - 1] |
  52    -                             +--------+--------+--------+-----+------------------+
  53    -  all cells are 32bit wide, except str[i] of course (they're 8bit [but
  54    -  should be 16bit, TODO]).
  55    -}
  56   -- build object layout
  57   fsize <- getObjectSize "java/lang/String"
  58   printfStr "string: fsize: %d (should be 4 * 5)\n" fsize
  59   tblptr <- mallocObject $ fromIntegral fsize
  60   let ptr = intPtrToPtr (fromIntegral tblptr) :: Ptr CPtrdiff
  61   mtbl <- getMethodTable "java/lang/String"
  62   poke ptr $ fromIntegral mtbl
  63
  64   -- build array layout
  65   let strlen = fromIntegral $ B.length str
  66   -- (+1) for \0, (+4) for length
  67   newstr <- mallocString (strlen + 5)
  68   BI.memset newstr 0 (fromIntegral $ strlen + 5)
  69   arr <- newArray ((map fromIntegral $ B.unpack str) :: [Word8])
  70   copyBytes (plusPtr newstr 4) arr strlen
  71   printfStr "new str ptr: (%s)@%d\n" (toString str) strlen
  72
  73   let newstr_length = castPtr newstr :: Ptr CPtrdiff
  74   poke newstr_length $ fromIntegral strlen
  75
  76   -- set value pointer
  77   poke (plusPtr ptr 4) (fromIntegral (ptrToIntPtr newstr) :: CPtrdiff)
  78   -- set count field
  79   poke (plusPtr ptr 8) (fromIntegral strlen :: CPtrdiff)
  80   -- set hash code (TODO)
  81   poke (plusPtr ptr 12) (0 :: CPtrdiff)
  82   -- set offset
  83   poke (plusPtr ptr 16) (0 :: CPtrdiff)
  84
  85   return $ fromIntegral tblptr