[commit: ghc] ghc-8.0: Fix Ticky histogram on Windows (b2796aa)

[git at git.haskell.org]

Repository : ssh://git@git.haskell.org/ghc

On branch  : ghc-8.0
Link       : http://ghc.haskell.org/trac/ghc/changeset/b2796aaee78f1e7d9dcd5285e48c955b390f514e/ghc

>---------------------------------------------------------------

commit b2796aaee78f1e7d9dcd5285e48c955b390f514e
Author: Tamar Christina <tamar at zhox.com>
Date:   Thu Jun 9 17:49:20 2016 +0200

    Fix Ticky histogram on Windows
    
    The histogram types are defined in `Ticky.c` as `StgInt` values.
    
    ```
    EXTERN StgInt RET_NEW_hst[TICKY_BIN_COUNT] INIT({0});
    EXTERN StgInt RET_OLD_hst[TICKY_BIN_COUNT] INIT({0});
    EXTERN StgInt RET_UNBOXED_TUP_hst[TICKY_BIN_COUNT] INIT({0});
    ```
    
    which means they'll be `32-bits` on `x86` and `64-bits` on `x86_64`.
    
    However the `bumpHistogram` in `StgCmmTicky` is incrementing them as if
    they're a `cLong`. A long on Windows `x86_64` is `32-bit`.
    
    As such when then value for the `_hst_1` is being set what it's actually doing
    is setting the value of the high bits of the first entry.
    
    This ends up giving us `0b‭100000000000000000000000000000000‬` or `4294967296`
    as is displayed in the ticket on #8308.
    
    Since `StgInt` is defined using the `WORD` size. Just use that directly in
    `bumpHistogram`.
    
    Also since `cLong` is no longer used after this commit it will also be dropped.
    
    Test Plan: make TEST=T8308
    
    Reviewers: mlen, jstolarek, bgamari, thomie, goldfire, simonmar, austin
    
    Reviewed By: bgamari, thomie
    
    Subscribers: #ghc_windows_task_force
    
    Differential Revision: https://phabricator.haskell.org/D2318
    
    GHC Trac Issues: #8308
    
    (cherry picked from commit b020db2a841c397a02ec352f8b6dc110b38b927b)


>---------------------------------------------------------------

b2796aaee78f1e7d9dcd5285e48c955b390f514e
 compiler/cmm/CmmType.hs         | 16 +++++-----------
 compiler/codeGen/StgCmmTicky.hs | 10 +++++-----
 2 files changed, 10 insertions(+), 16 deletions(-)

diff --git a/compiler/cmm/CmmType.hs b/compiler/cmm/CmmType.hs
index ae46330..4abbeaf 100644
--- a/compiler/cmm/CmmType.hs
+++ b/compiler/cmm/CmmType.hs
@@ -3,14 +3,14 @@
 module CmmType
     ( CmmType   -- Abstract
     , b8, b16, b32, b64, b128, b256, b512, f32, f64, bWord, bHalfWord, gcWord
-    , cInt, cLong
+    , cInt
     , cmmBits, cmmFloat
     , typeWidth, cmmEqType, cmmEqType_ignoring_ptrhood
     , isFloatType, isGcPtrType, isWord32, isWord64, isFloat64, isFloat32
 
     , Width(..)
     , widthInBits, widthInBytes, widthInLog, widthFromBytes
-    , wordWidth, halfWordWidth, cIntWidth, cLongWidth
+    , wordWidth, halfWordWidth, cIntWidth
     , halfWordMask
     , narrowU, narrowS
     , rEP_CostCentreStack_mem_alloc
@@ -129,10 +129,8 @@ bHalfWord dflags = cmmBits (halfWordWidth dflags)
 gcWord :: DynFlags -> CmmType
 gcWord dflags = CmmType GcPtrCat (wordWidth dflags)
 
-cInt, cLong :: DynFlags -> CmmType
-cInt  dflags = cmmBits (cIntWidth  dflags)
-cLong dflags = cmmBits (cLongWidth dflags)
-
+cInt :: DynFlags -> CmmType
+cInt dflags = cmmBits (cIntWidth  dflags)
 
 ------------ Predicates ----------------
 isFloatType, isGcPtrType :: CmmType -> Bool
@@ -207,15 +205,11 @@ halfWordMask dflags
  | otherwise             = panic "MachOp.halfWordMask: Unknown word size"
 
 -- cIntRep is the Width for a C-language 'int'
-cIntWidth, cLongWidth :: DynFlags -> Width
+cIntWidth :: DynFlags -> Width
 cIntWidth dflags = case cINT_SIZE dflags of
                    4 -> W32
                    8 -> W64
                    s -> panic ("cIntWidth: Unknown cINT_SIZE: " ++ show s)
-cLongWidth dflags = case cLONG_SIZE dflags of
-                    4 -> W32
-                    8 -> W64
-                    s -> panic ("cIntWidth: Unknown cLONG_SIZE: " ++ show s)
 
 widthInBits :: Width -> Int
 widthInBits W8   = 8
diff --git a/compiler/codeGen/StgCmmTicky.hs b/compiler/codeGen/StgCmmTicky.hs
index cdbcd25..4118383 100644
--- a/compiler/codeGen/StgCmmTicky.hs
+++ b/compiler/codeGen/StgCmmTicky.hs
@@ -466,12 +466,12 @@ tickyAllocHeap genuine hp
                      (CmmLit (cmmLabelOffB ticky_ctr (oFFSET_StgEntCounter_allocs dflags)))
                      bytes,
             -- Bump the global allocation total ALLOC_HEAP_tot
-            addToMemLbl (cLong dflags)
+            addToMemLbl (bWord dflags)
                         (mkCmmDataLabel rtsUnitId (fsLit "ALLOC_HEAP_tot"))
                         bytes,
             -- Bump the global allocation counter ALLOC_HEAP_ctr
             if not genuine then mkNop
-            else addToMemLbl (cLong dflags)
+            else addToMemLbl (bWord dflags)
                              (mkCmmDataLabel rtsUnitId (fsLit "ALLOC_HEAP_ctr"))
                              1
             ]}
@@ -580,11 +580,11 @@ bumpHistogram :: FastString -> Int -> FCode ()
 bumpHistogram lbl n = do
     dflags <- getDynFlags
     let offset = n `min` (tICKY_BIN_COUNT dflags - 1)
-    emit (addToMem (cLong dflags)
+    emit (addToMem (bWord dflags)
            (cmmIndexExpr dflags
-                (cLongWidth dflags)
+                (wordWidth dflags)
                 (CmmLit (CmmLabel (mkCmmDataLabel rtsUnitId lbl)))
-                (CmmLit (CmmInt (fromIntegral offset) (cLongWidth dflags))))
+                (CmmLit (CmmInt (fromIntegral offset) (wordWidth dflags))))
            1)
 
 ------------------------------------------------------------------