[Git][ghc/ghc][ghc-9.6] 4 commits: Revert "NCG(x86): Compile add+shift as lea if possible."

Matthew Pickering (@mpickering) gitlab at gitlab.haskell.org
Tue Jan 10 08:08:36 UTC 2023



Matthew Pickering pushed to branch ghc-9.6 at Glasgow Haskell Compiler / GHC


Commits:
548380ea by Matthew Pickering at 2023-01-09T12:03:07+00:00
Revert "NCG(x86): Compile add+shift as lea if possible."

This reverts commit 20457d775885d6c3df020d204da9a7acfb3c2e5a.

See #22666 and #21777

- - - - -
48a9e688 by Matthew Pickering at 2023-01-10T08:07:45+00:00
Store bootstrap_llvm_target and use it to set LlvmTarget in bindists

This mirrors some existing logic for the bootstrap_target which
influences how TargetPlatform is set.

As described on #21970 not storing this led to `LlvmTarget` being set incorrectly
and hence the wrong `--target` flag being passed to the C compiler.

Towards #21970

(cherry picked from commit 64286132cc0db4e227637887f98f5a3ecf7d326a)

- - - - -
2a7c7fa7 by Matthew Pickering at 2023-01-10T08:07:45+00:00
Check for FP_LD_NO_FIXUP_CHAINS in installation configure script

Otherwise, when installing from a bindist the C flag isn't passed to the
C compiler.

This completes the fix for #22429

(cherry picked from commit 4724e8d1a66fa0a821d322d9d2d90db7d7604916)

- - - - -
6db7d9da by Sebastian Graf at 2023-01-10T08:07:59+00:00
Handle shadowing in DmdAnal (#22718)

Previously, when we had a shadowing situation like
```hs
f x = ... -- demand signature <1L><1L>

main = ... \f -> f 1 ...
```
we'd happily use the shadowed demand signature at the call site inside the
lambda. Of course, that's wrong and solution is simply to remove the demand
signature from the `AnalEnv` when we enter the lambda.
This patch does so for all binding constructs Core.

In #22718 the issue was caused by LetUp not shadowing away the existing demand
signature for the let binder in the let body. The resulting absent error is
fickle to reproduce; hence no reproduction test case. #17478 would help.

Fixes #22718.

It appears that TcPlugin_Rewrite regresses by ~40% on Darwin. It is likely that
DmdAnal was exploiting ill-scoped analysis results.

Metric increase ['bytes allocated'] (test_env=x86_64-darwin-validate):
    TcPlugin_Rewrite

(cherry picked from commit e3fff7512bbf989386faaa1dccafdad1deabde84)

- - - - -


8 changed files:

- compiler/GHC/CmmToAsm/X86/CodeGen.hs
- compiler/GHC/Core/Opt/DmdAnal.hs
- configure.ac
- distrib/configure.ac.in
- m4/ghc_llvm_target.m4
- − testsuite/tests/codeGen/should_gen_asm/AddMulX86.asm
- − testsuite/tests/codeGen/should_gen_asm/AddMulX86.hs
- testsuite/tests/codeGen/should_gen_asm/all.T


Changes:

=====================================
compiler/GHC/CmmToAsm/X86/CodeGen.hs
=====================================
@@ -1048,29 +1048,10 @@ getRegister' _ is32Bit (CmmMachOp mop [x, y]) = -- dyadic MachOps
 
     --------------------
     add_code :: Width -> CmmExpr -> CmmExpr -> NatM Register
-    -- x + imm
     add_code rep x (CmmLit (CmmInt y _))
         | is32BitInteger y
         , rep /= W8 -- LEA doesn't support byte size (#18614)
         = add_int rep x y
-    -- x + (y << imm)
-    add_code rep x y
-        -- Byte size is not supported and 16bit size is slow when computed via LEA
-        | rep /= W8 && rep /= W16
-        -- 2^3 = 8 is the highest multiplicator supported by LEA.
-        , Just (x,y,shift_bits) <- get_shift x y
-        = add_shiftL rep x y (fromIntegral shift_bits)
-        where
-          -- x + (y << imm)
-          get_shift x (CmmMachOp (MO_Shl _w) [y, CmmLit (CmmInt shift_bits _)])
-            | shift_bits <= 3
-            = Just (x, y, shift_bits)
-          -- (y << imm) + x
-          get_shift (CmmMachOp (MO_Shl _w) [y, CmmLit (CmmInt shift_bits _)]) x
-            | shift_bits <= 3
-            = Just (x, y, shift_bits)
-          get_shift _ _
-            = Nothing
     add_code rep x y = trivialCode rep (ADD format) (Just (ADD format)) x y
       where format = intFormat rep
     -- TODO: There are other interesting patterns we want to replace
@@ -1085,7 +1066,6 @@ getRegister' _ is32Bit (CmmMachOp mop [x, y]) = -- dyadic MachOps
     sub_code rep x y = trivialCode rep (SUB (intFormat rep)) Nothing x y
 
     -- our three-operand add instruction:
-    add_int :: (Width -> CmmExpr -> Integer -> NatM Register)
     add_int width x y = do
         (x_reg, x_code) <- getSomeReg x
         let
@@ -1099,22 +1079,6 @@ getRegister' _ is32Bit (CmmMachOp mop [x, y]) = -- dyadic MachOps
         --
         return (Any format code)
 
-    -- x + (y << shift_bits) using LEA
-    add_shiftL :: (Width -> CmmExpr -> CmmExpr -> Int -> NatM Register)
-    add_shiftL width x y shift_bits = do
-        (x_reg, x_code) <- getSomeReg x
-        (y_reg, y_code) <- getSomeReg y
-        let
-            format = intFormat width
-            imm = ImmInt 0
-            code dst
-               = (x_code `appOL` y_code) `snocOL`
-                 LEA format
-                        (OpAddr (AddrBaseIndex (EABaseReg x_reg) (EAIndex y_reg (2 ^ shift_bits)) imm))
-                        (OpReg dst)
-        --
-        return (Any format code)
-
     ----------------------
 
     -- See Note [DIV/IDIV for bytes]


=====================================
compiler/GHC/Core/Opt/DmdAnal.hs
=====================================
@@ -333,7 +333,8 @@ dmdAnalBindLetUp :: TopLevelFlag
                  -> WithDmdType (DmdResult CoreBind a)
 dmdAnalBindLetUp top_lvl env id rhs anal_body = WithDmdType final_ty (R (NonRec id' rhs') (body'))
   where
-    WithDmdType body_ty body'   = anal_body env
+    WithDmdType body_ty body'   = anal_body (addInScopeAnalEnv env id)
+    -- See Note [Bringing a new variable into scope]
     WithDmdType body_ty' id_dmd = findBndrDmd env body_ty id
     -- See Note [Finalising boxity for demand signatures]
 
@@ -473,7 +474,8 @@ dmdAnal' env dmd (App fun arg)
 dmdAnal' env dmd (Lam var body)
   | isTyVar var
   = let
-        WithDmdType body_ty body' = dmdAnal env dmd body
+        WithDmdType body_ty body' = dmdAnal (addInScopeAnalEnv env var) dmd body
+        -- See Note [Bringing a new variable into scope]
     in
     WithDmdType body_ty (Lam var body')
 
@@ -481,7 +483,8 @@ dmdAnal' env dmd (Lam var body)
   = let (n, body_dmd)    = peelCallDmd dmd
           -- body_dmd: a demand to analyze the body
 
-        WithDmdType body_ty body' = dmdAnal env body_dmd body
+        WithDmdType body_ty body' = dmdAnal (addInScopeAnalEnv env var) body_dmd body
+        -- See Note [Bringing a new variable into scope]
         WithDmdType lam_ty var'   = annotateLamIdBndr env body_ty var
         new_dmd_type = multDmdType n lam_ty
     in
@@ -493,7 +496,9 @@ dmdAnal' env dmd (Case scrut case_bndr ty [Alt alt_con bndrs rhs])
   -- can consider its field demands when analysing the scrutinee.
   | want_precise_field_dmds alt_con
   = let
-        WithDmdType rhs_ty rhs'           = dmdAnal env dmd rhs
+        rhs_env = addInScopeAnalEnvs env (case_bndr:bndrs)
+        -- See Note [Bringing a new variable into scope]
+        WithDmdType rhs_ty rhs'           = dmdAnal rhs_env dmd rhs
         WithDmdType alt_ty1 fld_dmds      = findBndrsDmds env rhs_ty bndrs
         WithDmdType alt_ty2 case_bndr_dmd = findBndrDmd env alt_ty1 case_bndr
         !case_bndr'                       = setIdDemandInfo case_bndr case_bndr_dmd
@@ -629,7 +634,9 @@ dmdAnalSumAlts env dmd case_bndr (alt:alts)
 
 dmdAnalSumAlt :: AnalEnv -> SubDemand -> Id -> CoreAlt -> WithDmdType CoreAlt
 dmdAnalSumAlt env dmd case_bndr (Alt con bndrs rhs)
-  | WithDmdType rhs_ty rhs' <- dmdAnal env dmd rhs
+  | let rhs_env = addInScopeAnalEnvs env (case_bndr:bndrs)
+    -- See Note [Bringing a new variable into scope]
+  , WithDmdType rhs_ty rhs' <- dmdAnal rhs_env dmd rhs
   , WithDmdType alt_ty dmds <- findBndrsDmds env rhs_ty bndrs
   , let (_ :* case_bndr_sd) = findIdDemand alt_ty case_bndr
         -- See Note [Demand on case-alternative binders]
@@ -2399,7 +2406,7 @@ enterDFun bind env
 emptySigEnv :: SigEnv
 emptySigEnv = emptyVarEnv
 
--- | Extend an environment with the strictness IDs attached to the id
+-- | Extend an environment with the strictness sigs attached to the Ids
 extendAnalEnvs :: TopLevelFlag -> AnalEnv -> [Id] -> AnalEnv
 extendAnalEnvs top_lvl env vars
   = env { ae_sigs = extendSigEnvs top_lvl (ae_sigs env) vars }
@@ -2418,6 +2425,12 @@ extendSigEnv top_lvl sigs var sig = extendVarEnv sigs var (sig, top_lvl)
 lookupSigEnv :: AnalEnv -> Id -> Maybe (DmdSig, TopLevelFlag)
 lookupSigEnv env id = lookupVarEnv (ae_sigs env) id
 
+addInScopeAnalEnv :: AnalEnv -> Var -> AnalEnv
+addInScopeAnalEnv env id = env { ae_sigs = delVarEnv (ae_sigs env) id }
+
+addInScopeAnalEnvs :: AnalEnv -> [Var] -> AnalEnv
+addInScopeAnalEnvs env ids = env { ae_sigs = delVarEnvList (ae_sigs env) ids }
+
 nonVirgin :: AnalEnv -> AnalEnv
 nonVirgin env = env { ae_virgin = False }
 
@@ -2456,7 +2469,18 @@ findBndrDmd env dmd_ty id
 
     fam_envs = ae_fam_envs env
 
-{- Note [Making dictionary parameters strict]
+{- Note [Bringing a new variable into scope]
+~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~
+Consider
+   f x = blah
+   g = ...(\f. ...f...)...
+
+In the body of the '\f', any occurrence of `f` refers to the lambda-bound `f`,
+not the top-level `f` (which will be in `ae_sigs`).  So it's very important
+to delete `f` from `ae_sigs` when we pass a lambda/case/let-up binding of `f`.
+Otherwise chaos results (#22718).
+
+Note [Making dictionary parameters strict]
 ~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~
 The Opt_DictsStrict flag makes GHC use call-by-value for dictionaries.  Why?
 


=====================================
configure.ac
=====================================
@@ -667,6 +667,8 @@ GHC_LLVM_TARGET_SET_VAR
 # we intend to pass trough --targets to llvm as is.
 LLVMTarget_CPP=`    echo "$LlvmTarget"`
 AC_SUBST(LLVMTarget_CPP)
+# The target is substituted into the distrib/configure.ac file
+AC_SUBST(LlvmTarget)
 
 dnl ** See whether cc supports --target=<triple> and set
 dnl CONF_CC_OPTS_STAGE[012] accordingly.


=====================================
distrib/configure.ac.in
=====================================
@@ -18,6 +18,8 @@ dnl--------------------------------------------------------------------
 dnl Various things from the source distribution configure
 bootstrap_target=@TargetPlatform@
 
+bootstrap_llvm_target=@LlvmTarget@
+
 TargetHasRTSLinker=@TargetHasRTSLinker@
 AC_SUBST(TargetHasRTSLinker)
 
@@ -169,6 +171,11 @@ FPTOOLS_SET_C_LD_FLAGS([target],[CONF_CC_OPTS_STAGE1],[CONF_GCC_LINKER_OPTS_STAG
 # Stage 3 won't be supported by cross-compilation
 FPTOOLS_SET_C_LD_FLAGS([target],[CONF_CC_OPTS_STAGE2],[CONF_GCC_LINKER_OPTS_STAGE2],[CONF_LD_LINKER_OPTS_STAGE2],[CONF_CPP_OPTS_STAGE2])
 
+FP_LD_NO_FIXUP_CHAINS([target], [LDFLAGS])
+FP_LD_NO_FIXUP_CHAINS([build], [CONF_GCC_LINKER_OPTS_STAGE0])
+FP_LD_NO_FIXUP_CHAINS([target], [CONF_GCC_LINKER_OPTS_STAGE1])
+FP_LD_NO_FIXUP_CHAINS([target], [CONF_GCC_LINKER_OPTS_STAGE2])
+
 AC_SUBST(CONF_CC_OPTS_STAGE0)
 AC_SUBST(CONF_CC_OPTS_STAGE1)
 AC_SUBST(CONF_CC_OPTS_STAGE2)


=====================================
m4/ghc_llvm_target.m4
=====================================
@@ -50,5 +50,10 @@ AC_DEFUN([GHC_LLVM_TARGET], [
 # require it.
 AC_DEFUN([GHC_LLVM_TARGET_SET_VAR], [
   AC_REQUIRE([FPTOOLS_SET_PLATFORMS_VARS])
-  GHC_LLVM_TARGET([$target],[$target_cpu],[$target_vendor],[$target_os],[LlvmTarget])
+  if test "$bootstrap_llvm_target" != ""
+  then
+    LlvmTarget=$bootstrap_llvm_target
+  else
+    GHC_LLVM_TARGET([$target],[$target_cpu],[$target_vendor],[$target_os],[LlvmTarget])
+  fi
 ])


=====================================
testsuite/tests/codeGen/should_gen_asm/AddMulX86.asm deleted
=====================================
@@ -1,46 +0,0 @@
-.section .text
-.align 8
-.align 8
-	.quad	8589934604
-	.quad	0
-	.long	14
-	.long	0
-.globl AddMulX86_f_info
-.type AddMulX86_f_info, @function
-AddMulX86_f_info:
-.LcAx:
-	leaq (%r14,%rsi,8),%rbx
-	jmp *(%rbp)
-	.size AddMulX86_f_info, .-AddMulX86_f_info
-.section .data
-.align 8
-.align 1
-.globl AddMulX86_f_closure
-.type AddMulX86_f_closure, @object
-AddMulX86_f_closure:
-	.quad	AddMulX86_f_info
-.section .text
-.align 8
-.align 8
-	.quad	8589934604
-	.quad	0
-	.long	14
-	.long	0
-.globl AddMulX86_g_info
-.type AddMulX86_g_info, @function
-AddMulX86_g_info:
-.LcAL:
-	leaq (%r14,%rsi,8),%rbx
-	jmp *(%rbp)
-	.size AddMulX86_g_info, .-AddMulX86_g_info
-.section .data
-.align 8
-.align 1
-.globl AddMulX86_g_closure
-.type AddMulX86_g_closure, @object
-AddMulX86_g_closure:
-	.quad	AddMulX86_g_info
-.section .note.GNU-stack,"", at progbits
-.ident "GHC 9.3.20220228"
-
-


=====================================
testsuite/tests/codeGen/should_gen_asm/AddMulX86.hs deleted
=====================================
@@ -1,12 +0,0 @@
-{-# LANGUAGE MagicHash #-}
-
-module AddMulX86 where
-
-import GHC.Exts
-
-f :: Int# -> Int# -> Int#
-f x y =
-    x +# (y *# 8#) -- Should result in a lea instruction, which we grep the assembly output for.
-
-g x y =
-    (y *# 8#) +# x  -- Should result in a lea instruction, which we grep the assembly output for.


=====================================
testsuite/tests/codeGen/should_gen_asm/all.T
=====================================
@@ -10,4 +10,3 @@ test('memset-unroll', is_amd64_codegen, compile_cmp_asm, ['cmm', ''])
 test('bytearray-memset-unroll', is_amd64_codegen, compile_grep_asm, ['hs', True, ''])
 test('bytearray-memcpy-unroll', is_amd64_codegen, compile_grep_asm, ['hs', True, ''])
 test('T18137', [when(opsys('darwin'), skip), only_ways(llvm_ways)], compile_grep_asm, ['hs', False, '-fllvm -split-sections'])
-test('AddMulX86', is_amd64_codegen, compile_cmp_asm, ['hs', '-dno-typeable-binds'])



View it on GitLab: https://gitlab.haskell.org/ghc/ghc/-/compare/a587499c6dc8a7e7e646e9c5f246903a4cc99e56...6db7d9da21854fa9decaf6e49f7d4f6c45f70883

-- 
View it on GitLab: https://gitlab.haskell.org/ghc/ghc/-/compare/a587499c6dc8a7e7e646e9c5f246903a4cc99e56...6db7d9da21854fa9decaf6e49f7d4f6c45f70883
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/20230110/81552f62/attachment-0001.html>


More information about the ghc-commits mailing list