refactor: rename types (more consistent style)
authorBernhard Urban <lewurm@gmail.com>
Fri, 27 Apr 2012 10:39:27 +0000 (12:39 +0200)
committerBernhard Urban <lewurm@gmail.com>
Fri, 27 Apr 2012 10:39:27 +0000 (12:39 +0200)
Mate/ClassPool.hs
Mate/MethodPool.hs
Mate/Types.hs
Mate/X86CodeGen.hs

index fd5fc8ebb328bb897e9cf3f15202ef0000701969..3e000dfab81c869b01c9517b0fbe5d96e05e75b3 100644 (file)
@@ -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 &&
                          ((/=) "<init>" . 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 "<clinit>" (clFile ci) of
+  case lookupMethod "<clinit>" (ciFile ci) of
     Just m -> do
-      hmap <- parseMethod (clFile ci) "<clinit>"
+      hmap <- parseMethod (ciFile ci) "<clinit>"
       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
index 0e146a103031c214997b81950efc5e22917017ba..785d8218f6919fa606d9e45cbc0c1503240622ec 100644 (file)
@@ -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
index 7f193251302a288c57d84fe967a4be606c29c60e..7d1583dbb0b1bb51f4e17ba67fe48128988e36c5 100644 (file)
@@ -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
index 00e93032827e46d5acf2c65c80468f48d93aff60..d95358c959440d0acab0d5a016b09b4fa6834f1a 100644 (file)
@@ -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)