[Git][ghc/ghc][wip/bytecode-improvements] Deleted 1 commit: rts: Annotate BCOs with their Name

Ben Gamari (@bgamari) gitlab at gitlab.haskell.org
Fri Nov 8 20:12:24 UTC 2024



Ben Gamari pushed to branch wip/bytecode-improvements at Glasgow Haskell Compiler / GHC


WARNING: The push did not contain any new commits, but force pushed to delete the commits and changes below.


Deleted commits:
5f7c2d3e by Ben Gamari at 2024-11-01T15:04:01-04:00
rts: Annotate BCOs with their Name

- - - - -


6 changed files:

- compiler/GHC/ByteCode/Asm.hs
- compiler/GHC/ByteCode/Instr.hs
- compiler/GHC/StgToByteCode.hs
- rts/Disassembler.c
- rts/Interpreter.c
- rts/include/rts/Bytecodes.h


Changes:

=====================================
compiler/GHC/ByteCode/Asm.hs
=====================================
@@ -106,7 +106,7 @@ assembleBCOs interp profile proto_bcos tycons top_strs modbreaks spt_entries = d
   bcos'   <- mallocStrings interp bcos
   return CompiledByteCode
     { bc_bcos = bcos'
-    , bc_itbls =  itblenv
+    , bc_itbls = itblenv
     , bc_ffis = concatMap protoBCOFFIs proto_bcos
     , bc_strs = top_strs
     , bc_breaks = modbreaks
@@ -178,11 +178,12 @@ assembleOneBCO interp profile pbco = do
   return ubco'
 
 assembleBCO :: Platform -> ProtoBCO Name -> IO UnlinkedBCO
-assembleBCO platform (ProtoBCO { protoBCOName       = nm
-                             , protoBCOInstrs     = instrs
-                             , protoBCOBitmap     = bitmap
-                             , protoBCOBitmapSize = bsize
-                             , protoBCOArity      = arity }) = do
+assembleBCO platform
+            (ProtoBCO { protoBCOName       = nm
+                      , protoBCOInstrs     = instrs
+                      , protoBCOBitmap     = bitmap
+                      , protoBCOBitmapSize = bsize
+                      , protoBCOArity      = arity }) = do
   -- pass 1: collect up the offsets of the local labels.
   let asm = mapM_ (assembleI platform) instrs
 
@@ -527,6 +528,8 @@ assembleI platform i = case i of
                                                   , SmallOp tickx, SmallOp infox
                                                   , Op np
                                                   ]
+  BCO_NAME name            -> do np <- lit [BCONPtrStr name]
+                                 emit bci_BCO_NAME [Op np]
 
   where
     literal (LitLabel fs _)   = litlabel fs


=====================================
compiler/GHC/ByteCode/Instr.hs
=====================================
@@ -27,6 +27,8 @@ import GHC.Runtime.Heap.Layout ( StgWord )
 import Data.Int
 import Data.Word
 
+import Data.ByteString (ByteString)
+
 import GHC.Stack.CCS (CostCentre)
 
 import GHC.Stg.Syntax
@@ -229,6 +231,10 @@ data BCInstr
                       !Word16                -- breakpoint info index
                       (RemotePtr CostCentre)
 
+   -- | A "meta"-instruction for recording the name of a BCO for debugging purposes.
+   -- These are ignored by the interpreter but helpfully printed by the disassmbler.
+   | BCO_NAME         !ByteString
+
 -- -----------------------------------------------------------------------------
 -- Printing bytecode instructions
 
@@ -383,6 +389,7 @@ instance Outputable BCInstr where
                                <+> text "<tick_module>" <+> ppr tickx
                                <+> text "<info_module>" <+> ppr infox
                                <+> text "<cc>"
+   ppr (BCO_NAME nm)         = text "BCO_NAME" <+> text (show nm)
 
 
 
@@ -487,3 +494,4 @@ bciStackUse SLIDE{}               = 0
 bciStackUse MKAP{}                = 0
 bciStackUse MKPAP{}               = 0
 bciStackUse PACK{}                = 1 -- worst case is PACK 0 words
+bciStackUse BCO_NAME{}            = 0


=====================================
compiler/GHC/StgToByteCode.hs
=====================================
@@ -81,6 +81,7 @@ import GHC.Unit.Home.ModInfo (lookupHpt)
 import Data.Array
 import Data.Coerce (coerce)
 import Data.ByteString (ByteString)
+import qualified Data.ByteString.Char8 as BS
 import Data.Map (Map)
 import Data.IntMap (IntMap)
 import qualified Data.Map as Map
@@ -236,7 +237,8 @@ ppBCEnv p
 -- Create a BCO and do a spot of peephole optimisation on the insns
 -- at the same time.
 mkProtoBCO
-   :: Platform
+   :: (Outputable name)
+   => Platform
    -> name
    -> BCInstrList
    -> Either  [CgStgAlt] (CgStgRhs)
@@ -250,7 +252,7 @@ mkProtoBCO
 mkProtoBCO platform nm instrs_ordlist origin arity bitmap_size bitmap is_ret ffis
    = ProtoBCO {
         protoBCOName = nm,
-        protoBCOInstrs = maybe_with_stack_check,
+        protoBCOInstrs = maybe_add_bco_name $ maybe_add_stack_check peep_d,
         protoBCOBitmap = bitmap,
         protoBCOBitmapSize = fromIntegral bitmap_size,
         protoBCOArity = arity,
@@ -258,6 +260,10 @@ mkProtoBCO platform nm instrs_ordlist origin arity bitmap_size bitmap is_ret ffi
         protoBCOFFIs = ffis
       }
      where
+        maybe_add_bco_name instrs = BCO_NAME str : instrs
+          where
+            str = BS.pack $ showSDocOneLine defaultSDocContext (ppr nm)
+
         -- Overestimate the stack usage (in words) of this BCO,
         -- and if >= iNTERP_STACK_CHECK_THRESH, add an explicit
         -- stack check.  (The interpreter always does a stack check
@@ -265,17 +271,17 @@ mkProtoBCO platform nm instrs_ordlist origin arity bitmap_size bitmap is_ret ffi
         -- BCO anyway, so we only need to add an explicit one in the
         -- (hopefully rare) cases when the (overestimated) stack use
         -- exceeds iNTERP_STACK_CHECK_THRESH.
-        maybe_with_stack_check
-           | is_ret && stack_usage < fromIntegral (pc_AP_STACK_SPLIM (platformConstants platform)) = peep_d
+        maybe_add_stack_check instrs
+           | is_ret && stack_usage < fromIntegral (pc_AP_STACK_SPLIM (platformConstants platform)) = instrs
                 -- don't do stack checks at return points,
                 -- everything is aggregated up to the top BCO
                 -- (which must be a function).
                 -- That is, unless the stack usage is >= AP_STACK_SPLIM,
                 -- see bug #1466.
            | stack_usage >= fromIntegral iNTERP_STACK_CHECK_THRESH
-           = STKCHECK stack_usage : peep_d
+           = STKCHECK stack_usage : instrs
            | otherwise
-           = peep_d     -- the supposedly common case
+           = instrs     -- the supposedly common case
 
         -- We assume that this sum doesn't wrap
         stack_usage = sum (map bciStackUse peep_d)


=====================================
rts/Disassembler.c
=====================================
@@ -452,6 +452,13 @@ disInstr ( StgBCO *bco, int pc )
          debugBelch("RETURN_T\n ");
          break;
 
+      case bci_BCO_NAME: {
+         const char *name = (const char*) literals[instrs[pc]];
+         debugBelch("BCO_NAME    \"%s\"\n ", name);
+         pc += 1;
+         break;
+      }
+
       default:
          barf("disInstr: unknown opcode %u", (unsigned int) instr);
    }
@@ -464,10 +471,9 @@ void disassemble( StgBCO *bco )
    StgWord16*     instrs  = (StgWord16*)(bco->instrs->payload);
    StgMutArrPtrs* ptrs    = bco->ptrs;
    uint32_t       nbcs    = (uint32_t)(bco->instrs->bytes / sizeof(StgWord16));
-   uint32_t       pc      = 1;
+   uint32_t       pc      = 0;
 
    debugBelch("BCO\n" );
-   pc = 0;
    while (pc < nbcs) {
       debugBelch("\t%2d:  ", pc );
       pc = disInstr ( bco, pc );


=====================================
rts/Interpreter.c
=====================================
@@ -2087,6 +2087,10 @@ run_BCO:
             goto do_return_nonpointer;
         }
 
+        case bci_BCO_NAME:
+            BCO_NEXT;
+            goto nextInsn;
+
         case bci_SWIZZLE: {
             W_ stkoff = BCO_GET_LARGE_ARG;
             StgInt n = BCO_GET_LARGE_ARG;


=====================================
rts/include/rts/Bytecodes.h
=====================================
@@ -112,6 +112,8 @@
 
 #define bci_PRIMCALL                    87
 
+#define bci_BCO_NAME                    88
+
 /* If you need to go past 255 then you will run into the flags */
 
 /* If you need to go below 0x0100 then you will run into the instructions */



View it on GitLab: https://gitlab.haskell.org/ghc/ghc/-/commit/5f7c2d3e99ccae94d5cebfb7412ee20c49562037

-- 
View it on GitLab: https://gitlab.haskell.org/ghc/ghc/-/commit/5f7c2d3e99ccae94d5cebfb7412ee20c49562037
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/20241108/10ee44c9/attachment-0001.html>


More information about the ghc-commits mailing list