[Git][ghc/ghc][wip/ghc-debug] END_TSO_QUEUE is not a closure type on it's own

Sven Tennie gitlab at gitlab.haskell.org
Sat Aug 15 12:37:48 UTC 2020



Sven Tennie pushed to branch wip/ghc-debug at Glasgow Haskell Compiler / GHC


Commits:
89178bf2 by Sven Tennie at 2020-08-15T14:37:33+02:00
END_TSO_QUEUE is not a closure type on it's own

Indeed it's a CONSTR_NOCAF.

- - - - -


5 changed files:

- libraries/ghc-heap/GHC/Exts/Heap.hs
- libraries/ghc-heap/GHC/Exts/Heap/Closures.hs
- − libraries/ghc-heap/cbits/utils.c
- libraries/ghc-heap/ghc-heap.cabal.in
- libraries/ghc-heap/tests/tso_and_stack_closures.hs


Changes:

=====================================
libraries/ghc-heap/GHC/Exts/Heap.hs
=====================================
@@ -92,8 +92,6 @@ import Foreign
 
 #include "ghcconfig.h"
 
-foreign import ccall "isEndTsoQueue" isEndTsoQueue_c :: Addr# -> Bool
-
 -- | Some closures (e.g.TSOs) don't have corresponding types to represent them in Haskell.
 -- So when we have a pointer to such closure that we want to inspect, we `unsafeCoerce` it
 -- into the following `LiftedClosure` lifted type (could be any lifted type) so that the
@@ -355,30 +353,26 @@ getClosureX get_closure_raw x = do
 
             allocaArray (length wds) (\ptr -> do
                 pokeArray ptr wds
--- TODO: Does this work? I.e. do we emit EndTSOQueues?
-                if isEndTsoQueue_c (unpackPtr ptr) then
-                    pure $ EndTSOQueue { info = itbl }
-                else do
-                    fields <- FFIClosures.peekTSOFields peekStgTSOProfInfo ptr
-
-                    pure $ TSOClosure
-                        { info = itbl
-                        , _link = (pts !! 0)
-                        , global_link = (pts !! 1)
-                        , tsoStack = (pts !! 2)
-                        , trec = (pts !! 3)
-                        , blocked_exceptions = (pts !! 4)
-                        , bq = (pts !! 5)
-                        , what_next = FFIClosures.tso_what_next fields
-                        , why_blocked = FFIClosures.tso_why_blocked fields
-                        , flags = FFIClosures.tso_flags fields
-                        , threadId = FFIClosures.tso_threadId fields
-                        , saved_errno = FFIClosures.tso_saved_errno fields
-                        , tso_dirty = FFIClosures.tso_dirty fields
-                        , alloc_limit = FFIClosures.tso_alloc_limit fields
-                        , tot_stack_size = FFIClosures.tso_tot_stack_size fields
-                        , prof = FFIClosures.tso_prof fields
-                        }
+
+                fields <- FFIClosures.peekTSOFields peekStgTSOProfInfo ptr
+                pure $ TSOClosure
+                    { info = itbl
+                    , _link = (pts !! 0)
+                    , global_link = (pts !! 1)
+                    , tsoStack = (pts !! 2)
+                    , trec = (pts !! 3)
+                    , blocked_exceptions = (pts !! 4)
+                    , bq = (pts !! 5)
+                    , what_next = FFIClosures.tso_what_next fields
+                    , why_blocked = FFIClosures.tso_why_blocked fields
+                    , flags = FFIClosures.tso_flags fields
+                    , threadId = FFIClosures.tso_threadId fields
+                    , saved_errno = FFIClosures.tso_saved_errno fields
+                    , tso_dirty = FFIClosures.tso_dirty fields
+                    , alloc_limit = FFIClosures.tso_alloc_limit fields
+                    , tot_stack_size = FFIClosures.tso_tot_stack_size fields
+                    , prof = FFIClosures.tso_prof fields
+                    }
                 )
         STACK -> do
             unless (length pts == 1) $


=====================================
libraries/ghc-heap/GHC/Exts/Heap/Closures.hs
=====================================
@@ -296,10 +296,6 @@ data GenClosure b
       , tot_stack_size :: Word32
       , prof :: Maybe StgTSOProfInfo
       }
-  -- | Marker for the end of TSO queues
-  -- Technically it has the same structure as an StgTSO, but most data isn't initialized.
-  | EndTSOQueue
-     { info :: !StgInfoTable }
   -- Representation of StgStack: The 'tsoStack' of a 'TSOClosure'.
   | StackClosure
      { info :: !StgInfoTable


=====================================
libraries/ghc-heap/cbits/utils.c deleted
=====================================
@@ -1,8 +0,0 @@
-#include <stdio.h>
-#include "Rts.h"
-
-bool isEndTsoQueue(StgTSO* tso){
-    errorBelch("tso: %p", tso);
-    errorBelch("END_TSO_QUEUE: %p", END_TSO_QUEUE);
-    return tso == END_TSO_QUEUE;
-}


=====================================
libraries/ghc-heap/ghc-heap.cabal.in
=====================================
@@ -30,7 +30,6 @@ library
 
   ghc-options:      -Wall
   cmm-sources:      cbits/HeapPrim.cmm
-  c-sources:        cbits/utils.c
 
   default-extensions: NoImplicitPrelude
 


=====================================
libraries/ghc-heap/tests/tso_and_stack_closures.hs
=====================================
@@ -26,6 +26,7 @@ main = do
     let !_linkBox = _link tso
     _linkClosure <- getBoxedClosureData _linkBox
     assertEqual (name _linkClosure) "END_TSO_QUEUE"
+    assertEqual (getClosureType _linkClosure) CONSTR_NOCAF
 
     let !global_linkBox = global_link tso
     globalLinkClosure <- getBoxedClosureData global_linkBox



View it on GitLab: https://gitlab.haskell.org/ghc/ghc/-/commit/89178bf2199243f357a40b2b4ce6e597af0ff7cf

-- 
View it on GitLab: https://gitlab.haskell.org/ghc/ghc/-/commit/89178bf2199243f357a40b2b4ce6e597af0ff7cf
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/20200815/740578ff/attachment-0001.html>


More information about the ghc-commits mailing list