[Git][ghc/ghc][wip/marge_bot_batch_merge_job] 3 commits: hadrian: add flag to skip rebuilding dependency information #17636

Marge Bot gitlab at gitlab.haskell.org
Thu Jul 9 08:09:18 UTC 2020



 Marge Bot pushed to branch wip/marge_bot_batch_merge_job at Glasgow Haskell Compiler / GHC


Commits:
3033e0e4 by Adam Sandberg Ericsson at 2020-07-08T20:36:49-04:00
hadrian: add flag to skip rebuilding dependency information #17636

- - - - -
fa533a79 by Stefan Schulze Frielinghaus at 2020-07-09T04:09:11-04:00
Fix GHCi :print on big-endian platforms

On big-endian platforms executing

  import GHC.Exts
  data Foo = Foo Float# deriving Show
  foo = Foo 42.0#
  foo
  :print foo

results in an arithmetic overflow exception which is caused by function
index where moveBytes equals
  word_size - (r + item_size_b) * 8
Here we have a mixture of units. Both, word_size and item_size_b have
unit bytes whereas r has unit bits.  On 64-bit platforms moveBytes
equals then
  8 - (0 + 4) * 8
which results in a negative and therefore invalid second parameter for a
shiftL operation.

In order to make things more clear the expression
  (word .&. (mask `shiftL` moveBytes)) `shiftR` moveBytes
is equivalent to
  (word `shiftR` moveBytes) .&. mask
On big-endian platforms the shift must be a left shift instead of a
right shift. For symmetry reasons not a mask is used but two shifts in
order to zero out bits. Thus the fixed version equals
  case endian of
    BigEndian    -> (word `shiftL` moveBits) `shiftR` zeroOutBits `shiftL` zeroOutBits
    LittleEndian -> (word `shiftR` moveBits) `shiftL` zeroOutBits `shiftR` zeroOutBits

Fixes #16548 and #14455

- - - - -
709797c6 by Sylvain Henry at 2020-07-09T04:09:15-04:00
LLVM: fix MO_S_Mul2 support (#18434)

The value indicating if the carry is useful wasn't taken into account.

- - - - -


7 changed files:

- compiler/GHC/CmmToLlvm/CodeGen.hs
- compiler/GHC/Runtime/Heap/Inspect.hs
- hadrian/README.md
- hadrian/doc/make.md
- hadrian/src/CommandLine.hs
- hadrian/src/Main.hs
- testsuite/tests/ghci.debugger/scripts/all.T


Changes:

=====================================
compiler/GHC/CmmToLlvm/CodeGen.hs
=====================================
@@ -353,7 +353,7 @@ genCall (PrimTarget (MO_U_Mul2 w)) [dstH, dstL] [lhs, rhs] = runStmtsDecls $ do
     statement $ Store retL dstRegL
     statement $ Store retH dstRegH
 
-genCall (PrimTarget (MO_S_Mul2 w)) [dstH, dstL] [lhs, rhs] = runStmtsDecls $ do
+genCall (PrimTarget (MO_S_Mul2 w)) [dstC, dstH, dstL] [lhs, rhs] = runStmtsDecls $ do
     let width = widthToLlvmInt w
         bitWidth = widthInBits w
         width2x = LMInt (bitWidth * 2)
@@ -373,10 +373,18 @@ genCall (PrimTarget (MO_S_Mul2 w)) [dstH, dstL] [lhs, rhs] = runStmtsDecls $ do
     retShifted <- doExprW width2x $ LlvmOp LM_MO_AShr retV widthLlvmLit
     -- And extract them into retH.
     retH <- doExprW width $ Cast LM_Trunc retShifted width
+    -- Check if the carry is useful by doing a full arithmetic right shift on
+    -- retL and comparing the result with retH
+    let widthLlvmLitm1 = LMLitVar $ LMIntLit (fromIntegral bitWidth - 1) width
+    retH' <- doExprW width $ LlvmOp LM_MO_AShr retL widthLlvmLitm1
+    retC1  <- doExprW i1 $ Compare LM_CMP_Ne retH retH' -- Compare op returns a 1-bit value (i1)
+    retC   <- doExprW width $ Cast LM_Zext retC1 width  -- so we zero-extend it
     dstRegL <- getCmmRegW (CmmLocal dstL)
     dstRegH <- getCmmRegW (CmmLocal dstH)
+    dstRegC <- getCmmRegW (CmmLocal dstC)
     statement $ Store retL dstRegL
     statement $ Store retH dstRegH
+    statement $ Store retC dstRegC
 
 -- MO_U_QuotRem2 is another case we handle by widening the registers to double
 -- the width and use normal LLVM instructions (similarly to the MO_U_Mul2). The


=====================================
compiler/GHC/Runtime/Heap/Inspect.hs
=====================================
@@ -870,20 +870,21 @@ extractSubTerms recurse clos = liftM thdOf3 . go 0 0
                 (error "unboxedTupleTerm: no HValue for unboxed tuple") terms
 
     -- Extract a sub-word sized field from a word
-    index item_size_b index_b word_size endian =
-        (word .&. (mask `shiftL` moveBytes)) `shiftR` moveBytes
-      where
-        mask :: Word
-        mask = case item_size_b of
-            1 -> 0xFF
-            2 -> 0xFFFF
-            4 -> 0xFFFFFFFF
-            _ -> panic ("Weird byte-index: " ++ show index_b)
-        (q,r) = index_b `quotRem` word_size
-        word = array!!q
-        moveBytes = case endian of
-         BigEndian    -> word_size - (r + item_size_b) * 8
-         LittleEndian -> r * 8
+    -- A sub word is aligned to the left-most part of a word on big-endian
+    -- platforms, and to the right-most part of a word on little-endian
+    -- platforms.  This allows to write and read it back from memory
+    -- independent of endianness.  Bits not belonging to a sub word are zeroed
+    -- out, although, this is strictly speaking not necessary since a sub word
+    -- is read back from memory by appropriately casted pointers (see e.g.
+    -- ppr_float of cPprTermBase).
+    index size_b aligned_idx word_size endian = case endian of
+      BigEndian    -> (word `shiftL` moveBits) `shiftR` zeroOutBits `shiftL` zeroOutBits
+      LittleEndian -> (word `shiftR` moveBits) `shiftL` zeroOutBits `shiftR` zeroOutBits
+     where
+      (q, r) = aligned_idx `quotRem` word_size
+      word = array!!q
+      moveBits = r * 8
+      zeroOutBits = (word_size - size_b) * 8
 
 
 -- | Fast, breadth-first Type reconstruction


=====================================
hadrian/README.md
=====================================
@@ -104,6 +104,8 @@ simply drop the `--freeze1` flag and Hadrian will rebuild all out-of-date files.
 * `--freeze2`: just like `--freeze1` but tell Hadrian to additionally freeze
 Stage2 GHC.
 
+* `--skip-depends`: skips rebuilding Haskell module dependency files.
+
 * `--integer-simple`: build GHC using the `integer-simple` integer library
 (instead of `integer-gmp`).
 


=====================================
hadrian/doc/make.md
=====================================
@@ -208,3 +208,17 @@ time you fire up a build. This is not possible with the Make build system.
   # Hadrian
   build nofib # builds the compiler and everything we need if necessary, too
   ```
+
+- `make FAST=YES`
+
+  Partially supported in hadrian with the `--skip-depends` argument. Since
+  hadrian is not directory aware some of the features of `FAST=YES` are not
+  replicated.
+
+  ```sh
+  # Make
+  make FAST=YES
+
+  # Hadrian
+  build --skip-depends
+  ```


=====================================
hadrian/src/CommandLine.hs
=====================================
@@ -1,5 +1,5 @@
 module CommandLine (
-    optDescrs, cmdLineArgsMap, cmdFlavour, lookupFreeze1, lookupFreeze2,
+    optDescrs, cmdLineArgsMap, cmdFlavour, lookupFreeze1, lookupFreeze2, lookupSkipDepends,
     cmdBignum, cmdBignumCheck, cmdProgressInfo, cmdConfigure, cmdCompleteSetting,
     cmdDocsArgs, lookupBuildRoot, TestArgs(..), TestSpeed(..), defaultTestArgs,
     cmdPrefix
@@ -26,6 +26,7 @@ data CommandLineArgs = CommandLineArgs
     , flavour        :: Maybe String
     , freeze1        :: Bool
     , freeze2        :: Bool
+    , skipDepends    :: Bool
     , bignum         :: Maybe String
     , bignumCheck    :: Bool
     , progressInfo   :: ProgressInfo
@@ -43,6 +44,7 @@ defaultCommandLineArgs = CommandLineArgs
     , flavour        = Nothing
     , freeze1        = False
     , freeze2        = False
+    , skipDepends    = False
     , bignum         = Nothing
     , bignumCheck    = False
     , progressInfo   = Brief
@@ -114,9 +116,10 @@ readBuildRoot ms =
     set :: BuildRoot -> CommandLineArgs -> CommandLineArgs
     set flag flags = flags { buildRoot = flag }
 
-readFreeze1, readFreeze2 :: Either String (CommandLineArgs -> CommandLineArgs)
+readFreeze1, readFreeze2, readSkipDepends :: Either String (CommandLineArgs -> CommandLineArgs)
 readFreeze1 = Right $ \flags -> flags { freeze1 = True }
 readFreeze2 = Right $ \flags -> flags { freeze1 = True, freeze2 = True }
+readSkipDepends = Right $ \flags -> flags { skipDepends = True }
 
 readProgressInfo :: Maybe String -> Either String (CommandLineArgs -> CommandLineArgs)
 readProgressInfo ms =
@@ -256,6 +259,8 @@ optDescrs =
       "Freeze Stage1 GHC."
     , Option [] ["freeze2"] (NoArg readFreeze2)
       "Freeze Stage2 GHC."
+    , Option [] ["skip-depends"] (NoArg readSkipDepends)
+      "Skip rebuilding dependency information."
     , Option [] ["bignum"] (OptArg readBignum "BIGNUM")
       "Select GHC BigNum backend: native, gmp, ffi."
     , Option [] ["progress-info"] (OptArg readProgressInfo "STYLE")
@@ -361,6 +366,9 @@ lookupFreeze1 = freeze1 . lookupExtra defaultCommandLineArgs
 lookupFreeze2 :: Map.HashMap TypeRep Dynamic -> Bool
 lookupFreeze2 = freeze2 . lookupExtra defaultCommandLineArgs
 
+lookupSkipDepends :: Map.HashMap TypeRep Dynamic -> Bool
+lookupSkipDepends = skipDepends . lookupExtra defaultCommandLineArgs
+
 cmdBignum :: Action (Maybe String)
 cmdBignum = bignum <$> cmdLineArgs
 


=====================================
hadrian/src/Main.hs
=====================================
@@ -35,7 +35,10 @@ main = do
                   ] ++
                   [ (RebuildLater, buildRoot -/- "stage1/**")
                   | CommandLine.lookupFreeze2 argsMap
-                  ]
+                  ] ++
+                  (if CommandLine.lookupSkipDepends argsMap
+                   then [(RebuildLater, buildRoot -/- "**/.dependencies.mk"), (RebuildLater, buildRoot -/- "**/.dependencies")]
+                   else [])
 
     cwd <- getCurrentDirectory
     shakeColor <- shouldUseColor


=====================================
testsuite/tests/ghci.debugger/scripts/all.T
=====================================
@@ -28,9 +28,7 @@ test('print020', [extra_files(['../HappyTest.hs']),
                   omit_ways(['ghci-ext'])], ghci_script, ['print020.script'])
 
 test('print021', normal, ghci_script, ['print021.script'])
-test('print022',
-     [when(arch('powerpc64'), expect_broken(14455))],
-     ghci_script, ['print022.script'])
+test('print022', normal, ghci_script, ['print022.script'])
 test('print023', extra_files(['../Test.hs']), ghci_script, ['print023.script'])
 test('print024', extra_files(['../Test.hs']), ghci_script, ['print024.script'])
 test('print025', normal, ghci_script, ['print025.script'])



View it on GitLab: https://gitlab.haskell.org/ghc/ghc/-/compare/348f19c00d0f14112e3845b4654b8ab9cb694db9...709797c6d0754a21a39395f5ee89ec2b978ff63e

-- 
View it on GitLab: https://gitlab.haskell.org/ghc/ghc/-/compare/348f19c00d0f14112e3845b4654b8ab9cb694db9...709797c6d0754a21a39395f5ee89ec2b978ff63e
You're receiving this email because of your account on gitlab.haskell.org.


-------------- next part --------------
An HTML attachment was scrubbed...
URL: <http://mail.haskell.org/pipermail/ghc-commits/attachments/20200709/d79df9fc/attachment-0001.html>


More information about the ghc-commits mailing list