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
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:
| ... | ... | @@ -3932,7 +3932,7 @@ section "Annotating call stacks" |
| 3932 | 3932 | ------------------------------------------------------------------------
|
| 3933 | 3933 | |
| 3934 | 3934 | primop AnnotateStackOp "annotateStack#" GenPrimOp
|
| 3935 | - b -> a_reppoly -> a_reppoly
|
|
| 3935 | + b -> a -> (# a #)
|
|
| 3936 | 3936 | { Pushes an annotation frame to the stack which can be reported by backtraces. }
|
| 3937 | 3937 | with
|
| 3938 | 3938 | out_of_line = True
|
| 1 | 1 | {-# LANGUAGE GADTs #-}
|
| 2 | 2 | {-# LANGUAGE ScopedTypeVariables #-}
|
| 3 | 3 | {-# LANGUAGE MagicHash #-}
|
| 4 | +{-# LANGUAGE UnboxedTuples #-}
|
|
| 4 | 5 | {-# LANGUAGE ImplicitParams #-}
|
| 5 | 6 | module GHC.Stack.Annotation.Experimental where
|
| 6 | 7 | |
| ... | ... | @@ -35,8 +36,9 @@ instance Show SrcLocAnno where |
| 35 | 36 | ]
|
| 36 | 37 | |
| 37 | 38 | annotateStackWith :: forall a b. (Typeable a, Show a) => a -> b -> b
|
| 38 | -annotateStackWith ann =
|
|
| 39 | - annotateStack# (StackAnnotation ann)
|
|
| 39 | +annotateStackWith ann b =
|
|
| 40 | + case annotateStack# (StackAnnotation ann) b of
|
|
| 41 | + (# r #) -> r
|
|
| 40 | 42 | |
| 41 | 43 | annotateCallStack :: HasCallStack => a -> a
|
| 42 | 44 | annotateCallStack =
|
| ... | ... | @@ -89,7 +89,8 @@ sizeStgRetFunFrame :: Int |
| 89 | 89 | sizeStgRetFunFrame = bytesToWords (#const SIZEOF_StgRetFun)
|
| 90 | 90 | |
| 91 | 91 | sizeStgAnnFrame :: Int
|
| 92 | -sizeStgAnnFrame = bytesToWords (#const SIZEOF_StgAnnFrame)
|
|
| 92 | +sizeStgAnnFrame = bytesToWords $
|
|
| 93 | + (#const SIZEOF_StgAnnFrame_NoHdr) + (#size StgHeader)
|
|
| 93 | 94 | |
| 94 | 95 | offsetStgAnnFrameAnn :: WordOffset
|
| 95 | 96 | offsetStgAnnFrameAnn = byteOffsetToWordOffset $
|
| 1 | 1 | {-# LANGUAGE MagicHash #-}
|
| 2 | 2 | {-# LANGUAGE GADTs #-}
|
| 3 | +{-# LANGUAGE UnboxedTuples #-}
|
|
| 3 | 4 | |
| 4 | 5 | import Data.Typeable
|
| 5 | 6 | import GHC.Exts
|
| ... | ... | @@ -16,8 +17,9 @@ annotateStack |
| 16 | 17 | :: forall a r b.
|
| 17 | 18 | (Typeable a, Show a)
|
| 18 | 19 | => a -> b -> b
|
| 19 | -annotateStack ann =
|
|
| 20 | - annotateStack# (StackAnnotation ann)
|
|
| 20 | +annotateStack ann b =
|
|
| 21 | + case annotateStack# (StackAnnotation ann) b of
|
|
| 22 | + (# r #) -> r
|
|
| 21 | 23 | |
| 22 | 24 | hello :: Int -> Int -> Int
|
| 23 | 25 | hello x y = annotateStack (x,y) $
|
| 1 | 1 | ["(2,3)"]
|
| 2 | 2 | 47
|
| 3 | +["\"bar\"","\"foo\"","\"tailCallEx\""]
|
|
| 4 | +40 |
| ... | ... | @@ -443,7 +443,7 @@ wanteds os = concat |
| 443 | 443 | ,closureSize C "StgStopFrame"
|
| 444 | 444 | ,closureSize C "StgDeadThreadFrame"
|
| 445 | 445 | ,closureField C "StgDeadThreadFrame" "result"
|
| 446 | - ,structSize C "StgAnnFrame"
|
|
| 446 | + ,closureSize Both "StgAnnFrame"
|
|
| 447 | 447 | ,closureField C "StgAnnFrame" "ann"
|
| 448 | 448 | |
| 449 | 449 | ,closureSize Both "StgMutArrPtrs"
|