Mate/Strings.hs

   1 {-# LANGUAGE CPP #-}
   2 {-# LANGUAGE OverloadedStrings #-}
   3 {-# LANGUAGE ForeignFunctionInterface #-}
   4 #include "debug.h"
   5 module Mate.Strings (
   6   getUniqueStringAddr
   7   ) where
   8
   9 import Data.Word
  10 import qualified Data.Map as M
  11 import qualified Data.ByteString.Lazy as B
  12 import qualified Data.ByteString.Internal as BI
  13 #ifdef DEBUG
  14 import Text.Printf
  15 #endif
  16
  17 import Foreign.Ptr
  18 import Foreign.Marshal.Alloc
  19 import Foreign.Marshal.Utils
  20 import Foreign.Marshal.Array
  21
  22 import Mate.Types
  23 import Mate.Debug
  24
  25
  26 getUniqueStringAddr :: B.ByteString -> IO Word32
  27 getUniqueStringAddr str = do
  28   smap <- get_stringsmap >>= ptr2stringsmap
  29   case M.lookup str smap of
  30     Nothing -> do
  31       addr <- allocateJavaString str
  32       let smap' = M.insert str addr smap
  33       stringsmap2ptr smap' >>= set_stringsmap
  34       return addr
  35     Just addr -> return addr
  36
  37 allocateJavaString :: B.ByteString -> IO Word32
  38 allocateJavaString str = do
  39   -- TODO(bernhard): is this also true for UTF8 stuff?
  40   let strlen = fromIntegral $ B.length str
  41   arr <- newArray $ ((map fromIntegral $ B.unpack str) :: [Word8])
  42   -- (+1) for \0
  43   newstr <- mallocBytes (strlen + 1)
  44   BI.memset newstr 0 (fromIntegral $ strlen + 1)
  45   copyBytes newstr arr strlen
  46   let w32_ptr = fromIntegral $ ptrToIntPtr newstr
  47   printf_str "new str ptr: 0x%08x (%s)@%d\n" w32_ptr (toString str) strlen
  48   return w32_ptr