Wolfgang Jeltsch pushed to branch wip/jeltsch/textual-bytecode-output at Glasgow Haskell Compiler / GHC Commits: 913f5c1b by Wolfgang Jeltsch at 2026-05-28T15:51:27+03:00 Work in progress - - - - - c7150e2d by Wolfgang Jeltsch at 2026-05-28T15:51:41+03:00 `CompiledByteCode` wibbles - - - - - 5 changed files: - compiler/GHC/ByteCode/Serialize.hs - + compiler/GHC/ByteCode/Show.hs - compiler/ghc.cabal.in - ghc/GHC/Driver/Session/Mode.hs - ghc/Main.hs Changes: ===================================== compiler/GHC/ByteCode/Serialize.hs ===================================== @@ -6,7 +6,7 @@ {- | This module implements the serialization of bytecode objects to and from disk. -} module GHC.ByteCode.Serialize - ( writeBinByteCode, readBinByteCode + ( writeBinByteCode, readBinByteCode, readOnDiskModuleByteCode , ModuleByteCode(..) , BytecodeLibX(..) , BytecodeLib ===================================== compiler/GHC/ByteCode/Show.hs ===================================== @@ -0,0 +1,139 @@ +{-# LANGUAGE RecordWildCards #-} +{-# LANGUAGE ScopedTypeVariables #-} + +-- | […] +module GHC.ByteCode.Show (showByteCode) where + +import Data.Ord ((<)) +import Data.Function (($), (&), (.)) +import Data.Bool (otherwise) +import Data.Int (Int) +import Data.Word (Word8) +import Data.Maybe (maybe) +import Data.List (map, zipWith) +import Data.String (String) +import Data.ByteString (ByteString, null, length, unpack) +import Numeric (showHex) +import System.IO (IO, FilePath) +import GHC.Types.SrcLoc (noSrcSpan) +import GHC.Types.Error (MessageClass (MCDump)) +import GHC.Utils.Logger (Logger, logMsg) +import GHC.Utils.Outputable + ( + defaultDumpStyle, + SDoc, + text, + (<+>), + hsep, + nest, + vcat, + withPprStyle, + ppr + ) +import GHC.ByteCode.Types (CompiledByteCode (..)) +import GHC.ByteCode.Binary (OnDiskModuleByteCode (..)) +import GHC.ByteCode.Serialize (readOnDiskModuleByteCode) +import GHC.Driver.Env.Types (HscEnv) + +-- | […] +showByteCode :: Logger -> HscEnv -> FilePath -> IO () +showByteCode logger env path = do + byteCode <- readOnDiskModuleByteCode env path + logMsg logger + MCDump + noSrcSpan + (withPprStyle defaultDumpStyle $ pprOnDiskModuleByteCode byteCode) + +-- | […] +pprOnDiskModuleByteCode :: OnDiskModuleByteCode -> SDoc +pprOnDiskModuleByteCode OnDiskModuleByteCode {..} + = vcat $ + [ + text "module" <+> ppr odgbc_module, + nest 2 $ vcat + [ + text "hash:" + <+> ppr odgbc_hash, + text "compiled bytecode:" + <+> pprCompiledByteCode odgbc_compiled_byte_code, + text "contents of object files:" + <+> pprObjectFileContents odgbc_foreign + ] + ] + +-- | […] +pprCompiledByteCode :: CompiledByteCode -> SDoc +pprCompiledByteCode CompiledByteCode {..} + = vcat + [ + text "bytecode objects" + <+> pprByteCodeObjects bc_bcos, + text "data constructor info tables:" + <+> pprDataConstructorInfoTables bc_itbls, + text "top-level strings:" + <+> pprTopLevelStrings bc_strs, + text "break points:" + <+> maybe (text "<none>") pprInternalBreakPoints bc_breaks, + text "static-pointer table entries:" + <+> pprStaticPointerTableEntries bc_spt_entries, + text "HPC information:" + <+> pprHPCInfo bc_hpc_info + ] + +-- | […] +pprByteCodeObjects :: a -> SDoc +pprByteCodeObjects = pprByteCodeObjects + +-- | […] +pprDataConstructorInfoTables :: a -> SDoc +pprDataConstructorInfoTables = pprDataConstructorInfoTables + +-- | […] +pprTopLevelStrings :: a -> SDoc +pprTopLevelStrings = pprTopLevelStrings + +-- | […] +pprInternalBreakPoints :: a -> SDoc +pprInternalBreakPoints = pprInternalBreakPoints + +-- | […] +pprStaticPointerTableEntries :: a -> SDoc +pprStaticPointerTableEntries = pprStaticPointerTableEntries + +-- | […] +pprHPCInfo :: a -> SDoc +pprHPCInfo = pprHPCInfo + +-- | […] +pprObjectFileContents :: [ByteString] -> SDoc +pprObjectFileContents = vcatOrNone . zipWith pprEntry [0 ..] where + + pprEntry :: Int -> ByteString -> SDoc + pprEntry ix content + = vcat [ + hsep [ + text "file", + ppr ix, + text "of length", + ppr (length content) + ], + nest 2 $ pprByteString content + ] + +-- | […] +pprByteString :: ByteString -> SDoc +pprByteString byteString + | null byteString = text "<empty>" + | otherwise = byteString & unpack & map pprByte & hsep + +-- | […] +pprByte :: Word8 -> SDoc +pprByte byte = text $ if byte < 16 then '0' : unpadded else unpadded where + + unpadded :: String + unpadded = showHex byte "" + +-- | […] +vcatOrNone :: [SDoc] -> SDoc +vcatOrNone [] = text "<none>" +vcatOrNone docs = vcat docs ===================================== compiler/ghc.cabal.in ===================================== @@ -217,6 +217,7 @@ Library GHC.ByteCode.Linker GHC.ByteCode.Recomp.Binary GHC.ByteCode.Serialize + GHC.ByteCode.Show GHC.ByteCode.Types GHC.Cmm GHC.Cmm.BlockId ===================================== ghc/GHC/Driver/Session/Mode.hs ===================================== @@ -77,6 +77,7 @@ isShowGhciUsageMode _ = False data PostLoadMode = ShowInterface FilePath -- ghc --show-iface + | ShowByteCode FilePath -- ghc --show-byte-code | DoMkDependHS -- ghc -M | StopBefore StopPhase -- ghc -E | -C | -S -- StopBefore StopLn is the default @@ -101,6 +102,9 @@ showUnitsMode = mkPostLoadMode ShowPackages showInterfaceMode :: FilePath -> Mode showInterfaceMode fp = mkPostLoadMode (ShowInterface fp) +showByteCodeMode :: FilePath -> Mode +showByteCodeMode fp = mkPostLoadMode (ShowByteCode fp) + stopBeforeMode :: StopPhase -> Mode stopBeforeMode phase = mkPostLoadMode (StopBefore phase) @@ -231,9 +235,11 @@ mode_flags = replaceSpace ' ' = '-' replaceSpace c = c ] ++ - ------- interfaces ---------------------------------------------------- - [ defFlag "-show-iface" (HasArg (\f -> setMode (showInterfaceMode f) + ------- textual output of generated data ----------------------------- + [ defFlag "-show-iface" (HasArg (\f -> setMode (showInterfaceMode f) "--show-iface")) + , defFlag "-show-byte-code" (HasArg (\f -> setMode (showByteCodeMode f) + "--show-byte-code")) ------- primary modes ------------------------------------------------ , defFlag "c" (PassFlag (\f -> do setMode (stopBeforeMode NoStop) f ===================================== ghc/Main.hs ===================================== @@ -73,6 +73,8 @@ import GHC.SysTools.BaseDir import GHC.Iface.Load import GHC.Iface.Recomp.Binary ( fingerprintBinMem ) +import GHC.ByteCode.Show ( showByteCode ) + import GHC.Tc.Utils.Monad ( initIfaceCheck ) import GHC.Iface.Errors.Ppr @@ -266,6 +268,7 @@ main' postLoadMode units dflags0 args flagWarnings = do (hsc_units hsc_env) (hsc_NC hsc_env) f + ShowByteCode f -> liftIO $ showByteCode logger hsc_env f DoMake -> doMake units srcs DoMkDependHS -> doMkDependHS (map fst srcs) StopBefore p -> liftIO (oneShot hsc_env p srcs) View it on GitLab: https://gitlab.haskell.org/ghc/ghc/-/compare/6ad9b2334ffd78b41e06ae8182ae43f... -- View it on GitLab: https://gitlab.haskell.org/ghc/ghc/-/compare/6ad9b2334ffd78b41e06ae8182ae43f... You're receiving this email because of your account on gitlab.haskell.org.