import Mate.Types
import Mate.Utilities
import Mate.ClassPool
+import Mate.Strings
+
foreign import ccall "dynamic"
code_int :: FunPtr (CInt -> CInt -> IO CInt) -> (CInt -> CInt -> IO CInt)
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 DUP = push (Disp 0, esp)
emit (NEW objidx) = do
let objname = buildClassID cls objidx
- let amount = unsafePerformIO $ getMethodSize objname
+ amount <- liftIO $ getMethodSize objname
push (amount :: Word32)
calladdr <- getCurrentOffset
let w32_calladdr = 5 + calladdr
push eax
-- 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)
pop eax
mov (Disp (cArgs x), ebp) eax
+ emit (LDC1 x) = emit (LDC2 $ fromIntegral x)
+ emit (LDC2 x) = do
+ 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
+ offset <- liftIO $ getFieldOffset cname fname
push (Disp (fromIntegral $ offset * 4), 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
+ offset <- liftIO $ getFieldOffset cname fname
mov (Disp (fromIntegral $ offset * 4), eax) ebx -- set field
emit IADD = do pop ebx; pop eax; add 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
jmp $ getLabel sid lmap
emit RETURN = do mov esp ebp; pop ebp; ret
+ emit ARETURN = emit IRETURN
emit IRETURN = do
pop eax
mov esp ebp