Merging in the new codegen branch

[ghc-hetmet.git] / compiler / codeGen / CgHeapery.lhs

diff --git a/compiler/codeGen/CgHeapery.lhs b/compiler/codeGen/CgHeapery.lhs
index 66d41d3..2529891 100644 (file)
--- a/compiler/codeGen/CgHeapery.lhs
+++ b/compiler/codeGen/CgHeapery.lhs
@@ -42,9 +42,9 @@ import ClosureInfo
 import SMRep
 
 import Cmm
-import MachOp
 import CmmUtils
 import Id
+import IdInfo
 import DataCon
 import TyCon
 import CostCentre
@@ -191,7 +191,7 @@ mkStaticClosureFields cl_info ccs caf_refs payload
   = mkStaticClosure info_lbl ccs payload padding_wds 
        static_link_field saved_info_field
   where
-    info_lbl = infoTableLabelFromCI cl_info
+    info_lbl = infoTableLabelFromCI cl_info $ clHasCafRefs cl_info
 
     -- CAFs must have consistent layout, regardless of whether they
     -- are actually updatable or not.  The layout of a CAF is:
@@ -226,7 +226,6 @@ mkStaticClosureFields cl_info ccs caf_refs payload
        | caf_refs      = mkIntCLit 0
        | otherwise     = mkIntCLit 1
 
-
 mkStaticClosure :: CLabel -> CostCentreStack -> [CmmLit]
   -> [CmmLit] -> [CmmLit] -> [CmmLit] -> [CmmLit]
 mkStaticClosure info_lbl ccs payload padding_wds static_link_field saved_info_field
@@ -245,14 +244,14 @@ mkStaticClosure info_lbl ccs payload padding_wds static_link_field saved_info_fi
 
 padLitToWord :: CmmLit -> [CmmLit]
 padLitToWord lit = lit : padding pad_length
-  where rep = cmmLitRep lit
-        pad_length = wORD_SIZE - machRepByteWidth rep :: Int
+  where width = typeWidth (cmmLitType lit)
+        pad_length = wORD_SIZE - widthInBytes width :: Int
 
         padding n | n <= 0 = []
-                  | n `rem` 2 /= 0 = CmmInt 0 I8  : padding (n-1)
-                  | n `rem` 4 /= 0 = CmmInt 0 I16 : padding (n-2)
-                  | n `rem` 8 /= 0 = CmmInt 0 I32 : padding (n-4)
-                  | otherwise      = CmmInt 0 I64 : padding (n-8)
+                  | n `rem` 2 /= 0 = CmmInt 0 W8  : padding (n-1)
+                  | n `rem` 4 /= 0 = CmmInt 0 W16 : padding (n-2)
+                  | n `rem` 8 /= 0 = CmmInt 0 W32 : padding (n-4)
+                  | otherwise      = CmmInt 0 W64 : padding (n-8)
 \end{code}
 
 %************************************************************************
@@ -309,7 +308,7 @@ hpStkCheck cl_info is_fun reg_save_code code
         -- Strictly speaking, we should tag node here.  But if
         -- node doesn't point to the closure, the code for the closure
         -- cannot depend on the value of R1 anyway, so we're safe.
-    closure_lbl = closureLabelFromCI cl_info
+    closure_lbl = closureLabelFromCI cl_info (clHasCafRefs cl_info)
 
     full_save_code = node_asst `plusStmts` reg_save_code
 
@@ -410,7 +409,7 @@ unbxTupleHeapCheck regs ptrs nptrs fail_code code
        ; code }
   where
     full_fail_code  = fail_code `plusStmts` oneStmt assign_liveness
-    assign_liveness = CmmAssign (CmmGlobal (VanillaReg 9))     -- Ho ho ho!
+    assign_liveness = CmmAssign (CmmGlobal (VanillaReg 9 VNonGcPtr))   -- Ho ho ho!
                                (CmmLit (mkWordCLit liveness))
     liveness       = mkRegLiveness regs ptrs nptrs
     rts_label      = CmmLit (CmmLabel (mkRtsCodeLabel (sLit "stg_gc_ut")))
@@ -495,10 +494,8 @@ hpChkGen :: CmmExpr -> CmmExpr -> CmmExpr -> Code
 hpChkGen bytes liveness reentry
   = do_checks' (CmmLit (mkIntCLit 0)) bytes False True assigns stg_gc_gen
   where
-    assigns = mkStmts [
-               CmmAssign (CmmGlobal (VanillaReg 9))  liveness,
-               CmmAssign (CmmGlobal (VanillaReg 10)) reentry
-               ]
+    assigns = mkStmts [ mk_vanilla_assignment 9 liveness,
+                       mk_vanilla_assignment 10 reentry ]
 
 -- a heap check where R1 points to the closure to enter on return, and
 -- we want to assign to Sp[0] on failure (used in AutoApply.cmm:BUILD_PAP).
@@ -511,10 +508,12 @@ stkChkGen :: CmmExpr -> CmmExpr -> CmmExpr -> Code
 stkChkGen bytes liveness reentry
   = do_checks' bytes (CmmLit (mkIntCLit 0)) True False assigns stg_gc_gen
   where
-    assigns = mkStmts [
-               CmmAssign (CmmGlobal (VanillaReg 9))  liveness,
-               CmmAssign (CmmGlobal (VanillaReg 10)) reentry
-               ]
+    assigns = mkStmts [ mk_vanilla_assignment 9 liveness,
+                       mk_vanilla_assignment 10 reentry ]
+
+mk_vanilla_assignment :: Int -> CmmExpr -> CmmStmt
+mk_vanilla_assignment n e
+  = CmmAssign (CmmGlobal (VanillaReg n (vgcFlag (cmmExprType e)))) e
 
 stkChkNodePoints :: CmmExpr -> Code
 stkChkNodePoints bytes
@@ -554,7 +553,8 @@ allocDynClosure cl_info use_cc blame_cc amodes_with_offsets
                -- Remember, virtHp points to last allocated word, 
                -- ie 1 *before* the info-ptr word of new object.
 
-               info_ptr = CmmLit (CmmLabel (infoTableLabelFromCI cl_info))
+               info_ptr = CmmLit (CmmLabel (infoTableLabelFromCI cl_info
+                                                   (clHasCafRefs cl_info)))
                hdr_w_offsets = initDynHdr info_ptr use_cc `zip` [0..]
 
        -- SAY WHAT WE ARE ABOUT TO DO