summaryrefslogtreecommitdiff
path: root/compiler/codeGen/CgCallConv.hs
diff options
context:
space:
mode:
Diffstat (limited to 'compiler/codeGen/CgCallConv.hs')
-rw-r--r--compiler/codeGen/CgCallConv.hs23
1 files changed, 11 insertions, 12 deletions
diff --git a/compiler/codeGen/CgCallConv.hs b/compiler/codeGen/CgCallConv.hs
index 752769f4e3..87c69b6331 100644
--- a/compiler/codeGen/CgCallConv.hs
+++ b/compiler/codeGen/CgCallConv.hs
@@ -39,7 +39,6 @@ import CgUtils
import CgMonad
import SMRep
-import MachOp
import Cmm
import CLabel
@@ -149,7 +148,7 @@ mkLiveness :: Name -> Int -> Bitmap -> FCode Liveness
mkLiveness name size bits
| size > mAX_SMALL_BITMAP_SIZE -- Bitmap does not fit in one word
= do { let lbl = mkBitmapLabel (getUnique name)
- ; emitRODataLits lbl ( mkWordCLit (fromIntegral size)
+ ; emitRODataLits "mkLiveness" lbl ( mkWordCLit (fromIntegral size)
: map mkWordCLit bits)
; return (BigLiveness lbl) }
@@ -196,7 +195,7 @@ mkRegLiveness regs ptrs nptrs
all_non_ptrs = 0xff
reg_bits [] = 0
- reg_bits ((id, VanillaReg i) : regs) | isFollowableArg (idCgRep id)
+ reg_bits ((id, VanillaReg i _) : regs) | isFollowableArg (idCgRep id)
= (1 `shiftL` (i - 1)) .|. reg_bits regs
reg_bits (_ : regs)
= reg_bits regs
@@ -264,8 +263,8 @@ slowCallPattern _ = panic "CgStackery.slowCallPattern"
-------------------------------------------------------------------------
dataReturnConvPrim :: CgRep -> CmmReg
-dataReturnConvPrim PtrArg = CmmGlobal (VanillaReg 1)
-dataReturnConvPrim NonPtrArg = CmmGlobal (VanillaReg 1)
+dataReturnConvPrim PtrArg = CmmGlobal (VanillaReg 1 VGcPtr)
+dataReturnConvPrim NonPtrArg = CmmGlobal (VanillaReg 1 VNonGcPtr)
dataReturnConvPrim LongArg = CmmGlobal (LongReg 1)
dataReturnConvPrim FloatArg = CmmGlobal (FloatReg 1)
dataReturnConvPrim DoubleArg = CmmGlobal (DoubleReg 1)
@@ -288,7 +287,7 @@ getSequelAmode
= do { EndOfBlockInfo virt_sp sequel <- getEndOfBlockInfo
; case sequel of
OnStack -> do { sp_rel <- getSpRelOffset virt_sp
- ; returnFC (CmmLoad sp_rel wordRep) }
+ ; returnFC (CmmLoad sp_rel bWord) }
UpdateCode -> returnFC (CmmLit (CmmLabel mkUpdInfoLabel))
CaseAlts lbl _ _ -> returnFC (CmmLit (CmmLabel lbl))
@@ -361,7 +360,7 @@ assign_regs args supply
where
go [] acc supply = (acc, []) -- Return the results reversed (doesn't matter)
go ((VoidArg,_) : args) acc supply -- Skip void arguments; they aren't passed, and
- = go args acc supply -- there's nothign to bind them to
+ = go args acc supply -- there's nothing to bind them to
go ((rep,arg) : args) acc supply
= case assign_reg rep supply of
Just (reg, supply') -> go args ((arg,reg):acc) supply'
@@ -370,9 +369,9 @@ assign_regs args supply
assign_reg :: CgRep -> AvailRegs -> Maybe (GlobalReg, AvailRegs)
assign_reg FloatArg (vs, f:fs, ds, ls) = Just (FloatReg f, (vs, fs, ds, ls))
assign_reg DoubleArg (vs, fs, d:ds, ls) = Just (DoubleReg d, (vs, fs, ds, ls))
-assign_reg LongArg (vs, fs, ds, l:ls) = Just (LongReg l, (vs, fs, ds, ls))
-assign_reg PtrArg (v:vs, fs, ds, ls) = Just (VanillaReg v, (vs, fs, ds, ls))
-assign_reg NonPtrArg (v:vs, fs, ds, ls) = Just (VanillaReg v, (vs, fs, ds, ls))
+assign_reg LongArg (vs, fs, ds, l:ls) = pprTrace "longArg" (ppr l) $ Just (LongReg l, (vs, fs, ds, ls))
+assign_reg PtrArg (v:vs, fs, ds, ls) = Just (VanillaReg v VGcPtr, (vs, fs, ds, ls))
+assign_reg NonPtrArg (v:vs, fs, ds, ls) = Just (VanillaReg v VNonGcPtr, (vs, fs, ds, ls))
-- PtrArg and NonPtrArg both go in a vanilla register
assign_reg other not_enough_regs = Nothing
@@ -430,11 +429,11 @@ mkRegTbl_allRegs regs_in_use
mkRegTbl' regs_in_use vanillas floats doubles longs
= (ok_vanilla, ok_float, ok_double, ok_long)
where
- ok_vanilla = mapCatMaybes (select VanillaReg) vanillas
+ ok_vanilla = mapCatMaybes (select (\i -> VanillaReg i VNonGcPtr)) vanillas
+ -- ptrhood isn't looked at, hence we can use any old rep.
ok_float = mapCatMaybes (select FloatReg) floats
ok_double = mapCatMaybes (select DoubleReg) doubles
ok_long = mapCatMaybes (select LongReg) longs
- -- rep isn't looked at, hence we can use any old rep.
select :: (Int -> GlobalReg) -> Int{-cand-} -> Maybe Int
-- one we've unboxed the Int, we make a GlobalReg