also use ptrSize in ClassPool
-- TODO(bernhard): correct sizes for different types...
let fsize = fromIntegral $ M.size $ ciFieldMap ci
-- one slot for "method-table-ptr"
-- TODO(bernhard): correct sizes for different types...
let fsize = fromIntegral $ M.size $ ciFieldMap ci
-- one slot for "method-table-ptr"
- return $ (1 + fsize) * ptrSize
+ -- one slot for GC-data
+ return $ (2 + fsize) * ptrSize
getStaticFieldAddr :: CPtrdiff -> IO CPtrdiff
getStaticFieldAddr from = do
getStaticFieldAddr :: CPtrdiff -> IO CPtrdiff
getStaticFieldAddr from = do
-- TODO(bernhard): we have some duplicates in immap (i.e. some
-- entries have the same offset), so we could
-- save some memory here.
-- TODO(bernhard): we have some duplicates in immap (i.e. some
-- entries have the same offset), so we could
-- save some memory here.
- iftable <- mallocClassData ((4*) $ M.size immap)
+ iftable <- mallocClassData ((ptrSize*) $ M.size immap)
let wn_iftable = fromIntegral $ ptrToIntPtr iftable :: NativeWord
-- store interface-table at offset 0 in method-table
pokeElemOff (intPtrToPtr $ fromIntegral mbase) 0 wn_iftable
let wn_iftable = fromIntegral $ ptrToIntPtr iftable :: NativeWord
-- store interface-table at offset 0 in method-table
pokeElemOff (intPtrToPtr $ fromIntegral mbase) 0 wn_iftable
-- load map again, because there could be new entries now
-- due to loading superinterfaces
imap' <- getInterfaceMap
-- load map again, because there could be new entries now
-- due to loading superinterfaces
imap' <- getInterfaceMap
- let max_off = fromIntegral $ M.size immap * 4
+ let max_off = fromIntegral $ M.size immap * ptrSize
-- create index of methods by this interface
let mm = zipbase max_off (classMethods cfile)
-- create index of methods by this interface
let mm = zipbase max_off (classMethods cfile)
setInterfaceMethodMap $ M.fromList sm `M.union` M.fromList mm `M.union` immap
setInterfaceMap $ M.insert path cfile imap'
where
setInterfaceMethodMap $ M.fromList sm `M.union` M.fromList mm `M.union` immap
setInterfaceMap $ M.insert path cfile imap'
where
- zipbase base = zipWith (\x y -> (entry y, x + base)) [0,4..]
+ zipbase base = zipWith (\x y -> (entry y, x + base)) [0,ptrSize..]
entry = getname path
getname p y = p `B.append` methodName y `B.append` encode (methodSignature y)
entry = getname path
getname p y = p `B.append` methodName y `B.append` encode (methodSignature y)
let (sfields, ifields) = partition (S.member ACC_STATIC . fieldAccessFlags) (classFields cf)
let sc_sm = getsupermap superclass ciStaticMap
let (sfields, ifields) = partition (S.member ACC_STATIC . fieldAccessFlags) (classFields cf)
let sc_sm = getsupermap superclass ciStaticMap
- staticbase <- mallocClassData $ fromIntegral (length sfields) * 4
+ staticbase <- mallocClassData $ fromIntegral (length sfields) * ptrSize
let sm = zipbase (fromIntegral $ ptrToIntPtr staticbase) sfields
-- new fields "overwrite" old ones, if they have the same name
let staticmap = sm `M.union` sc_sm
let sc_im = getsupermap superclass ciFieldMap
let sm = zipbase (fromIntegral $ ptrToIntPtr staticbase) sfields
-- new fields "overwrite" old ones, if they have the same name
let staticmap = sm `M.union` sc_sm
let sc_im = getsupermap superclass ciFieldMap
- -- "+ 4" for the method table pointer
- let max_off = (4+) $ fromIntegral $ M.size sc_im * 4
+ -- "+ (2*ptrsize)" for the method table pointer and GC data
+ let max_off = (+ (2*ptrSize)) $ fromIntegral $ M.size sc_im * ptrSize
let im = zipbase max_off ifields
-- new fields "overwrite" old ones, if they have the same name
let fieldmap = im `M.union` sc_im
let im = zipbase max_off ifields
-- new fields "overwrite" old ones, if they have the same name
let fieldmap = im `M.union` sc_im
return (staticmap, fieldmap)
where
zipbase :: Int32 -> [Field Direct] -> FieldMap
return (staticmap, fieldmap)
where
zipbase :: Int32 -> [Field Direct] -> FieldMap
- zipbase base = foldr (\(x,y) -> M.insert (fieldName y) (x + base)) M.empty . zip [0,4..]
+ zipbase base = foldr (\(x,y) -> M.insert (fieldName y) (x + base)) M.empty . zip [0,ptrSize..]
-- helper
getsupermap :: Maybe ClassInfo -> (ClassInfo -> FieldMap) -> FieldMap
-- helper
getsupermap :: Maybe ClassInfo -> (ClassInfo -> FieldMap) -> FieldMap
((/=) "<init>" . methodName) x)
(classMethods cf)
let sc_mm = getsupermap superclass ciMethodMap
((/=) "<init>" . methodName) x)
(classMethods cf)
let sc_mm = getsupermap superclass ciMethodMap
- let max_off = fromIntegral $ M.size sc_mm * 4
+ let max_off = fromIntegral $ M.size sc_mm * ptrSize
let mm = zipbase max_off methods
let methodmap = M.fromList mm `M.union` sc_mm
-- (+1): one slot for the interface-table-ptr
let mm = zipbase max_off methods
let methodmap = M.fromList mm `M.union` sc_mm
-- (+1): one slot for the interface-table-ptr
- methodbase <- mallocClassData (((+1) $ fromIntegral $ M.size methodmap) * 4)
+ methodbase <- mallocClassData (((+1) $ fromIntegral $ M.size methodmap) * ptrSize)
return (methodmap, fromIntegral $ ptrToIntPtr methodbase)
return (methodmap, fromIntegral $ ptrToIntPtr methodbase)
- where zipbase base = zipWith (\x y -> (entry y, x + base)) [0,4..]
+ where zipbase base = zipWith (\x y -> (entry y, x + base)) [0,ptrSize..]
where entry y = methodName y `B.append` encode (methodSignature y)
where entry y = methodName y `B.append` encode (methodSignature y)
-ptrSize, longSize :: NativeWord
+ptrSize, longSize :: Num a => a
#if defined(ARCH_X86)
ptrSize = 4
longSize = 8
#if defined(ARCH_X86)
ptrSize = 4
longSize = 8
- - +-------------+-------+-------+----------------+--------+
- - | MethodTable | value | count | cachedhashcode | offset |
- - +-------------+-------+-------+----------------+--------+
- - | |
- - | +------------+
+ - +-------------+---------+-------+-------+----------------+--------+
+ - | MethodTable | GC Data | value | count | cachedhashcode | offset |
+ - +-------------+---------+-------+-------+----------------+--------+
+ - | |
+ - | +--+
- v v
- java/lang/String +--------+--------+--------+-----+------------------+
- | length | str[0] | str[1] | ... | str [length - 1] |
- v v
- java/lang/String +--------+--------+--------+-----+------------------+
- | length | str[0] | str[1] | ... | str [length - 1] |
-}
-- build object layout
fsize <- getObjectSize "java/lang/String"
-}
-- build object layout
fsize <- getObjectSize "java/lang/String"
- printfStr $ printf "string: fsize: %d (should be 4 * 5)\n" fsize
+ printfStr $ printf "string: fsize: %d (should be 4 * 6)\n" fsize
tblptr <- mallocObjectUnmanaged $ fromIntegral fsize
let ptr = intPtrToPtr (fromIntegral tblptr) :: Ptr CPtrdiff
mtbl <- getMethodTable "java/lang/String"
tblptr <- mallocObjectUnmanaged $ fromIntegral fsize
let ptr = intPtrToPtr (fromIntegral tblptr) :: Ptr CPtrdiff
mtbl <- getMethodTable "java/lang/String"
let newstr_length = castPtr newstr :: Ptr CPtrdiff
poke newstr_length $ fromIntegral strlen
let newstr_length = castPtr newstr :: Ptr CPtrdiff
poke newstr_length $ fromIntegral strlen
+ -- set GC Data (TODO)
+ poke (plusPtr ptr 0x4) (0 :: CPtrdiff)
- poke (plusPtr ptr 4) (fromIntegral (ptrToIntPtr newstr) :: CPtrdiff)
+ poke (plusPtr ptr 0x8) (fromIntegral (ptrToIntPtr newstr) :: CPtrdiff)
- poke (plusPtr ptr 8) (fromIntegral strlen :: CPtrdiff)
+ poke (plusPtr ptr 0xc) (fromIntegral strlen :: CPtrdiff)
- poke (plusPtr ptr 12) (0 :: CPtrdiff)
+ poke (plusPtr ptr 0x10) (0 :: CPtrdiff)
- poke (plusPtr ptr 16) (0 :: CPtrdiff)
+ poke (plusPtr ptr 0x14) (0 :: CPtrdiff)
return $ fromIntegral tblptr
return $ fromIntegral tblptr
import qualified Data.Map as M
import qualified Data.ByteString.Lazy as B
import Control.Monad
import qualified Data.Map as M
import qualified Data.ByteString.Lazy as B
import Control.Monad
+import Control.Applicative
import Foreign hiding (xor)
import Foreign.C.Types
import Foreign hiding (xor)
import Foreign.C.Types
emit32 (0x9090ffff :: Word32); nop; nop
let patcher reip = do
let (cname, fname) = buildFieldOffset cls x
emit32 (0x9090ffff :: Word32); nop; nop
let patcher reip = do
let (cname, fname) = buildFieldOffset cls x
- offset <- liftIO $ getFieldOffset cname fname
- push32_rel_eax (Disp (fromIntegral offset)) -- get field
+ offset <- liftIO $ fromIntegral <$> getFieldOffset cname fname
+ push32_rel_eax (Disp offset) -- get field
return reip
return $ Just (trapaddr, ObjectField patcher)
emit' (PUTFIELD x) = do
return reip
return $ Just (trapaddr, ObjectField patcher)
emit' (PUTFIELD x) = do
emit32 (0x9090ffff :: Word32); nop; nop
let patcher reip = do
let (cname, fname) = buildFieldOffset cls x
emit32 (0x9090ffff :: Word32); nop; nop
let patcher reip = do
let (cname, fname) = buildFieldOffset cls x
- offset <- liftIO $ getFieldOffset cname fname
- mov32_rel_ebx_eax (Disp (fromIntegral offset)) -- set field
+ offset <- liftIO $ fromIntegral <$> getFieldOffset cname fname
+ mov32_rel_ebx_eax (Disp offset) -- set field
return reip
return $ Just (trapaddr, ObjectField patcher)
return reip
return $ Just (trapaddr, ObjectField patcher)
callMalloc
-- 0x13371337 is just a placeholder; will be replaced with mtable ptr
mov (Disp 0, eax) (0x13371337 :: Word32)
callMalloc
-- 0x13371337 is just a placeholder; will be replaced with mtable ptr
mov (Disp 0, eax) (0x13371337 :: Word32)
+ mov (Disp 4, eax) (0x1337babe :: Word32)
let patcher reip = do
objsize <- liftIO $ getObjectSize objname
push32 objsize
callMalloc
mtable <- liftIO $ getMethodTable objname
mov (Disp 0, eax) mtable
let patcher reip = do
objsize <- liftIO $ getObjectSize objname
push32 objsize
callMalloc
mtable <- liftIO $ getMethodTable objname
mov (Disp 0, eax) mtable
+ mov (Disp 4, eax) (0x1337babe :: Word32)
return reip
return $ Just (trapaddr, NewObject patcher)
return reip
return $ Just (trapaddr, NewObject patcher)
struct integer {
unsigned int method_table_ptr;
struct integer {
unsigned int method_table_ptr;
int value;
};
struct string {
unsigned int method_table_ptr;
int value;
};
struct string {
unsigned int method_table_ptr;
struct chararray *value;
};
struct chararray *value;
};