codegen: kill unsafePerformIO
[mate.git] / Mate / X86CodeGen.hs
index 2c4e70e907289e4c87fd8326e6a66b6802697f64..0e8d98e80416458ba5bedd28f4b7df92954ec0bc 100644 (file)
@@ -26,6 +26,8 @@ import Mate.BasicBlocks
 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)
@@ -197,7 +199,7 @@ emitFromBB method cls hmap =  do
         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)
@@ -233,7 +235,7 @@ emitFromBB method cls hmap =  do
     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
@@ -243,7 +245,7 @@ emitFromBB method cls hmap =  do
         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)
@@ -268,16 +270,22 @@ emitFromBB method cls hmap =  do
         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
@@ -286,6 +294,7 @@ emitFromBB method cls hmap =  do
     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
@@ -312,6 +321,7 @@ emitFromBB method cls hmap =  do
         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