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 <- getStringMap
  28   case M.lookup str smap of
  29     Nothing -> do
  30       addr <- allocateJavaString str
  31       setStringMap $ M.insert str addr smap
  32       return addr
  33     Just addr -> return addr
  34
  35 allocateJavaString :: B.ByteString -> IO Word32
  36 allocateJavaString str = do
  37   -- TODO(bernhard): is this also true for UTF8 stuff?
  38   let strlen = fromIntegral $ B.length str
  39   arr <- newArray ((map fromIntegral $ B.unpack str) :: [Word8])
  40   -- (+1) for \0
  41   newstr <- mallocString (strlen + 1)
  42   BI.memset newstr 0 (fromIntegral $ strlen + 1)
  43   copyBytes newstr arr strlen
  44   let w32_ptr = fromIntegral $ ptrToIntPtr newstr
  45   printfStr "new str ptr: 0x%08x (%s)@%d\n" w32_ptr (toString str) strlen
  46   return w32_ptr