Hannes Siebenhandl pushed to branch wip/fendor/ann-frame at Glasgow Haskell Compiler / GHC Commits: 677c5337 by fendor at 2025-05-22T14:57:01+02:00 FIXME: try to fix the primop - - - - - 6 changed files: - compiler/GHC/Builtin/primops.txt.pp - libraries/ghc-experimental/src/GHC/Stack/Annotation/Experimental.hs - libraries/ghc-heap/GHC/Exts/Stack/Constants.hsc - libraries/ghc-heap/tests/ann_frame.hs - libraries/ghc-heap/tests/ann_frame.stdout - utils/deriveConstants/Main.hs Changes: ===================================== compiler/GHC/Builtin/primops.txt.pp ===================================== @@ -3932,7 +3932,7 @@ section "Annotating call stacks" ------------------------------------------------------------------------ primop AnnotateStackOp "annotateStack#" GenPrimOp - b -> a_reppoly -> a_reppoly + b -> a -> (# a #) { Pushes an annotation frame to the stack which can be reported by backtraces. } with out_of_line = True ===================================== libraries/ghc-experimental/src/GHC/Stack/Annotation/Experimental.hs ===================================== @@ -1,6 +1,7 @@ {-# LANGUAGE GADTs #-} {-# LANGUAGE ScopedTypeVariables #-} {-# LANGUAGE MagicHash #-} +{-# LANGUAGE UnboxedTuples #-} {-# LANGUAGE ImplicitParams #-} module GHC.Stack.Annotation.Experimental where @@ -35,8 +36,9 @@ instance Show SrcLocAnno where ] annotateStackWith :: forall a b. (Typeable a, Show a) => a -> b -> b -annotateStackWith ann = - annotateStack# (StackAnnotation ann) +annotateStackWith ann b = + case annotateStack# (StackAnnotation ann) b of + (# r #) -> r annotateCallStack :: HasCallStack => a -> a annotateCallStack = ===================================== libraries/ghc-heap/GHC/Exts/Stack/Constants.hsc ===================================== @@ -89,7 +89,8 @@ sizeStgRetFunFrame :: Int sizeStgRetFunFrame = bytesToWords (#const SIZEOF_StgRetFun) sizeStgAnnFrame :: Int -sizeStgAnnFrame = bytesToWords (#const SIZEOF_StgAnnFrame) +sizeStgAnnFrame = bytesToWords $ + (#const SIZEOF_StgAnnFrame_NoHdr) + (#size StgHeader) offsetStgAnnFrameAnn :: WordOffset offsetStgAnnFrameAnn = byteOffsetToWordOffset $ ===================================== libraries/ghc-heap/tests/ann_frame.hs ===================================== @@ -1,5 +1,6 @@ {-# LANGUAGE MagicHash #-} {-# LANGUAGE GADTs #-} +{-# LANGUAGE UnboxedTuples #-} import Data.Typeable import GHC.Exts @@ -16,8 +17,9 @@ annotateStack :: forall a r b. (Typeable a, Show a) => a -> b -> b -annotateStack ann = - annotateStack# (StackAnnotation ann) +annotateStack ann b = + case annotateStack# (StackAnnotation ann) b of + (# r #) -> r hello :: Int -> Int -> Int hello x y = annotateStack (x,y) $ ===================================== libraries/ghc-heap/tests/ann_frame.stdout ===================================== @@ -1,2 +1,4 @@ ["(2,3)"] 47 +["\"bar\"","\"foo\"","\"tailCallEx\""] +40 ===================================== utils/deriveConstants/Main.hs ===================================== @@ -443,7 +443,7 @@ wanteds os = concat ,closureSize C "StgStopFrame" ,closureSize C "StgDeadThreadFrame" ,closureField C "StgDeadThreadFrame" "result" - ,structSize C "StgAnnFrame" + ,closureSize Both "StgAnnFrame" ,closureField C "StgAnnFrame" "ann" ,closureSize Both "StgMutArrPtrs" View it on GitLab: https://gitlab.haskell.org/ghc/ghc/-/commit/677c5337c764c880d1769dd7159c372f... -- View it on GitLab: https://gitlab.haskell.org/ghc/ghc/-/commit/677c5337c764c880d1769dd7159c372f... You're receiving this email because of your account on gitlab.haskell.org.