Disable the BCO disassembler master
authorJoachim Breitner <mail@joachim-breitner.de>
Wed, 15 Nov 2017 16:46:29 +0000 (11:46 -0500)
committerJoachim Breitner <mail@joachim-breitner.de>
Wed, 15 Nov 2017 16:46:29 +0000 (11:46 -0500)
as it causes problems such as https://github.com/def-/ghc-vis/issues/17

cbits/HeapView.c
src/GHC/Disassembler.hs
src/GHC/HeapView.hs

index 38f7922..427f4fc 100644 (file)
@@ -157,6 +157,8 @@ StgMutArrPtrs *gtc_heap_view_closurePtrs(Capability *cap, StgClosure *closure) {
     StgThunkInfoTable *thunk_info;
     StgFunInfoTable *fun_info;
 
+    // fprintf(stderr,"closurePtrs: Reading type %s\n", gtc_heap_view_closure_type_names[info->type]);
+
     switch (info->type) {
         case INVALID_OBJECT:
             barf("Invalid Object");
index 58d7ad2..8651f71 100644 (file)
@@ -234,7 +234,7 @@ disassemble ptrs lits = runGet $ do
                 _ <- getWord16host
                 _ <- getWord16host
                 return BCIBRK_FUN
-            x -> error $ "Unknown opcode " ++ show x
+            x -> return $ BCI_DECODE_ERROR x
         (i :) `fmap` nextInst
 
 
@@ -296,6 +296,7 @@ data BCI box
     | BCIBRK_FUN -- ^ We do not parse this opcode's arguments
     | BCITESTLT_W Word Int
     | BCITESTEQ_W Word Int
+    | BCI_DECODE_ERROR Word16
     deriving (Show, Functor, Traversable, Foldable)
 
 #if MIN_VERSION_binary(0,8,1)
index 2eda349..7990956 100644 (file)
@@ -708,11 +708,12 @@ ppClosure showBox prec c = case c of
     APStackClosure {..} -> app $ map (showBox 10) $
         fun : payload
     BCOClosure {..} -> app
-        ["_bco"]
+        ["_bco", showBox 10 bcoptrs]
     ArrWordsClosure {..} -> app
         ["toArray", "("++show (length arrWords) ++ " words)", intercalate "," (shorten (map show arrWords)) ]
     MutArrClosure {..} -> app
-        ["toMutArray", "("++show (length mccPayload) ++ " ptrs)",  intercalate "," (shorten (map (showBox 10) mccPayload))]
+        --["toMutArray", "("++show (length mccPayload) ++ " ptrs)",  intercalate "," (shorten (map (showBox 10) mccPayload))]
+        ["[", intercalate ", " (shorten (map (showBox 10) mccPayload)),"]"]
     MutVarClosure {..} -> app $
         ["_mutVar", (showBox 10) var]
     MVarClosure {..} -> app $
@@ -1032,6 +1033,8 @@ boundMultipleTimes (HeapGraph m) roots = map head $ filter (not.null) $ map tail
 --
 -- If any of these return 'Nothing', then 'disassembleBCO' returns Nothing
 disassembleBCO :: (a -> Maybe (GenClosure b)) -> GenClosure a -> Maybe [BCI b]
+-- Disable the assembler
+disassembleBCO _ _ | id True = Nothing
 disassembleBCO deref (BCOClosure {..}) = do
     opsC <- deref instrs
     litsC <- deref literals