Mate/X86CodeGen.hs

   1 {-# LANGUAGE OverloadedStrings #-}
   2 module Mate.X86CodeGen where
   3
   4 import Data.Binary
   5 import Data.Int
   6 import Data.List
   7 import Data.Maybe
   8 import qualified Data.Map as M
   9 import qualified Data.ByteString.Lazy as B
  10
  11 import Foreign
  12 import Foreign.Ptr
  13 import Foreign.C.Types
  14
  15 import Text.Printf
  16
  17 import qualified JVM.Assembler as J
  18 import JVM.Assembler hiding (Instruction)
  19
  20 import Harpy
  21 import Harpy.X86Disassembler
  22
  23 import Mate.BasicBlocks
  24
  25 test_01 = do
  26       hmap <- parseMethod "./tests/While.class" "f"
  27       printMapBB hmap
  28       case hmap of
  29         Nothing -> putStrLn "sorry, no code generation"
  30         Just hmap -> do
  31               let ebb = emitFromBB hmap
  32               (_, Right ((entry, bbstarts, jumps), disasm)) <- runCodeGen ebb () ()
  33               let int_entry = ((fromIntegral $ ptrToIntPtr entry) :: Int)
  34               -- TODO(bernhard): patch jumps
  35               printf "disasm:\n"
  36               mapM_ (putStrLn . showAtt) disasm
  37               printf "basicblocks addresses:\n"
  38               let b = map (\(x,y) -> (x,y + int_entry)) $ M.toList bbstarts
  39               mapM_ (\(x,y) -> printf "\tBasicBlock %2d starts at 0x%08x\n" x y) b
  40               printf "stuff to patch:\n"
  41               let patching = [ (int_entry + topatch
  42                              ,  int_entry + (fromJust $ M.lookup bid bbstarts))
  43                              | (Jump (bid,topatch)) <- jumps]
  44               mapM_ (\(x,y) -> printf "\tpatch jmp @ 0x%08x to address 0x%08x\n" x y) patching
  45
  46 type EntryPoint = Ptr Word8
  47 type EntryPointOffset = Int
  48 type PatchInfo = (BlockID, EntryPointOffset)
  49 data Jump = Jump PatchInfo
  50
  51 type BBStarts = M.Map BlockID Int
  52
  53 type CompileInfo = (EntryPoint, BBStarts, [Jump])
  54
  55 emitFromBB :: MapBB -> CodeGen e s (CompileInfo, [Instruction])
  56 emitFromBB hmap =  do
  57         ep <- getEntryPoint
  58         push ebp
  59         mov ebp esp
  60         (bbstarts, jumps) <- efBB (0,(hmap M.! 0)) M.empty
  61         mov esp ebp
  62         pop ebp
  63         ret
  64         d <- disassemble
  65         return ((ep, bbstarts, jumps), d)
  66   where
  67   efBB :: (BlockID, BasicBlock) -> BBStarts -> CodeGen e s (BBStarts, [Jump])
  68   efBB (bid, bb) bbstarts =
  69         if M.member bid bbstarts then
  70           return (bbstarts, [])
  71         else
  72           do
  73           bb_offset <- getCodeOffset
  74           let bbstarts' = M.insert bid bb_offset bbstarts
  75           mapM emit $ code bb
  76           jj <- getCodeOffset
  77           let j = Jump (bid, jj)
  78           case successor bb of
  79             Return -> return (bbstarts', [])
  80             OneTarget t -> do
  81               (bbstarts'', jumps) <- efBB (t, hmap M.! t) bbstarts'
  82               return (bbstarts'', j:jumps)
  83             TwoTarget t1 t2 -> do
  84               (bbstarts'', jumps) <- efBB (t1, hmap M.! t1) bbstarts'
  85               (bbstarts''', jumps') <- efBB (t2, hmap M.! t2) bbstarts''
  86               return (bbstarts''', j:(jumps ++ jumps'))
  87   -- TODO(bernhard): also use metainformation
  88   -- TODO(bernhard): implement `emit' as function which accepts a list of
  89   --                 instructions, so we can use patterns for optimizations
  90   emit :: J.Instruction -> CodeGen e s ()
  91   emit (ILOAD_ x) = do
  92       push (Disp (cArgs_ x), ebp)
  93   emit (ISTORE_ x) = do
  94       pop eax
  95       mov (Disp (cArgs_ x), ebp) eax
  96   emit IADD = do pop ebx; pop eax; add eax ebx; push eax
  97   emit (IINC x imm) = do
  98       add (Disp (cArgs x), ebp) (s8_w32 imm)
  99
 100   emit (IF cond _) = do
 101       pop eax
 102       cmp eax (0 :: Word32)
 103       -- TODO(bernhard): can we use harpy magic here, in order to avoid patching?
 104       case cond of
 105         -- "patch me" after code generation (here we don't know the address yet)
 106         C_EQ -> error "not implemented yet"
 107         C_NE -> error "not implemented yet"
 108         C_LT -> error "not implemented yet"
 109         C_GE -> error "not implemented yet"
 110         C_GT -> jg (0xaabbccdd :: Word32)
 111         C_LE -> error "not implemented yet"
 112
 113   emit IRETURN = do pop eax
 114   emit _ = do cmovbe eax eax -- dummy
 115
 116   cArgs x = (8 + 4 * (fromIntegral x))
 117   cArgs_ x = (8 + 4 * case x of I0 -> 0; I1 -> 1; I2 -> 2; I3 -> 3)
 118
 119   -- sign extension from w8 to w32 (over s8)
 120   --   unfortunately, hs-java is using Word8 everywhere (while
 121   --   it should be Int8 actually)
 122   s8_w32 :: Word8 -> Word32
 123   s8_w32 w8 = fromIntegral s8
 124     where s8 = (fromIntegral w8) :: Int8