projects
/
mate.git
/ commitdiff
commit
grep
author
committer
pickaxe
?
search:
re
summary
|
shortlog
|
log
|
commit
| commitdiff |
tree
raw
|
patch
|
inline
| side by side (parent:
938e054
)
codegen: kill unsafePerformIO
author
Bernhard Urban
<lewurm@gmail.com>
Thu, 26 Apr 2012 11:36:33 +0000
(13:36 +0200)
committer
Bernhard Urban
<lewurm@gmail.com>
Thu, 26 Apr 2012 11:36:33 +0000
(13:36 +0200)
thanks to MonadIO \o/
Mate/X86CodeGen.hs
patch
|
blob
|
history
diff --git
a/Mate/X86CodeGen.hs
b/Mate/X86CodeGen.hs
index 9fc57567fd963ced2185cee14d289f0ce6853472..0e8d98e80416458ba5bedd28f4b7df92954ec0bc 100644
(file)
--- a/
Mate/X86CodeGen.hs
+++ b/
Mate/X86CodeGen.hs
@@
-199,7
+199,7
@@
emitFromBB method cls hmap = do
mov eax (Disp 0, eax)
-- get method offset
let nameAndSig = methodname `B.append` (encode msig)
mov eax (Disp 0, eax)
-- get method offset
let nameAndSig = methodname `B.append` (encode msig)
-
let offset = unsafePerform
IO $ getMethodOffset objname nameAndSig
+
offset <- lift
IO $ getMethodOffset objname nameAndSig
-- make actual (indirect) call
calladdr <- getCurrentOffset
call (Disp offset, eax)
-- make actual (indirect) call
calladdr <- getCurrentOffset
call (Disp offset, eax)
@@
-235,7
+235,7
@@
emitFromBB method cls hmap = do
emit DUP = push (Disp 0, esp)
emit (NEW objidx) = do
let objname = buildClassID cls objidx
emit DUP = push (Disp 0, esp)
emit (NEW objidx) = do
let objname = buildClassID cls objidx
-
let amount = unsafePerform
IO $ getMethodSize objname
+
amount <- lift
IO $ getMethodSize objname
push (amount :: Word32)
calladdr <- getCurrentOffset
let w32_calladdr = 5 + calladdr
push (amount :: Word32)
calladdr <- getCurrentOffset
let w32_calladdr = 5 + calladdr
@@
-245,7
+245,7
@@
emitFromBB method cls hmap = do
push eax
-- TODO(bernhard): save reference somewhere for GC
-- set method table pointer
push eax
-- TODO(bernhard): save reference somewhere for GC
-- set method table pointer
-
let mtable = unsafePerform
IO $ getMethodTable objname
+
mtable <- lift
IO $ getMethodTable objname
mov (Disp 0, eax) mtable
emit (CHECKCAST _) = nop -- TODO(bernhard): ...
emit (BIPUSH val) = push ((fromIntegral val) :: Word32)
mov (Disp 0, eax) mtable
emit (CHECKCAST _) = nop -- TODO(bernhard): ...
emit (BIPUSH val) = push ((fromIntegral val) :: Word32)
@@
-272,20
+272,20
@@
emitFromBB method cls hmap = do
emit (LDC1 x) = emit (LDC2 $ fromIntegral x)
emit (LDC2 x) = do
emit (LDC1 x) = emit (LDC2 $ fromIntegral x)
emit (LDC2 x) = do
-
let value =
case (constsPool cls) M.! x of
- (CString s) ->
unsafePerform
IO $ getUniqueStringAddr s
+
value <-
case (constsPool cls) M.! x of
+ (CString s) ->
lift
IO $ getUniqueStringAddr s
_ -> error $ "LDCI... missing impl."
push value
emit (GETFIELD x) = do
pop eax -- this pointer
let (cname, fname) = buildFieldOffset cls x
_ -> error $ "LDCI... missing impl."
push value
emit (GETFIELD x) = do
pop eax -- this pointer
let (cname, fname) = buildFieldOffset cls x
-
let offset = unsafePerform
IO $ getFieldOffset cname fname
+
offset <- lift
IO $ 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
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 = unsafePerform
IO $ getFieldOffset cname fname
+
offset <- lift
IO $ getFieldOffset cname fname
mov (Disp (fromIntegral $ offset * 4), eax) ebx -- set field
emit IADD = do pop ebx; pop eax; add eax ebx; push eax
mov (Disp (fromIntegral $ offset * 4), eax) ebx -- set field
emit IADD = do pop ebx; pop eax; add eax ebx; push eax