import CgMonad
import SMRep
-import MachOp
import Cmm
import CLabel
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) }
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
-------------------------------------------------------------------------
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)
= 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))
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'
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
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