From: Bernhard Urban Date: Fri, 27 Apr 2012 10:39:27 +0000 (+0200) Subject: refactor: rename types (more consistent style) X-Git-Url: http://wien.tomnetworks.com/gitweb/?p=mate.git;a=commitdiff_plain;h=733a46559319e7ca67b104bfe0b1e737c4ab784c refactor: rename types (more consistent style) --- diff --git a/Mate/ClassPool.hs b/Mate/ClassPool.hs index fd5fc8e..3e000df 100644 --- a/Mate/ClassPool.hs +++ b/Mate/ClassPool.hs @@ -42,40 +42,40 @@ getClassInfo path = do getClassFile :: B.ByteString -> IO (Class Resolved) getClassFile path = do ci <- getClassInfo path - return $ clFile ci + return $ ciFile ci getStaticFieldOffset :: B.ByteString -> B.ByteString -> IO (CUInt) getStaticFieldOffset path field = do ci <- getClassInfo path - return $ fromIntegral $ (clStaticMap ci) M.! field + return $ fromIntegral $ (ciStaticMap ci) M.! field getFieldOffset :: B.ByteString -> B.ByteString -> IO (Int32) getFieldOffset path field = do ci <- getClassInfo path - return $ (clFieldMap ci) M.! field + return $ (ciFieldMap ci) M.! field -- method + signature plz! getMethodOffset :: B.ByteString -> B.ByteString -> IO (Word32) getMethodOffset path method = do ci <- getClassInfo path - return $ fromIntegral $ (clMethodMap ci) M.! method + return $ fromIntegral $ (ciMethodMap ci) M.! method getMethodTable :: B.ByteString -> IO (Word32) getMethodTable path = do ci <- getClassInfo path - return $ clMethodBase ci + return $ ciMethodBase ci getMethodSize :: B.ByteString -> IO (Word32) getMethodSize path = do ci <- getClassInfo path -- TODO(bernhard): correct sizes for different types... - let msize = fromIntegral $ M.size $ clMethodMap ci + let msize = fromIntegral $ M.size $ ciMethodMap ci return $ (1 + msize) * 4 foreign export ccall getStaticFieldAddr :: CUInt -> Ptr () -> IO CUInt getStaticFieldAddr :: CUInt -> Ptr () -> IO CUInt getStaticFieldAddr from ptr_trapmap = do - trapmap <- ptr2tmap ptr_trapmap + trapmap <- ptr2trapmap ptr_trapmap let w32_from = fromIntegral from let sfi = trapmap M.! w32_from case sfi of @@ -121,11 +121,11 @@ calculateFields cf superclass = do staticbase <- mallocBytes ((fromIntegral $ length sfields) * 4) let i_sb = fromIntegral $ ptrToIntPtr $ staticbase let sm = zipbase i_sb sfields - let sc_sm = getsupermap superclass clStaticMap + let sc_sm = getsupermap superclass ciStaticMap -- new fields "overwrite" old ones, if they have the same name let staticmap = (M.fromList sm) `M.union` sc_sm - let sc_im = getsupermap superclass clFieldMap + let sc_im = getsupermap superclass ciFieldMap -- "+ 4" for the method table pointer let max_off = (fromIntegral $ (M.size sc_im) * 4) + 4 let im = zipbase max_off ifields @@ -147,7 +147,7 @@ calculateMethodMap cf superclass = do (\x -> (not . S.member ACC_STATIC . methodAccessFlags) x && ((/=) "" . methodName) x) (classMethods cf) - let sc_mm = getsupermap superclass clMethodMap + let sc_mm = getsupermap superclass ciMethodMap let max_off = fromIntegral $ (M.size sc_mm) * 4 let mm = zipbase max_off methods let methodmap = (M.fromList mm) `M.union` sc_mm @@ -166,12 +166,12 @@ loadAndInitClass path = do Just x -> return x -- first try to execute class initializer of superclass - when (path /= "java/lang/Object") ((loadAndInitClass $ superClass $ clFile ci) >> return ()) + when (path /= "java/lang/Object") ((loadAndInitClass $ superClass $ ciFile ci) >> return ()) -- execute class initializer - case lookupMethod "" (clFile ci) of + case lookupMethod "" (ciFile ci) of Just m -> do - hmap <- parseMethod (clFile ci) "" + hmap <- parseMethod (ciFile ci) "" printMapBB hmap case hmap of Just hmap' -> do @@ -185,7 +185,7 @@ loadAndInitClass path = do Nothing -> return () class_map' <- get_classmap >>= ptr2classmap - let new_ci = ci { clInitDone = True } + let new_ci = ci { ciInitDone = True } let class_map'' = M.insert path new_ci class_map' classmap2ptr class_map'' >>= set_classmap return new_ci diff --git a/Mate/MethodPool.hs b/Mate/MethodPool.hs index 0e146a1..785d821 100644 --- a/Mate/MethodPool.hs +++ b/Mate/MethodPool.hs @@ -34,8 +34,8 @@ foreign import ccall "dynamic" foreign export ccall getMethodEntry :: CUInt -> CUInt -> IO CUInt getMethodEntry :: CUInt -> CUInt -> IO CUInt getMethodEntry signal_from methodtable = do - mmap <- get_methodmap >>= ptr2mmap - tmap <- get_trapmap >>= ptr2tmap + mmap <- get_methodmap >>= ptr2methodmap + tmap <- get_trapmap >>= ptr2trapmap vmap <- get_virtualmap >>= ptr2virtualmap let w32_from = fromIntegral signal_from @@ -71,7 +71,7 @@ getMethodEntry signal_from methodtable = do nf <- loadNativeFunction symbol let w32_nf = fromIntegral nf let mmap' = M.insert mi' w32_nf mmap - mmap2ptr mmap' >>= set_methodmap + methodmap2ptr mmap' >>= set_methodmap return nf Nothing -> error $ (show method) ++ " not found. abort" Just w32 -> return (fromIntegral w32) @@ -117,8 +117,8 @@ loadNativeFunction sym = do initMethodPool :: IO () initMethodPool = do - mmap2ptr M.empty >>= set_methodmap - tmap2ptr M.empty >>= set_trapmap + methodmap2ptr M.empty >>= set_methodmap + trapmap2ptr M.empty >>= set_trapmap classmap2ptr M.empty >>= set_classmap virtualmap2ptr M.empty >>= set_virtualmap stringsmap2ptr M.empty >>= set_stringsmap @@ -126,21 +126,21 @@ initMethodPool = do addMethodRef :: Word32 -> MethodInfo -> [B.ByteString] -> IO () addMethodRef entry (MethodInfo mmname _ msig) clsnames = do - mmap <- get_methodmap >>= ptr2mmap + mmap <- get_methodmap >>= ptr2methodmap let newmap = M.fromList $ map (\x -> ((MethodInfo mmname x msig), entry)) clsnames - mmap2ptr (mmap `M.union` newmap) >>= set_methodmap + methodmap2ptr (mmap `M.union` newmap) >>= set_methodmap compileBB :: MapBB -> MethodInfo -> IO Word32 compileBB hmap methodinfo = do - tmap <- get_trapmap >>= ptr2tmap + tmap <- get_trapmap >>= ptr2trapmap - cls <- getClassFile (cName methodinfo) + cls <- getClassFile (methClassName methodinfo) let ebb = emitFromBB (methName methodinfo) cls hmap (_, Right ((entry, _, _, new_tmap), disasm)) <- runCodeGen ebb () () let tmap' = M.union tmap new_tmap -- prefers elements in cmap - tmap2ptr tmap' >>= set_trapmap + trapmap2ptr tmap' >>= set_trapmap printf "disasm:\n" mapM_ (putStrLn . showAtt) disasm diff --git a/Mate/Types.hs b/Mate/Types.hs index 7f19325..7d1583d 100644 --- a/Mate/Types.hs +++ b/Mate/Types.hs @@ -19,8 +19,8 @@ import JVM.Assembler type BlockID = Int -- Represents a CFG node data BasicBlock = BasicBlock { - code :: [Instruction], - successor :: BBEnd } + code :: [Instruction], + successor :: BBEnd } -- describes (leaving) edges of a CFG node data BBEnd = Return | FallThrough BlockID | OneTarget BlockID | TwoTarget BlockID BlockID deriving Show @@ -28,12 +28,13 @@ data BBEnd = Return | FallThrough BlockID | OneTarget BlockID | TwoTarget BlockI type MapBB = M.Map BlockID BasicBlock + -- Word32 = point of method call in generated code -- MethodInfo = relevant information about callee -type TMap = M.Map Word32 TrapInfo +type TrapMap = M.Map Word32 TrapInfo data TrapInfo = - MI MethodInfo | + MI MethodInfo | -- for static calls VI MethodInfo | -- for virtual calls SFI StaticFieldInfo @@ -41,42 +42,20 @@ data StaticFieldInfo = StaticFieldInfo { sfiClassName :: B.ByteString, sfiFieldName :: B.ByteString } --- B.ByteString = name of method --- Word32 = entrypoint of method -type MMap = M.Map MethodInfo Word32 - -type ClassMap = M.Map B.ByteString ClassInfo -type FieldMap = M.Map B.ByteString Int32 --- java strings are allocated once, therefore we --- use a hashmap to store the address for a String -type StringsMap = M.Map B.ByteString Word32 - --- map "methodtable addr" to "classname" --- we need that to identify the actual type --- on the invokevirtual insn -type VirtualMap = M.Map Word32 B.ByteString - -data ClassInfo = ClassInfo { - clName :: B.ByteString, - clFile :: Class Resolved, - clStaticMap :: FieldMap, - clFieldMap :: FieldMap, - clMethodMap :: FieldMap, - clMethodBase :: Word32, - clInitDone :: Bool } +-- B.ByteString = name of method +-- Word32 = entrypoint of method +type MethodMap = M.Map MethodInfo Word32 data MethodInfo = MethodInfo { methName :: B.ByteString, - cName :: B.ByteString, - mSignature :: MethodSignature} - -instance Eq MethodInfo where - (MethodInfo m_a c_a s_a) == (MethodInfo m_b c_b s_b) = - (m_a == m_b) && (c_a == c_b) && (s_a == s_b) + methClassName :: B.ByteString, + methSignature :: MethodSignature + } deriving (Eq, Ord) -- TODO(bernhard): not really efficient. also, outsource that to hs-java +-- deriving should be enough? instance Ord MethodSignature where compare (MethodSignature args_a ret_a) (MethodSignature args_b ret_b) | cmp_args /= EQ = cmp_args @@ -84,25 +63,46 @@ instance Ord MethodSignature where where cmp_args = (show args_a) `compare` (show args_b) -instance Ord MethodInfo where - compare (MethodInfo m_a c_a s_a) (MethodInfo m_b c_b s_b) - | cmp_m /= EQ = cmp_m - | cmp_c /= EQ = cmp_c - | otherwise = s_a `compare` s_b - where - cmp_m = m_a `compare` m_b - cmp_c = c_a `compare` c_b - instance Show MethodInfo where show (MethodInfo method c sig) = (toString c) ++ "." ++ (toString method) ++ "." ++ (show sig) + +-- store information of loaded classes +type ClassMap = M.Map B.ByteString ClassInfo + +data ClassInfo = ClassInfo { + ciName :: B.ByteString, + ciFile :: Class Resolved, + ciStaticMap :: FieldMap, + ciFieldMap :: FieldMap, + ciMethodMap :: FieldMap, + ciMethodBase :: Word32, + ciInitDone :: Bool } + + +-- store field offsets in a map +type FieldMap = M.Map B.ByteString Int32 + + +-- java strings are allocated only once, therefore we +-- use a hashmap to store the address for a String +type StringsMap = M.Map B.ByteString Word32 + + +-- map "methodtable addr" to "classname" +-- we need that to identify the actual type +-- on the invokevirtual insn +type VirtualMap = M.Map Word32 B.ByteString + + toString :: B.ByteString -> String toString bstr = decodeString $ map (chr . fromIntegral) $ B.unpack bstr --- global map hax +-- those functions are for the "global map hax" +-- TODO(bernhard): other solution please foreign import ccall "get_trapmap" get_trapmap :: IO (Ptr ()) @@ -134,21 +134,22 @@ foreign import ccall "set_stringsmap" set_stringsmap :: Ptr () -> IO () -- TODO(bernhard): make some typeclass magic 'n stuff -mmap2ptr :: MMap -> IO (Ptr ()) -mmap2ptr mmap = do - ptr_mmap <- newStablePtr mmap - return $ castStablePtrToPtr ptr_mmap - -ptr2mmap :: Ptr () -> IO MMap -ptr2mmap vmap = deRefStablePtr $ ((castPtrToStablePtr vmap) :: StablePtr MMap) - -tmap2ptr :: TMap -> IO (Ptr ()) -tmap2ptr tmap = do - ptr_tmap <- newStablePtr tmap - return $ castStablePtrToPtr ptr_tmap - -ptr2tmap :: Ptr () -> IO TMap -ptr2tmap vmap = deRefStablePtr $ ((castPtrToStablePtr vmap) :: StablePtr tmap) +-- or remove that sh** +methodmap2ptr :: MethodMap -> IO (Ptr ()) +methodmap2ptr methodmap = do + ptr_methodmap <- newStablePtr methodmap + return $ castStablePtrToPtr ptr_methodmap + +ptr2methodmap :: Ptr () -> IO MethodMap +ptr2methodmap methodmap = deRefStablePtr $ ((castPtrToStablePtr methodmap) :: StablePtr MethodMap) + +trapmap2ptr :: TrapMap -> IO (Ptr ()) +trapmap2ptr trapmap = do + ptr_trapmap <- newStablePtr trapmap + return $ castStablePtrToPtr ptr_trapmap + +ptr2trapmap :: Ptr () -> IO TrapMap +ptr2trapmap vmap = deRefStablePtr $ ((castPtrToStablePtr vmap) :: StablePtr trapmap) classmap2ptr :: ClassMap -> IO (Ptr ()) classmap2ptr cmap = do diff --git a/Mate/X86CodeGen.hs b/Mate/X86CodeGen.hs index 00e9303..d95358c 100644 --- a/Mate/X86CodeGen.hs +++ b/Mate/X86CodeGen.hs @@ -119,7 +119,7 @@ type PatchInfo = (BlockID, EntryPointOffset) type BBStarts = M.Map BlockID Int -type CompileInfo = (EntryPoint, BBStarts, Int, TMap) +type CompileInfo = (EntryPoint, BBStarts, Int, TrapMap) emitFromBB :: B.ByteString -> Class Resolved -> MapBB -> CodeGen e s (CompileInfo, [Instruction]) @@ -142,7 +142,7 @@ emitFromBB method cls hmap = do getLabel _ [] = error "label not found!" getLabel i ((x,l):xs) = if i==x then l else getLabel i xs - efBB :: (BlockID, BasicBlock) -> TMap -> BBStarts -> [(BlockID, Label)] -> CodeGen e s (TMap, BBStarts) + efBB :: (BlockID, BasicBlock) -> TrapMap -> BBStarts -> [(BlockID, Label)] -> CodeGen e s (TrapMap, BBStarts) efBB (bid, bb) calls bbstarts lmap = if M.member bid bbstarts then return (calls, bbstarts)