Pass DynFlags down to gcWord
authorIan Lynagh <ian@well-typed.com>
Wed, 12 Sep 2012 11:37:01 +0000 (12:37 +0100)
committerIan Lynagh <ian@well-typed.com>
Wed, 12 Sep 2012 11:37:01 +0000 (12:37 +0100)
15 files changed:
compiler/cmm/CmmExpr.hs
compiler/cmm/CmmLayoutStack.hs
compiler/cmm/CmmParse.y
compiler/cmm/CmmType.hs
compiler/cmm/CmmUtils.hs
compiler/cmm/MkGraph.hs
compiler/codeGen/CgForeignCall.hs
compiler/codeGen/CgPrimOp.hs
compiler/codeGen/CgUtils.hs
compiler/codeGen/ClosureInfo.lhs
compiler/codeGen/StgCmmEnv.hs
compiler/codeGen/StgCmmForeign.hs
compiler/codeGen/StgCmmPrim.hs
compiler/llvmGen/LlvmCodeGen/Base.hs
compiler/llvmGen/LlvmCodeGen/CodeGen.hs

index 3387b3f..128eb1c 100644 (file)
@@ -133,7 +133,7 @@ cmmLitType dflags (CmmHighStackMark)   = bWord dflags
 
 cmmLabelType :: DynFlags -> CLabel -> CmmType
 cmmLabelType dflags lbl
- | isGcPtrLabel lbl = gcWord
+ | isGcPtrLabel lbl = gcWord dflags
  | otherwise        = bWord dflags
 
 cmmExprWidth :: DynFlags -> CmmExpr -> Width
@@ -415,11 +415,12 @@ node :: GlobalReg
 node = VanillaReg 1 VGcPtr
 
 globalRegType :: DynFlags -> GlobalReg -> CmmType
-globalRegType _      (VanillaReg _ VGcPtr)    = gcWord
+globalRegType dflags (VanillaReg _ VGcPtr)    = gcWord dflags
 globalRegType dflags (VanillaReg _ VNonGcPtr) = bWord dflags
 globalRegType _      (FloatReg _)      = cmmFloat W32
 globalRegType _      (DoubleReg _)     = cmmFloat W64
 globalRegType _      (LongReg _)       = cmmBits W64
-globalRegType _      Hp                = gcWord    -- The initialiser for all
+globalRegType dflags Hp                = gcWord dflags
+                                            -- The initialiser for all
                                             -- dynamically allocated closures
 globalRegType dflags _                 = bWord dflags
index 27054bb..0ddbfb6 100644 (file)
@@ -916,8 +916,8 @@ lowerSafeForeignCall dflags block
     id <- newTemp (bWord dflags)
     new_base <- newTemp (cmmRegType dflags (CmmGlobal BaseReg))
     let (caller_save, caller_load) = callerSaveVolatileRegs dflags
-    load_tso <- newTemp gcWord
-    load_stack <- newTemp gcWord
+    load_tso <- newTemp (gcWord dflags)
+    load_stack <- newTemp (gcWord dflags)
     let suspend = saveThreadState dflags <*>
                   caller_save <*>
                   mkMiddle (callSuspendThread id intrbl)
index d7df52a..bfde123 100644 (file)
@@ -611,7 +611,7 @@ typenot8 :: { CmmType }
         | 'bits64'              { b64 }
         | 'float32'             { f32 }
         | 'float64'             { f64 }
-        | 'gcptr'               { gcWord }
+        | 'gcptr'               {% do dflags <- getDynFlags; return $ gcWord dflags }
 {
 section :: String -> Section
 section "text"      = Text
index db5db9b..4c5d6b1 100644 (file)
@@ -102,8 +102,8 @@ bWord _ = cmmBits wordWidth
 bHalfWord :: DynFlags -> CmmType
 bHalfWord dflags = cmmBits (halfWordWidth dflags)
 
-gcWord :: CmmType
-gcWord = CmmType GcPtrCat wordWidth
+gcWord :: DynFlags -> CmmType
+gcWord = CmmType GcPtrCat wordWidth
 
 cInt, cLong :: CmmType
 cInt  = cmmBits cIntWidth
index bc09217..07130f3 100644 (file)
@@ -89,7 +89,7 @@ import Hoopl
 
 primRepCmmType :: DynFlags -> PrimRep -> CmmType
 primRepCmmType _      VoidRep    = panic "primRepCmmType:VoidRep"
-primRepCmmType _      PtrRep     = gcWord
+primRepCmmType dflags PtrRep     = gcWord dflags
 primRepCmmType dflags IntRep     = bWord dflags
 primRepCmmType dflags WordRep    = bWord dflags
 primRepCmmType _      Int64Rep   = b64
index 6bcdcaa..d9dfb42 100644 (file)
@@ -231,7 +231,7 @@ mkReturn dflags e actuals updfr_off =
 mkReturnSimple  :: DynFlags -> [CmmActual] -> UpdFrameOffset -> CmmAGraph
 mkReturnSimple dflags actuals updfr_off =
   mkReturn dflags e actuals updfr_off
-  where e = CmmLoad (CmmStackSlot Old updfr_off) gcWord
+  where e = CmmLoad (CmmStackSlot Old updfr_off) (gcWord dflags)
 
 mkBranch        :: BlockId -> CmmAGraph
 mkBranch bid     = mkLast (CmmBranch bid)
index 48f674a..213745d 100644 (file)
@@ -256,7 +256,7 @@ emitOpenNursery =
    do dflags <- getDynFlags
       stmtsC [
         -- Hp = CurrentNursery->free - 1;
-        CmmAssign hp (cmmOffsetW dflags (CmmLoad (nursery_bdescr_free dflags) gcWord) (-1)),
+        CmmAssign hp (cmmOffsetW dflags (CmmLoad (nursery_bdescr_free dflags) (gcWord dflags)) (-1)),
 
         -- HpLim = CurrentNursery->start +
         --              CurrentNursery->blocks*BLOCK_SIZE_W - 1;
index 92ff418..aaa97a2 100644 (file)
@@ -167,7 +167,7 @@ emitPrimOp _      [res] GetCurrentCCSOp [_dummy_arg] _live
    = stmtC (CmmAssign (CmmLocal res) curCCS)
 
 emitPrimOp dflags [res] ReadMutVarOp [mutv] _
-   = stmtC (CmmAssign (CmmLocal res) (cmmLoadIndexW dflags mutv (fixedHdrSize dflags) gcWord))
+   = stmtC (CmmAssign (CmmLocal res) (cmmLoadIndexW dflags mutv (fixedHdrSize dflags) (gcWord dflags)))
 
 emitPrimOp dflags [] WriteMutVarOp [mutv,var] live
    = do stmtC (CmmStore (cmmOffsetW dflags mutv (fixedHdrSize dflags)) var)
@@ -818,7 +818,7 @@ doIndexByteArrayOp _ _ _ _
 doReadPtrArrayOp :: LocalReg -> CmmExpr -> CmmExpr -> Code
 doReadPtrArrayOp res addr idx
    = do dflags <- getDynFlags
-        mkBasicIndexedRead (arrPtrsHdrSize dflags) Nothing gcWord res addr idx
+        mkBasicIndexedRead (arrPtrsHdrSize dflags) Nothing (gcWord dflags) res addr idx
 
 
 doWriteOffAddrOp, doWriteByteArrayOp
index 29554c8..ca03dfa 100644 (file)
@@ -184,7 +184,7 @@ addToMemE width ptr n
 
 tagToClosure :: DynFlags -> TyCon -> CmmExpr -> CmmExpr
 tagToClosure dflags tycon tag
-  = CmmLoad (cmmOffsetExprW dflags closure_tbl tag) gcWord
+  = CmmLoad (cmmOffsetExprW dflags closure_tbl tag) (gcWord dflags)
   where closure_tbl = CmmLit (CmmLabel lbl)
         lbl = mkClosureTableLabel (tyConName tycon) NoCafRefs
 
index 88174b9..1b1c360 100644 (file)
@@ -266,7 +266,7 @@ instance Outputable CgRep where
     ppr DoubleArg = ptext (sLit "D_")
 
 argMachRep :: DynFlags -> CgRep -> CmmType
-argMachRep _      PtrArg    = gcWord
+argMachRep dflags PtrArg    = gcWord dflags
 argMachRep dflags NonPtrArg = bWord dflags
 argMachRep _      LongArg   = b64
 argMachRep _      FloatArg  = f32
index 10fc202..664a606 100644 (file)
@@ -102,8 +102,9 @@ lneIdInfo dflags id regs
 
 rhsIdInfo :: Id -> LambdaFormInfo -> FCode (CgIdInfo, LocalReg)
 rhsIdInfo id lf_info
-  = do { reg <- newTemp gcWord
-       ; return (mkCgIdInfo id lf_info (CmmReg (CmmLocal reg)), reg) }
+  = do dflags <- getDynFlags
+       reg <- newTemp (gcWord dflags)
+       return (mkCgIdInfo id lf_info (CmmReg (CmmLocal reg)), reg)
 
 mkRhsInit :: DynFlags -> LocalReg -> LambdaFormInfo -> CmmExpr -> CmmAGraph
 mkRhsInit dflags reg lf_info expr
index eb5850f..0a6b6b9 100644 (file)
@@ -292,7 +292,7 @@ emitSaveThreadState bid = do
 
   -- CurrentTSO->stackobj->sp = Sp;
   emitStore (cmmOffset dflags (CmmLoad (cmmOffset dflags stgCurrentTSO (tso_stackobj dflags)) (bWord dflags)) (stack_SP dflags))
-                 (CmmStackSlot (Young bid) (widthInBytes (typeWidth gcWord)))
+                 (CmmStackSlot (Young bid) (widthInBytes (typeWidth (gcWord dflags))))
   emit $ closeNursery dflags
   -- and save the current cost centre stack in the TSO when profiling:
   when (dopt Opt_SccProfilingOn dflags) $
@@ -304,8 +304,8 @@ closeNursery dflags = mkStore (nursery_bdescr_free dflags) (cmmOffsetW dflags st
 
 loadThreadState :: DynFlags -> LocalReg -> LocalReg -> CmmAGraph
 loadThreadState dflags tso stack = do
-  -- tso <- newTemp gcWord -- TODO FIXME NOW
-  -- stack <- newTemp gcWord -- TODO FIXME NOW
+  -- tso <- newTemp (gcWord dflags) -- TODO FIXME NOW
+  -- stack <- newTemp (gcWord dflags) -- TODO FIXME NOW
   catAGraphs [
         -- tso = CurrentTSO;
         mkAssign (CmmLocal tso) stgCurrentTSO,
index aa803e0..e16557e 100644 (file)
@@ -248,7 +248,7 @@ emitPrimOp _ [res] GetCurrentCCSOp [_dummy_arg]
    = emitAssign (CmmLocal res) curCCS
 
 emitPrimOp dflags [res] ReadMutVarOp [mutv]
-   = emitAssign (CmmLocal res) (cmmLoadIndexW dflags mutv (fixedHdrSize dflags) gcWord)
+   = emitAssign (CmmLocal res) (cmmLoadIndexW dflags mutv (fixedHdrSize dflags) (gcWord dflags))
 
 emitPrimOp dflags [] WriteMutVarOp [mutv,var]
    = do emitStore (cmmOffsetW dflags mutv (fixedHdrSize dflags)) var
@@ -886,7 +886,7 @@ doIndexByteArrayOp _ _ _ _
 doReadPtrArrayOp ::  LocalReg -> CmmExpr -> CmmExpr -> FCode ()
 doReadPtrArrayOp res addr idx
    = do dflags <- getDynFlags
-        mkBasicIndexedRead (arrPtrsHdrSize dflags) Nothing gcWord res addr idx
+        mkBasicIndexedRead (arrPtrsHdrSize dflags) Nothing (gcWord dflags) res addr idx
 
 
 doWriteOffAddrOp :: Maybe MachOp -> [LocalReg] -> [CmmExpr] -> FCode ()
index d9a43fb..00c2129 100644 (file)
@@ -137,8 +137,8 @@ tysToParams :: [LlvmType] -> [LlvmParameter]
 tysToParams = map (\ty -> (ty, []))
 
 -- | Pointer width
-llvmPtrBits :: Int
-llvmPtrBits = widthInBits $ typeWidth gcWord
+llvmPtrBits :: DynFlags -> Int
+llvmPtrBits dflags = widthInBits $ typeWidth $ gcWord dflags
 
 -- ----------------------------------------------------------------------------
 -- * Llvm Version
index a4b7652..f80a4f2 100644 (file)
@@ -652,9 +652,10 @@ genStore_slow env addr val meta = do
         other ->
             pprPanic "genStore: ptr not right type!"
                     (PprCmm.pprExpr addr <+> text (
-                        "Size of Ptr: " ++ show llvmPtrBits ++
+                        "Size of Ptr: " ++ show (llvmPtrBits dflags) ++
                         ", Size of var: " ++ show (llvmWidthInBits other) ++
                         ", Var: " ++ show vaddr))
+    where dflags = getDflags env
 
 
 -- | Unconditional branch
@@ -1130,10 +1131,10 @@ genLoad_slow env e ty meta = do
 
          other -> pprPanic "exprToVar: CmmLoad expression is not right type!"
                         (PprCmm.pprExpr e <+> text (
-                            "Size of Ptr: " ++ show llvmPtrBits ++
+                            "Size of Ptr: " ++ show (llvmPtrBits dflags) ++
                             ", Size of var: " ++ show (llvmWidthInBits other) ++
                             ", Var: " ++ show iptr))
-
+    where dflags = getDflags env
 
 -- | Handle CmmReg expression
 --