[Git][ghc/ghc][wip/no_fixup_chains_2] 2 commits: Store bootstrap_llvm_target and use it to set LlvmTarget in bindists

Matthew Pickering (@mpickering) gitlab at gitlab.haskell.org
Mon Jan 9 16:17:32 UTC 2023 


Matthew Pickering pushed to branch wip/no_fixup_chains_2 at Glasgow Haskell Compiler / GHC


Commits:
036c4034 by Matthew Pickering at 2023-01-09T16:17:19+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

- - - - -
4e70977a by Matthew Pickering at 2023-01-09T16:17:19+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.

- - - - -


6 changed files:

- configure.ac
- distrib/configure.ac.in
- libraries/base/GHC/Stack/CloneStack.hs
- m4/ghc_llvm_target.m4
- testsuite/tests/rts/decodeMyStack.stdout
- testsuite/tests/rts/decodeMyStack_underflowFrames.hs


Changes:

=====================================
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)


=====================================
libraries/base/GHC/Stack/CloneStack.hs
=====================================
@@ -26,6 +26,7 @@ import Control.Concurrent.MVar
 import Data.Maybe (catMaybes)
 import Foreign
 import GHC.Conc.Sync
+import GHC.ClosureTypes
 import GHC.Exts (Int (I#), RealWorld, StackSnapshot#, ThreadId#, Array#, sizeofArray#, indexArray#, State#, StablePtr#)
 import GHC.IO (IO (..))
 import GHC.InfoProv (InfoProv (..), InfoProvEnt, ipLoc, ipeProv, peekInfoProv)
@@ -207,7 +208,7 @@ data StackEntry = StackEntry
   { functionName :: String,
     moduleName :: String,
     srcLoc :: String,
-    closureType :: Word
+    closureType :: ClosureType
   }
   deriving (Show, Eq)
 
@@ -246,8 +247,7 @@ decode stackSnapshot = do
         { functionName = ipLabel infoProv,
           moduleName = ipMod infoProv,
           srcLoc = ipLoc infoProv,
-          -- read looks dangerous, be we can trust that the closure type is always there.
-          closureType = read . ipDesc $ infoProv
+          closureType = ipDesc $ infoProv
         }
 
 getDecodedStackArray :: StackSnapshot -> IO [Ptr InfoProvEnt]


=====================================
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/rts/decodeMyStack.stdout
=====================================
@@ -1,12 +1,12 @@
-StackEntry {functionName = "main.(...)", moduleName = "Main", srcLoc = "decodeMyStack.hs:22:27-41", closureType = 53}
-StackEntry {functionName = "getDeepStack.getDeepStackCase", moduleName = "Main", srcLoc = "decodeMyStack.hs:18:26-28", closureType = 53}
-StackEntry {functionName = "getDeepStack.getDeepStackCase", moduleName = "Main", srcLoc = "decodeMyStack.hs:18:26-28", closureType = 53}
-StackEntry {functionName = "getDeepStack.getDeepStackCase", moduleName = "Main", srcLoc = "decodeMyStack.hs:18:26-28", closureType = 53}
-StackEntry {functionName = "getDeepStack.getDeepStackCase", moduleName = "Main", srcLoc = "decodeMyStack.hs:18:26-28", closureType = 53}
-StackEntry {functionName = "getDeepStack.getDeepStackCase", moduleName = "Main", srcLoc = "decodeMyStack.hs:18:26-28", closureType = 53}
-StackEntry {functionName = "getDeepStack.getDeepStackCase", moduleName = "Main", srcLoc = "decodeMyStack.hs:18:26-28", closureType = 53}
-StackEntry {functionName = "getDeepStack.getDeepStackCase", moduleName = "Main", srcLoc = "decodeMyStack.hs:18:26-28", closureType = 53}
-StackEntry {functionName = "getDeepStack.getDeepStackCase", moduleName = "Main", srcLoc = "decodeMyStack.hs:18:26-28", closureType = 53}
-StackEntry {functionName = "getDeepStack.getDeepStackCase", moduleName = "Main", srcLoc = "decodeMyStack.hs:18:26-28", closureType = 53}
-StackEntry {functionName = "getDeepStack.getDeepStackCase", moduleName = "Main", srcLoc = "decodeMyStack.hs:18:26-28", closureType = 53}
-StackEntry {functionName = "getDeepStack.getDeepStackCase", moduleName = "Main", srcLoc = "decodeMyStack.hs:13:7-21", closureType = 53}
+StackEntry {functionName = "main.(...)", moduleName = "Main", srcLoc = "decodeMyStack.hs:22:27-41", closureType = STACK}
+StackEntry {functionName = "getDeepStack.getDeepStackCase", moduleName = "Main", srcLoc = "decodeMyStack.hs:18:26-28", closureType = STACK}
+StackEntry {functionName = "getDeepStack.getDeepStackCase", moduleName = "Main", srcLoc = "decodeMyStack.hs:18:26-28", closureType = STACK}
+StackEntry {functionName = "getDeepStack.getDeepStackCase", moduleName = "Main", srcLoc = "decodeMyStack.hs:18:26-28", closureType = STACK}
+StackEntry {functionName = "getDeepStack.getDeepStackCase", moduleName = "Main", srcLoc = "decodeMyStack.hs:18:26-28", closureType = STACK}
+StackEntry {functionName = "getDeepStack.getDeepStackCase", moduleName = "Main", srcLoc = "decodeMyStack.hs:18:26-28", closureType = STACK}
+StackEntry {functionName = "getDeepStack.getDeepStackCase", moduleName = "Main", srcLoc = "decodeMyStack.hs:18:26-28", closureType = STACK}
+StackEntry {functionName = "getDeepStack.getDeepStackCase", moduleName = "Main", srcLoc = "decodeMyStack.hs:18:26-28", closureType = STACK}
+StackEntry {functionName = "getDeepStack.getDeepStackCase", moduleName = "Main", srcLoc = "decodeMyStack.hs:18:26-28", closureType = STACK}
+StackEntry {functionName = "getDeepStack.getDeepStackCase", moduleName = "Main", srcLoc = "decodeMyStack.hs:18:26-28", closureType = STACK}
+StackEntry {functionName = "getDeepStack.getDeepStackCase", moduleName = "Main", srcLoc = "decodeMyStack.hs:18:26-28", closureType = STACK}
+StackEntry {functionName = "getDeepStack.getDeepStackCase", moduleName = "Main", srcLoc = "decodeMyStack.hs:13:7-21", closureType = STACK}


=====================================
testsuite/tests/rts/decodeMyStack_underflowFrames.hs
=====================================
@@ -1,6 +1,7 @@
 module Main where
 
 import GHC.Stack.CloneStack
+import GHC.ClosureTypes
 import System.IO.Unsafe
 import Control.Monad
 
@@ -34,16 +35,16 @@ main = do
     StackEntry
       { functionName = "assertEqual",
         moduleName = "Main",
-        srcLoc = "decodeMyStack_underflowFrames.hs:23:11",
-        closureType = 53
+        srcLoc = "decodeMyStack_underflowFrames.hs:24:11",
+        closureType = STACK
       }
   assertEqual
     (stack !! 1)
     StackEntry
       { functionName = "main.(...)",
         moduleName = "Main",
-        srcLoc = "decodeMyStack_underflowFrames.hs:29:20-36",
-        closureType = 53
+        srcLoc = "decodeMyStack_underflowFrames.hs:30:20-36",
+        closureType = STACK
       }
   forM_
     [2 .. 1001]
@@ -53,8 +54,8 @@ main = do
           StackEntry
             { functionName = "getDeepStack.getDeepStackCase",
               moduleName = "Main",
-              srcLoc = "decodeMyStack_underflowFrames.hs:19:26-28",
-              closureType = 53
+              srcLoc = "decodeMyStack_underflowFrames.hs:20:26-28",
+              closureType = STACK
             }
     )
   assertEqual
@@ -62,6 +63,6 @@ main = do
     StackEntry
       { functionName = "getDeepStack.getDeepStackCase",
         moduleName = "Main",
-        srcLoc = "decodeMyStack_underflowFrames.hs:14:7-21",
-        closureType = 53
+        srcLoc = "decodeMyStack_underflowFrames.hs:15:7-21",
+        closureType = STACK
       }



View it on GitLab: https://gitlab.haskell.org/ghc/ghc/-/compare/e3669c95d66a4904f0ac1848a9565ad4cd634e45...4e70977ac02f6b7f0a3013bed76aceb813e5d03b

-- 
View it on GitLab: https://gitlab.haskell.org/ghc/ghc/-/compare/e3669c95d66a4904f0ac1848a9565ad4cd634e45...4e70977ac02f6b7f0a3013bed76aceb813e5d03b
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/20230109/c27ff1aa/attachment-0001.html>

More information about the ghc-commits mailing list