cmm: Introduce cmmLoadBWord and cmmLoadGCWord

11 files changed, 31 insertions, 23 deletions

diff --git a/compiler/GHC/Cmm/Info.hs b/compiler/GHC/Cmm/Info.hs
index 53e1b67fcc..db6d92ced6 100644
--- a/compiler/GHC/Cmm/Info.hs
+++ b/compiler/GHC/Cmm/Info.hs
@@ -450,7 +450,7 @@ wordAligned platform align_check e
 -- | Takes a closure pointer and returns the info table pointer
 closureInfoPtr :: Platform -> DoAlignSanitisation -> CmmExpr -> CmmExpr
 closureInfoPtr platform align_check e =
-    CmmLoad (wordAligned platform align_check e) (bWord platform)
+    cmmLoadBWord platform (wordAligned platform align_check e)
 
 -- | Takes an info pointer (the first word of a closure) and returns its entry
 -- code
@@ -458,7 +458,7 @@ entryCode :: Platform -> CmmExpr -> CmmExpr
 entryCode platform e =
  if platformTablesNextToCode platform
       then e
-      else CmmLoad e (bWord platform)
+      else cmmLoadBWord platform e
 
 -- | Takes a closure pointer, and return the *zero-indexed*
 -- constructor tag obtained from the info table
diff --git a/compiler/GHC/Cmm/LayoutStack.hs b/compiler/GHC/Cmm/LayoutStack.hs
index 1bd00ed65a..f23af80d7e 100644
--- a/compiler/GHC/Cmm/LayoutStack.hs
+++ b/compiler/GHC/Cmm/LayoutStack.hs
@@ -1164,7 +1164,7 @@ lowerSafeForeignCall profile block
         -- different.  Hence we continue by jumping to the top stack frame,
         -- not by jumping to succ.
         jump = CmmCall { cml_target    = entryCode platform $
-                                         CmmLoad spExpr (bWord platform)
+                                         cmmLoadBWord platform spExpr
                        , cml_cont      = Just succ
                        , cml_args_regs = regs
                        , cml_args      = widthInBytes (wordWidth platform)
diff --git a/compiler/GHC/Cmm/Parser.y b/compiler/GHC/Cmm/Parser.y
index 68d5821309..065737922f 100644
--- a/compiler/GHC/Cmm/Parser.y
+++ b/compiler/GHC/Cmm/Parser.y
@@ -1289,8 +1289,7 @@ doReturn exprs_code = do
 mkReturnSimple  :: Profile -> [CmmActual] -> UpdFrameOffset -> CmmAGraph
 mkReturnSimple profile actuals updfr_off =
   mkReturn profile e actuals updfr_off
-  where e = entryCode platform (CmmLoad (CmmStackSlot Old updfr_off)
-                             (gcWord platform))
+  where e = entryCode platform (cmmLoadGCWord platform (CmmStackSlot Old updfr_off))
         platform = profilePlatform profile
 
 doRawJump :: CmmParse CmmExpr -> [GlobalReg] -> CmmParse ()
diff --git a/compiler/GHC/Cmm/Utils.hs b/compiler/GHC/Cmm/Utils.hs
index 596b8d050f..b541d7a95c 100644
--- a/compiler/GHC/Cmm/Utils.hs
+++ b/compiler/GHC/Cmm/Utils.hs
@@ -31,6 +31,7 @@ module GHC.Cmm.Utils(
         cmmRegOffB, cmmOffsetB, cmmLabelOffB, cmmOffsetLitB, cmmOffsetExprB,
         cmmRegOffW, cmmOffsetW, cmmLabelOffW, cmmOffsetLitW, cmmOffsetExprW,
         cmmIndex, cmmIndexExpr, cmmLoadIndex, cmmLoadIndexW,
+        cmmLoadBWord, cmmLoadGCWord,
         cmmNegate,
         cmmULtWord, cmmUGeWord, cmmUGtWord, cmmUShrWord,
         cmmSLtWord,
@@ -306,6 +307,14 @@ cmmIndexExpr platform width base idx =
 cmmLoadIndex :: Platform -> CmmType -> CmmExpr -> Int -> CmmExpr
 cmmLoadIndex platform ty expr ix = CmmLoad (cmmIndex platform (typeWidth ty) expr ix) ty
 
+-- | Load a non-pointer word.
+cmmLoadBWord :: Platform -> CmmExpr -> CmmExpr
+cmmLoadBWord platform ptr = CmmLoad ptr (bWord platform)
+
+-- | Load a GC pointer.
+cmmLoadGCWord :: Platform -> CmmExpr -> CmmExpr
+cmmLoadGCWord platform ptr = CmmLoad ptr (gcWord platform)
+
 -- The "B" variants take byte offsets
 cmmRegOffB :: CmmReg -> ByteOff -> CmmExpr
 cmmRegOffB = cmmRegOff
diff --git a/compiler/GHC/CmmToAsm/PIC.hs b/compiler/GHC/CmmToAsm/PIC.hs
index 8a728102e5..2bf8a58fd6 100644
--- a/compiler/GHC/CmmToAsm/PIC.hs
+++ b/compiler/GHC/CmmToAsm/PIC.hs
@@ -63,6 +63,7 @@ import GHC.CmmToAsm.Types
 import GHC.Cmm.Dataflow.Collections
 import GHC.Cmm
 import GHC.Cmm.CLabel
+import GHC.Cmm.Utils (cmmLoadBWord)
 
 import GHC.Types.Basic
 
@@ -134,7 +135,7 @@ cmmMakeDynamicReference config referenceKind lbl
         AccessViaSymbolPtr -> do
               let symbolPtr = mkDynamicLinkerLabel SymbolPtr lbl
               addImport symbolPtr
-              return $ CmmLoad (cmmMakePicReference config symbolPtr) (bWord platform)
+              return $ cmmLoadBWord platform (cmmMakePicReference config symbolPtr)
 
         AccessDirectly -> case referenceKind of
                 -- for data, we might have to make some calculations:
diff --git a/compiler/GHC/StgToCmm/Foreign.hs b/compiler/GHC/StgToCmm/Foreign.hs
index a1ee175bad..e3cd4d8db1 100644
--- a/compiler/GHC/StgToCmm/Foreign.hs
+++ b/compiler/GHC/StgToCmm/Foreign.hs
@@ -303,10 +303,9 @@ saveThreadState profile = do
 
    , -- tso->stackobj->sp = Sp;
      mkStore (cmmOffset platform
-                        (CmmLoad (cmmOffset platform
+                        (cmmLoadBWord platform (cmmOffset platform
                                             (CmmReg (CmmLocal tso))
-                                            (tso_stackobj profile))
-                                 (bWord platform))
+                                            (tso_stackobj profile)))
                         (stack_SP profile))
              spExpr
 
@@ -444,7 +443,7 @@ closeNursery profile tso = do
     let alloc =
            CmmMachOp (mo_wordSub platform)
               [ cmmOffsetW platform hpExpr 1
-              , CmmLoad (nursery_bdescr_start platform cnreg) (bWord platform)
+              , cmmLoadBWord platform (nursery_bdescr_start platform cnreg)
               ]
 
         alloc_limit = cmmOffset platform (CmmReg tsoreg) (tso_alloc_limit profile)
@@ -473,9 +472,9 @@ loadThreadState profile = do
     -- tso = CurrentTSO;
     mkAssign (CmmLocal tso) currentTSOExpr,
     -- stack = tso->stackobj;
-    mkAssign (CmmLocal stack) (CmmLoad (cmmOffset platform (CmmReg (CmmLocal tso)) (tso_stackobj profile)) (bWord platform)),
+    mkAssign (CmmLocal stack) (cmmLoadBWord platform (cmmOffset platform (CmmReg (CmmLocal tso)) (tso_stackobj profile))),
     -- Sp = stack->sp;
-    mkAssign spReg (CmmLoad (cmmOffset platform (CmmReg (CmmLocal stack)) (stack_SP profile)) (bWord platform)),
+    mkAssign spReg (cmmLoadBWord platform (cmmOffset platform (CmmReg (CmmLocal stack)) (stack_SP profile))),
     -- SpLim = stack->stack + RESERVED_STACK_WORDS;
     mkAssign spLimReg (cmmOffsetW platform (cmmOffset platform (CmmReg (CmmLocal stack)) (stack_STACK profile))
                                 (pc_RESERVED_STACK_WORDS (platformConstants platform))),
@@ -543,12 +542,12 @@ openNursery profile tso = do
   -- stg_returnToStackTop in rts/StgStartup.cmm.
   pure $ catAGraphs [
      mkAssign cnreg currentNurseryExpr,
-     mkAssign bdfreereg  (CmmLoad (nursery_bdescr_free platform cnreg)  (bWord platform)),
+     mkAssign bdfreereg  (cmmLoadBWord platform (nursery_bdescr_free platform cnreg)),
 
      -- Hp = CurrentNursery->free - 1;
      mkAssign hpReg (cmmOffsetW platform (CmmReg bdfreereg) (-1)),
 
-     mkAssign bdstartreg (CmmLoad (nursery_bdescr_start platform cnreg) (bWord platform)),
+     mkAssign bdstartreg (cmmLoadBWord platform (nursery_bdescr_start platform cnreg)),
 
      -- HpLim = CurrentNursery->start +
      --              CurrentNursery->blocks*BLOCK_SIZE_W - 1;
diff --git a/compiler/GHC/StgToCmm/Layout.hs b/compiler/GHC/StgToCmm/Layout.hs
index 5664be908e..0857cf5db2 100644
--- a/compiler/GHC/StgToCmm/Layout.hs
+++ b/compiler/GHC/StgToCmm/Layout.hs
@@ -90,7 +90,7 @@ emitReturn results
        ; case sequel of
            Return ->
              do { adjustHpBackwards
-                ; let e = CmmLoad (CmmStackSlot Old updfr_off) (gcWord platform)
+                ; let e = cmmLoadGCWord platform (CmmStackSlot Old updfr_off)
                 ; emit (mkReturn profile (entryCode platform e) results updfr_off)
                 }
            AssignTo regs adjust ->
diff --git a/compiler/GHC/StgToCmm/Prim.hs b/compiler/GHC/StgToCmm/Prim.hs
index b980c0aacd..72f42ba831 100644
--- a/compiler/GHC/StgToCmm/Prim.hs
+++ b/compiler/GHC/StgToCmm/Prim.hs
@@ -2169,7 +2169,7 @@ doWritePtrArrayOp addr idx val
          ) (CmmLit (CmmInt 1 W8))
 
 loadArrPtrsSize :: Profile -> CmmExpr -> CmmExpr
-loadArrPtrsSize profile addr = CmmLoad (cmmOffsetB platform addr off) (bWord platform)
+loadArrPtrsSize profile addr = cmmLoadBWord platform (cmmOffsetB platform addr off)
  where off = fixedHdrSize profile + pc_OFFSET_StgMutArrPtrs_ptrs (profileConstants profile)
        platform = profilePlatform profile
 
@@ -3258,7 +3258,7 @@ doPtrArrayBoundsCheck
 doPtrArrayBoundsCheck idx arr = do
     profile <- getProfile
     platform <- getPlatform
-    let sz = CmmLoad (cmmOffsetB platform arr sz_off) (bWord platform)
+    let sz = cmmLoadBWord platform (cmmOffset platform arr sz_off)
         sz_off = fixedHdrSize profile + pc_OFFSET_StgMutArrPtrs_ptrs (platformConstants platform)
     doBoundsCheck idx sz
 
@@ -3269,7 +3269,7 @@ doSmallPtrArrayBoundsCheck
 doSmallPtrArrayBoundsCheck idx arr = do
     profile <- getProfile
     platform <- getPlatform
-    let sz = CmmLoad (cmmOffsetB platform arr sz_off) (bWord platform)
+    let sz = cmmLoadBWord platform (cmmOffset platform arr sz_off)
         sz_off = fixedHdrSize profile + pc_OFFSET_StgSmallMutArrPtrs_ptrs (platformConstants platform)
     doBoundsCheck idx sz
 
@@ -3282,7 +3282,7 @@ doByteArrayBoundsCheck
 doByteArrayBoundsCheck idx arr idx_ty elem_ty = do
     profile <- getProfile
     platform <- getPlatform
-    let sz = CmmLoad (cmmOffsetB platform arr sz_off) (bWord platform)
+    let sz = cmmLoadBWord platform (cmmOffset platform arr sz_off)
         sz_off = fixedHdrSize profile + pc_OFFSET_StgArrBytes_bytes (platformConstants platform)
         elem_sz = widthInBytes $ typeWidth elem_ty
         idx_sz = widthInBytes $ typeWidth idx_ty
diff --git a/compiler/GHC/StgToCmm/Prof.hs b/compiler/GHC/StgToCmm/Prof.hs
index 8af9189e9a..bb3d4a8696 100644
--- a/compiler/GHC/StgToCmm/Prof.hs
+++ b/compiler/GHC/StgToCmm/Prof.hs
@@ -396,7 +396,7 @@ ldvEnter cl_ptr = do
         -- don't forget to subtract node's tag
         ldv_wd = ldvWord platform cl_ptr
         new_ldv_wd = cmmOrWord platform
-                        (cmmAndWord platform (CmmLoad ldv_wd (bWord platform))
+                        (cmmAndWord platform (cmmLoadBWord platform ldv_wd)
                                              (CmmLit (mkWordCLit platform (pc_ILDV_CREATE_MASK constants))))
                         (cmmOrWord platform (loadEra platform) (CmmLit (mkWordCLit platform (pc_ILDV_STATE_USE constants))))
     ifProfiling $
diff --git a/compiler/GHC/StgToCmm/Ticky.hs b/compiler/GHC/StgToCmm/Ticky.hs
index 2a543b6553..118c05d920 100644
--- a/compiler/GHC/StgToCmm/Ticky.hs
+++ b/compiler/GHC/StgToCmm/Ticky.hs
@@ -374,7 +374,7 @@ registerTickyCtr ctr_lbl = do
     let locked = cmmEqWord platform (CmmReg $ CmmLocal old) (zeroExpr platform)
     emit =<< mkCmmIfThen locked register_stmts
 
-  let test = cmmEqWord platform (CmmLoad registeredp (bWord platform)) (zeroExpr platform)
+  let test = cmmEqWord platform (cmmLoadBWord platform registeredp) (zeroExpr platform)
   emit =<< mkCmmIfThen test cas_test
 
 tickyReturnOldCon, tickyReturnNewCon :: RepArity -> FCode ()
diff --git a/compiler/GHC/StgToCmm/Utils.hs b/compiler/GHC/StgToCmm/Utils.hs
index 67fb8c621e..22e34dddae 100644
--- a/compiler/GHC/StgToCmm/Utils.hs
+++ b/compiler/GHC/StgToCmm/Utils.hs
@@ -146,7 +146,7 @@ mkTaggedObjectLoad platform reg base offset tag
 
 tagToClosure :: Platform -> TyCon -> CmmExpr -> CmmExpr
 tagToClosure platform tycon tag
-  = CmmLoad (cmmOffsetExprW platform closure_tbl tag) (bWord platform)
+  = cmmLoadBWord platform (cmmOffsetExprW platform closure_tbl tag)
   where closure_tbl = CmmLit (CmmLabel lbl)
         lbl = mkClosureTableLabel (tyConName tycon) NoCafRefs
 
@@ -561,7 +561,7 @@ whenUpdRemSetEnabled code = do
     platform <- getPlatform
     do_it <- getCode code
     let
-      enabled = CmmLoad (CmmLit $ CmmLabel mkNonmovingWriteBarrierEnabledLabel) (bWord platform)
+      enabled = cmmLoadBWord platform (CmmLit $ CmmLabel mkNonmovingWriteBarrierEnabledLabel)
       zero = zeroExpr platform
       is_enabled = cmmNeWord platform enabled zero
     the_if <- mkCmmIfThenElse' is_enabled do_it mkNop (Just False)