Merging in the new codegen branch

[ghc-hetmet.git] / compiler / codeGen / CgCallConv.hs

diff --git a/compiler/codeGen/CgCallConv.hs b/compiler/codeGen/CgCallConv.hs
index 752769f..87c69b6 100644 (file)
--- 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