codegen: factor i{load,store} shortcuts

[mate.git] / Mate / X86CodeGen.hs

diff --git a/Mate/X86CodeGen.hs b/Mate/X86CodeGen.hs
index d09304d70428463ddd400351c27fdf234be83bee..8b3c39f49d94b14c3953e6641c673b8a418fbcd4 100644 (file)
--- a/Mate/X86CodeGen.hs
+++ b/Mate/X86CodeGen.hs
@@ -48,8 +48,9 @@ type CompileInfo = (EntryPoint, BBStarts, Int, TrapMap)
 
 emitFromBB :: B.ByteString -> MethodSignature -> Class Direct -> MapBB -> CodeGen e s (CompileInfo, [Instruction])
 emitFromBB method sig cls hmap =  do
-        llmap <- sequence [newNamedLabel ("bb_" ++ show x) | (x,_) <- M.toList hmap]
-        let lmap = zip (Prelude.fst $ unzip $ M.toList hmap) llmap
+        let keys = M.keys hmap
+        llmap <- mapM (newNamedLabel . (++) "bb_" . show) keys
+        let lmap = zip keys llmap
         ep <- getEntryPoint
         push ebp
         mov ebp esp
@@ -78,7 +79,10 @@ emitFromBB method sig cls hmap =  do
           let calls' = calls `M.union` M.fromList (catMaybes cs)
           case successor bb of
             Return -> return (calls', bbstarts')
-            FallThrough t -> efBB (t, hmap M.! t) calls' bbstarts' lmap
+            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
@@ -144,7 +148,7 @@ emitFromBB method sig cls hmap =  do
         -- note, that "mi" has the wrong class reference here.
         -- we figure that out at run-time, in the methodpool,
         -- depending on the method-table-ptr
-        invokeEpilog cpidx offset (\x -> InterfaceMethod x mi)
+        invokeEpilog cpidx offset (`InterfaceMethod` mi)
     emit' (INVOKEVIRTUAL cpidx) = do
         -- get methodInfo entry
         let mi@(MethodInfo methodname objname msig@(MethodSignature args _))  = buildMethodID cls cpidx
@@ -159,7 +163,7 @@ emitFromBB method sig cls hmap =  do
         -- note, that "mi" has the wrong class reference here.
         -- we figure that out at run-time, in the methodpool,
         -- depending on the method-table-ptr
-        invokeEpilog cpidx offset (\x -> VirtualMethod x mi)
+        invokeEpilog cpidx offset (`VirtualMethod` mi)
     emit' (PUTSTATIC cpidx) = do
         pop eax
         trapaddr <- getCurrentOffset
@@ -237,7 +241,8 @@ emitFromBB method sig cls hmap =  do
     emit (INSTANCEOF _) = do
       pop eax
       push (1 :: Word32)
-    emit ATHROW = nop -- TODO(bernhard): ...
+    emit ATHROW = -- TODO(bernhard): ...
+        emit32 (0xffffffff :: Word32)
     emit I2C = do
       pop eax
       and eax (0x000000ff :: Word32)
@@ -252,14 +257,14 @@ emitFromBB method sig cls hmap =  do
     emit (ICONST_3) = push (3 :: Word32)
     emit (ICONST_4) = push (4 :: Word32)
     emit (ICONST_5) = push (5 :: Word32)
+
     emit (ALOAD_ x) = emit (ILOAD_ x)
-    emit (ILOAD_ x) = push (Disp (cArgs_ x), ebp)
+    emit (ILOAD_ x) = emit (ILOAD $ cArgs_ x)
     emit (ALOAD x) = emit (ILOAD x)
     emit (ILOAD x) = push (Disp (cArgs x), ebp)
+
     emit (ASTORE_ x) = emit (ISTORE_ x)
-    emit (ISTORE_ x) = do
-        pop eax
-        mov (Disp (cArgs_ x), ebp) eax
+    emit (ISTORE_ x) = emit (ISTORE $ cArgs_ x)
     emit (ASTORE x) = emit (ISTORE x)
     emit (ISTORE x) = do
         pop eax
@@ -269,6 +274,7 @@ emitFromBB method sig cls hmap =  do
     emit (LDC2 x) = do
         value <- case constsPool cls M.! x of
                       (CString s) -> liftIO $ getUniqueStringAddr s
+                      (CInteger i) -> liftIO $ return i
                       e -> error $ "LDCI... missing impl.: " ++ show e
         push value
     emit (GETFIELD x) = do
@@ -349,13 +355,13 @@ emitFromBB method sig cls hmap =  do
       else 4 + (thisMethodArgCnt * 4) - (4 * x')
     where x' = fromIntegral x
 
-  cArgs_ :: IMM -> Word32
-  cArgs_ x = cArgs $ case x of I0 -> 0; I1 -> 1; I2 -> 2; I3 -> 3
+  cArgs_ :: IMM -> Word8
+  cArgs_ x = case x of I0 -> 0; I1 -> 1; I2 -> 2; I3 -> 3
 
   thisMethodArgCnt :: Word32
   thisMethodArgCnt = isNonStatic + fromIntegral (length args)
     where
-    (Just m) = lookupMethodSig method sig cls
+    m = fromJust $ lookupMethodSig method sig cls
     (MethodSignature args _) = sig
     isNonStatic = if S.member ACC_STATIC (methodAccessFlags m)
         then 0 else 1 -- one argument for the this pointer