codegen: map each real PC to java bytecode PC
[mate.git] / Mate / X86CodeGen.hs
index 7d17a9d7314d0f18929f124fdca250909381f9c7..03333ce0d35d5163a3b31da763a60eb3d20b6ad6 100644 (file)
@@ -42,10 +42,10 @@ type PatchInfo = (BlockID, EntryPointOffset)
 
 type BBStarts = M.Map BlockID Int
 
-type CompileInfo = (EntryPoint, BBStarts, Int, TrapMap)
+type CompileInfo = (EntryPoint, Int, TrapMap)
 
 
-emitFromBB :: Class Direct -> RawMethod -> CodeGen e s (CompileInfo, [Instruction])
+emitFromBB :: Class Direct -> RawMethod -> CodeGen e JpcNpcMap (CompileInfo, [Instruction])
 emitFromBB cls method = do
     let keys = M.keys hmap
     llmap <- mapM (newNamedLabel . (++) "bb_" . show) keys
@@ -54,42 +54,30 @@ emitFromBB cls method = do
     push ebp
     mov ebp esp
     sub esp (fromIntegral (rawLocals method) * ptrSize :: Word32)
-
-    (calls, bbstarts) <- efBB (0, hmap M.! 0) M.empty M.empty lmap
+    calls <- M.fromList . catMaybes . concat <$> mapM (efBB lmap) keys
     d <- disassemble
     end <- getCodeOffset
-    return ((ep, bbstarts, end, calls), d)
+    return ((ep, end, calls), d)
   where
   hmap = rawMapBB method
 
   getLabel :: BlockID -> [(BlockID, Label)] -> Label
-  getLabel _ [] = error "label not found!"
+  getLabel bid [] = error $ "label " ++ show bid ++ " not found"
   getLabel i ((x,l):xs) = if i==x then l else getLabel i xs
 
-  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)
-    else do
-      bb_offset <- getCodeOffset
-      let bbstarts' = M.insert bid bb_offset bbstarts
-      defineLabel $ getLabel bid lmap
-      cs <- mapM emit'' $ code bb
-      let calls' = calls `M.union` M.fromList (catMaybes cs)
-      case successor bb of
-        Return -> return (calls', bbstarts')
+  efBB :: [(BlockID, Label)] -> BlockID -> CodeGen e JpcNpcMap [(Maybe (Word32, TrapCause))]
+  efBB lmap bid = do
+    defineLabel $ getLabel bid lmap
+    retval <- mapM emit'' $ code bb
+    case successor bb of
         FallThrough t -> do
           -- TODO(bernhard): le dirty hax. see java/lang/Integer.toString(int, int)
           jmp (getLabel t lmap)
-          efBB (t, hmap M.! t) calls' bbstarts' lmap
-        OneTarget t -> efBB (t, hmap M.! t) calls' bbstarts' lmap
-        TwoTarget t1 t2 -> do
-          (calls'', bbstarts'') <- efBB (t1, hmap M.! t1) calls' bbstarts' lmap
-          efBB (t2, hmap M.! t2) calls'' bbstarts'' lmap
-    -- TODO(bernhard): also use metainformation
-    -- TODO(bernhard): implement `emit' as function which accepts a list of
-    --                 instructions, so we can use patterns for optimizations
+        _ -> return ()
+    return retval
     where
+    bb = hmap M.! bid
+
     forceRegDump :: CodeGen e s ()
     forceRegDump = do
       push esi
@@ -99,10 +87,9 @@ emitFromBB cls method = do
 
     getCurrentOffset :: CodeGen e s Word32
     getCurrentOffset = do
-      ep <- getEntryPoint
-      let w32_ep = (fromIntegral $ ptrToIntPtr ep) :: Word32
-      offset <- getCodeOffset
-      return $ w32_ep + fromIntegral offset
+      ep <- (fromIntegral . ptrToIntPtr) <$> getEntryPoint
+      offset <- fromIntegral <$> getCodeOffset
+      return $ ep + offset
 
     emitInvoke :: Word16 -> Bool -> CodeGen e s (Maybe (Word32, TrapCause))
     emitInvoke cpidx hasThis = do
@@ -111,7 +98,7 @@ emitFromBB cls method = do
       -- like: call $0x01234567
       calladdr <- emitSigIllTrap 5
       let patcher reip = do
-            entryAddr <- liftIO $ getMethodEntry l
+            (entryAddr, _) <- liftIO $ getMethodEntry l
             call (fromIntegral (entryAddr - (reip + 5)) :: NativeWord)
             return reip
       -- discard arguments on stack
@@ -150,8 +137,12 @@ emitFromBB cls method = do
       -- depending on the method-table-ptr
       return $ Just (calladdr, VirtualCall isInterface mi offset)
 
-    emit'' :: J.Instruction -> CodeGen e s (Maybe (Word32, TrapCause))
-    emit'' insn = newNamedLabel ("jvm_insn: " ++ show insn) >>= defineLabel >> emit' insn
+    emit'' :: J.Instruction -> CodeGen e JpcNpcMap (Maybe (Word32, TrapCause))
+    emit'' insn = do
+      ep <- (fromIntegral . ptrToIntPtr) <$> getEntryPoint
+      jpcrpc <- getState
+      setState (M.insert ep bid jpcrpc)
+      newNamedLabel ("jvm_insn: " ++ show insn) >>= defineLabel >> emit' insn
 
     emit' :: J.Instruction -> CodeGen e s (Maybe (Word32, TrapCause))
     emit' (INVOKESPECIAL cpidx) = emitInvoke cpidx True
@@ -227,6 +218,7 @@ emitFromBB cls method = do
     emit' ATHROW = do
       trapaddr <- emitSigIllTrap 2
       let patcher resp reip = do
+            error "no athrow for you, sorry"
             emitSigIllTrap 2
             return reip
       return $ Just (trapaddr, ThrowException patcher)