Fix interpreter with profiling

This was broken by D3746 and/or D3809, but unfortunately we didn't
notice because CI at the time wasn't building the profiling way.

Test Plan:
```
cd testsuite/test/profiling/should_run
make WAY=ghci-ext-prof
```

Reviewers: bgamari, michalt, hvr, erikd

Subscribers: rwbarton, thomie, carter

GHC Trac Issues: #14705

Differential Revision: https://phabricator.haskell.org/D4437

1 files changed, 19 insertions, 8 deletions

diff --git a/compiler/codeGen/StgCmmLayout.hs b/compiler/codeGen/StgCmmLayout.hs
index 95828ad4c6..78a7cf3f85 100644
--- a/compiler/codeGen/StgCmmLayout.hs
+++ b/compiler/codeGen/StgCmmLayout.hs
@@ -19,6 +19,7 @@ module StgCmmLayout (
         slowCall, directCall,
 
         FieldOffOrPadding(..),
+        ClosureHeader(..),
         mkVirtHeapOffsets,
         mkVirtHeapOffsetsWithPadding,
         mkVirtConstrOffsets,
@@ -398,9 +399,17 @@ data FieldOffOrPadding a
     | Padding ByteOff  -- Length of padding in bytes.
               ByteOff  -- Offset in bytes.
 
+-- | Used to tell the various @mkVirtHeapOffsets@ functions what kind
+-- of header the object has.  This will be accounted for in the
+-- offsets of the fields returned.
+data ClosureHeader
+  = NoHeader
+  | StdHeader
+  | ThunkHeader
+
 mkVirtHeapOffsetsWithPadding
   :: DynFlags
-  -> Bool                     -- True <=> is a thunk
+  -> ClosureHeader            -- What kind of header to account for
   -> [NonVoid (PrimRep, a)]   -- Things to make offsets for
   -> ( WordOff                -- Total number of words allocated
      , WordOff                -- Number of words allocated for *pointers*
@@ -414,15 +423,17 @@ mkVirtHeapOffsetsWithPadding
 -- mkVirtHeapOffsetsWithPadding always returns boxed things with smaller offsets
 -- than the unboxed things
 
-mkVirtHeapOffsetsWithPadding dflags is_thunk things =
+mkVirtHeapOffsetsWithPadding dflags header things =
     ASSERT(not (any (isVoidRep . fst . fromNonVoid) things))
     ( tot_wds
     , bytesToWordsRoundUp dflags bytes_of_ptrs
     , concat (ptrs_w_offsets ++ non_ptrs_w_offsets) ++ final_pad
     )
   where
-    hdr_words | is_thunk   = thunkHdrSize dflags
-              | otherwise  = fixedHdrSizeW dflags
+    hdr_words = case header of
+      NoHeader -> 0
+      StdHeader -> fixedHdrSizeW dflags
+      ThunkHeader -> thunkHdrSize dflags
     hdr_bytes = wordsToBytes dflags hdr_words
 
     (ptrs, non_ptrs) = partition (isGcPtrRep . fst . fromNonVoid) things
@@ -471,25 +482,25 @@ mkVirtHeapOffsetsWithPadding dflags is_thunk things =
 
 mkVirtHeapOffsets
   :: DynFlags
-  -> Bool                     -- True <=> is a thunk
+  -> ClosureHeader            -- What kind of header to account for
   -> [NonVoid (PrimRep,a)]    -- Things to make offsets for
   -> (WordOff,                -- _Total_ number of words allocated
       WordOff,                -- Number of words allocated for *pointers*
       [(NonVoid a, ByteOff)])
-mkVirtHeapOffsets dflags is_thunk things =
+mkVirtHeapOffsets dflags header things =
     ( tot_wds
     , ptr_wds
     , [ (field, offset) | (FieldOff field offset) <- things_offsets ]
     )
   where
    (tot_wds, ptr_wds, things_offsets) =
-       mkVirtHeapOffsetsWithPadding dflags is_thunk things
+       mkVirtHeapOffsetsWithPadding dflags header things
 
 -- | Just like mkVirtHeapOffsets, but for constructors
 mkVirtConstrOffsets
   :: DynFlags -> [NonVoid (PrimRep, a)]
   -> (WordOff, WordOff, [(NonVoid a, ByteOff)])
-mkVirtConstrOffsets dflags = mkVirtHeapOffsets dflags False
+mkVirtConstrOffsets dflags = mkVirtHeapOffsets dflags StdHeader
 
 -- | Just like mkVirtConstrOffsets, but used when we don't have the actual
 -- arguments. Useful when e.g. generating info tables; we just need to know