module Mate.X86CodeGen where
import Data.Binary
+import Data.BinaryState
import Data.Int
import Data.Maybe
import qualified Data.Map as M
import qualified Data.ByteString.Lazy as B
import Control.Monad
-import Foreign
+import Foreign hiding (xor)
import Foreign.C.Types
import Text.Printf
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])
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)
mov eax (Disp 0, eax)
-- get method offset
let nameAndSig = methodname `B.append` (encode msig)
- let offset = unsafePerformIO $ getMethodOffset objname nameAndSig
+ offset <- liftIO $ getMethodOffset objname nameAndSig
-- make actual (indirect) call
calladdr <- getCurrentOffset
call (Disp offset, eax)
emit' insn = emit insn >> return Nothing
emit :: J.Instruction -> CodeGen e s ()
- emit POP = do -- print dropped value
- calladdr <- getCurrentOffset
- -- '5' is the size of the `call' instruction ( + immediate)
- let w32_calladdr = 5 + calladdr
- let trapaddr = (fromIntegral getaddr :: Word32)
- call (trapaddr - w32_calladdr)
+ emit POP = do -- dropp value
add esp (4 :: Word32)
emit DUP = push (Disp 0, esp)
+ emit AASTORE = emit IASTORE
+ emit IASTORE = do
+ pop eax -- value
+ pop ebx -- offset
+ add ebx (1 :: Word32)
+ pop ecx -- aref
+ mov (ecx, ebx, S4) eax
+ emit AALOAD = emit IALOAD
+ emit IALOAD = do
+ pop ebx -- offset
+ add ebx (1 :: Word32)
+ pop ecx -- aref
+ push (ecx, ebx, S4)
+ emit ARRAYLENGTH = do
+ pop eax
+ push (Disp 0, eax)
+ emit (ANEWARRAY _) = emit (NEWARRAY 10) -- 10 == T_INT
+ emit (NEWARRAY typ) = do
+ let tsize = case decodeS (0 :: Integer) (B.pack [typ]) of
+ T_INT -> 4
+ _ -> error $ "newarray: type not implemented yet"
+ -- get length from stack, but leave it there
+ mov eax (Disp 0, esp)
+ mov ebx (tsize :: Word32)
+ -- multiple amount with native size of one element
+ mul ebx -- result is in eax
+ add eax (4 :: Word32) -- for "length" entry
+ -- push amount of bytes to allocate
+ push eax
+ callMalloc
+ pop eax -- ref to arraymemory
+ pop ebx -- length
+ mov (Disp 0, eax) ebx -- store length at offset 0
+ push eax -- push ref again
emit (NEW objidx) = do
let objname = buildClassID cls objidx
- let amount = unsafePerformIO $ getMethodSize objname
+ amount <- liftIO $ getObjectSize objname
push (amount :: Word32)
- calladdr <- getCurrentOffset
- let w32_calladdr = 5 + calladdr
- let malloaddr = (fromIntegral getMallocAddr :: Word32)
- call (malloaddr - w32_calladdr)
- add esp (4 :: Word32)
- push eax
+ callMalloc
-- TODO(bernhard): save reference somewhere for GC
-- set method table pointer
- let mtable = unsafePerformIO $ getMethodTable objname
+ mtable <- liftIO $ getMethodTable objname
mov (Disp 0, eax) mtable
emit (CHECKCAST _) = nop -- TODO(bernhard): ...
emit (BIPUSH val) = push ((fromIntegral val) :: Word32)
emit (ICONST_0) = push (0 :: Word32)
emit (ICONST_1) = push (1 :: Word32)
emit (ICONST_2) = push (2 :: Word32)
+ 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 (LDC1 x) = emit (LDC2 $ fromIntegral x)
emit (LDC2 x) = do
- let value = case (constsPool cls) M.! x of
- (CString s) -> unsafePerformIO $ getUniqueStringAddr s
+ value <- case (constsPool cls) M.! x of
+ (CString s) -> liftIO $ getUniqueStringAddr s
_ -> error $ "LDCI... missing impl."
push value
emit (GETFIELD x) = do
pop eax -- this pointer
let (cname, fname) = buildFieldOffset cls x
- let offset = unsafePerformIO $ getFieldOffset cname fname
- push (Disp (fromIntegral $ offset * 4), eax) -- get field
+ offset <- liftIO $ getFieldOffset cname fname
+ push (Disp (fromIntegral $ offset), eax) -- get field
emit (PUTFIELD x) = do
pop ebx -- value to write
pop eax -- this pointer
let (cname, fname) = buildFieldOffset cls x
- let offset = unsafePerformIO $ getFieldOffset cname fname
- mov (Disp (fromIntegral $ offset * 4), eax) ebx -- set field
+ offset <- liftIO $ getFieldOffset cname fname
+ mov (Disp (fromIntegral $ offset), eax) ebx -- set field
emit IADD = do pop ebx; pop eax; add eax ebx; push eax
emit ISUB = do pop ebx; pop eax; sub eax ebx; push eax
emit IMUL = do pop ebx; pop eax; mul ebx; push eax
+ emit IXOR = do pop ebx; pop eax; xor eax ebx; push eax
emit (IINC x imm) = do
add (Disp (cArgs x), ebp) (s8_w32 imm)
+ emit (IF_ACMP cond x) = emit (IF_ICMP cond x)
emit (IF_ICMP cond _) = do
pop eax -- value2
pop ebx -- value1
ret
emit invalid = error $ "insn not implemented yet: " ++ (show invalid)
+ callMalloc :: CodeGen e s ()
+ callMalloc = do
+ calladdr <- getCurrentOffset
+ let w32_calladdr = 5 + calladdr
+ let malloaddr = (fromIntegral getMallocAddr :: Word32)
+ call (malloaddr - w32_calladdr)
+ add esp (4 :: Word32)
+ push eax
+
-- for locals we use a different storage
cArgs :: Word8 -> Word32
cArgs x = if (x' >= thisMethodArgCnt)
projects / mate.git / blobdiff