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 Foreign.Ptr
  17 import Foreign.Marshal.Utils
  18 import Foreign.Marshal.Array
  19
  20 import Mate.Types
  21 import Mate.Debug
  22 import Mate.GarbageAlloc
  23
  24
  25 getUniqueStringAddr :: B.ByteString -> IO Word32
  26 getUniqueStringAddr str = do
  27   smap <- get_stringsmap >>= ptr2stringsmap
  28   case M.lookup str smap of
  29     Nothing -> do
  30       addr <- allocateJavaString str
  31       let smap' = M.insert str addr smap
  32       stringsmap2ptr smap' >>= set_stringsmap
  33       return addr
  34     Just addr -> return addr
  35
  36 allocateJavaString :: B.ByteString -> IO Word32
  37 allocateJavaString str = do
  38   -- TODO(bernhard): is this also true for UTF8 stuff?
  39   let strlen = fromIntegral $ B.length str
  40   arr <- newArray ((map fromIntegral $ B.unpack str) :: [Word8])
  41   -- (+1) for \0
  42   newstr <- mallocString (strlen + 1)
  43   BI.memset newstr 0 (fromIntegral $ strlen + 1)
  44   copyBytes newstr arr strlen
  45   let w32_ptr = fromIntegral $ ptrToIntPtr newstr
  46   printfStr "new str ptr: 0x%08x (%s)@%d\n" w32_ptr (toString str) strlen
  47   return w32_ptr