summaryrefslogtreecommitdiff
diff options
context:
space:
mode:
authorCheng Shao <astrohavoc@gmail.com>2022-10-28 17:27:24 +0000
committerMarge Bot <ben+marge-bot@smart-cactus.org>2022-11-11 00:26:55 -0500
commita8adc71e80734c6dc2e119596368f84e39fd1172 (patch)
treea194112eb7a9bd0db51fda32a4a869a395e16362
parentc1fe4ab6ee00b21c1918f67b58ad78be5b044109 (diff)
downloadhaskell-a8adc71e80734c6dc2e119596368f84e39fd1172.tar.gz
compiler: annotate CmmFileEmbed with blob length
This patch adds the blob length field to CmmFileEmbed. The wasm32 NCG needs to know the precise size of each data segment.
-rw-r--r--compiler/GHC/Cmm.hs8
-rw-r--r--compiler/GHC/Cmm/Utils.hs6
-rw-r--r--compiler/GHC/CmmToAsm/AArch64/Ppr.hs2
-rw-r--r--compiler/GHC/CmmToAsm/PPC/Ppr.hs2
-rw-r--r--compiler/GHC/CmmToAsm/X86/Ppr.hs2
-rw-r--r--compiler/GHC/StgToCmm.hs4
6 files changed, 12 insertions, 12 deletions
diff --git a/compiler/GHC/Cmm.hs b/compiler/GHC/Cmm.hs
index b764e80281..77a6574eb5 100644
--- a/compiler/GHC/Cmm.hs
+++ b/compiler/GHC/Cmm.hs
@@ -282,8 +282,8 @@ data CmmStatic
-- ^ uninitialised data, N bytes long
| CmmString ByteString
-- ^ string of 8-bit values only, not zero terminated.
- | CmmFileEmbed FilePath
- -- ^ an embedded binary file
+ | CmmFileEmbed FilePath Int
+ -- ^ an embedded binary file and its byte length
instance OutputableP Platform CmmStatic where
pdoc = pprStatic
@@ -292,7 +292,7 @@ instance Outputable CmmStatic where
ppr (CmmStaticLit lit) = text "CmmStaticLit" <+> ppr lit
ppr (CmmUninitialised n) = text "CmmUninitialised" <+> ppr n
ppr (CmmString _) = text "CmmString"
- ppr (CmmFileEmbed fp) = text "CmmFileEmbed" <+> text fp
+ ppr (CmmFileEmbed fp _) = text "CmmFileEmbed" <+> text fp
-- Static data before SRT generation
data GenCmmStatics (rawOnly :: Bool) where
@@ -444,7 +444,7 @@ pprStatic platform s = case s of
CmmStaticLit lit -> nest 4 $ text "const" <+> pdoc platform lit <> semi
CmmUninitialised i -> nest 4 $ text "I8" <> brackets (int i)
CmmString s' -> nest 4 $ text "I8[]" <+> text (show s')
- CmmFileEmbed path -> nest 4 $ text "incbin " <+> text (show path)
+ CmmFileEmbed path _ -> nest 4 $ text "incbin " <+> text (show path)
-- --------------------------------------------------------------------------
-- data sections
diff --git a/compiler/GHC/Cmm/Utils.hs b/compiler/GHC/Cmm/Utils.hs
index 7524ba7c5e..bf8c96fd14 100644
--- a/compiler/GHC/Cmm/Utils.hs
+++ b/compiler/GHC/Cmm/Utils.hs
@@ -197,9 +197,9 @@ mkByteStringCLit lbl bytes
-- | We make a top-level decl for the embedded binary file, and return a label pointing to it
mkFileEmbedLit
- :: CLabel -> FilePath -> (CmmLit, GenCmmDecl (GenCmmStatics raw) info stmt)
-mkFileEmbedLit lbl path
- = (CmmLabel lbl, CmmData (Section ReadOnlyData lbl) (CmmStaticsRaw lbl [CmmFileEmbed path]))
+ :: CLabel -> FilePath -> Int -> (CmmLit, GenCmmDecl (GenCmmStatics raw) info stmt)
+mkFileEmbedLit lbl path len
+ = (CmmLabel lbl, CmmData (Section ReadOnlyData lbl) (CmmStaticsRaw lbl [CmmFileEmbed path len]))
-- | Build a data-segment data block
diff --git a/compiler/GHC/CmmToAsm/AArch64/Ppr.hs b/compiler/GHC/CmmToAsm/AArch64/Ppr.hs
index 54cf73d55e..9997b8fb52 100644
--- a/compiler/GHC/CmmToAsm/AArch64/Ppr.hs
+++ b/compiler/GHC/CmmToAsm/AArch64/Ppr.hs
@@ -162,7 +162,7 @@ pprDatas config (CmmStaticsRaw lbl dats)
pprData :: NCGConfig -> CmmStatic -> SDoc
pprData _config (CmmString str) = pprString str
-pprData _config (CmmFileEmbed path) = pprFileEmbed path
+pprData _config (CmmFileEmbed path _) = pprFileEmbed path
pprData config (CmmUninitialised bytes)
= let platform = ncgPlatform config
diff --git a/compiler/GHC/CmmToAsm/PPC/Ppr.hs b/compiler/GHC/CmmToAsm/PPC/Ppr.hs
index 78abfcb0a3..e16006bcd2 100644
--- a/compiler/GHC/CmmToAsm/PPC/Ppr.hs
+++ b/compiler/GHC/CmmToAsm/PPC/Ppr.hs
@@ -168,7 +168,7 @@ pprDatas platform (CmmStaticsRaw lbl dats) = vcat (pprLabel platform lbl : map (
pprData :: Platform -> CmmStatic -> SDoc
pprData platform d = case d of
CmmString str -> pprString str
- CmmFileEmbed path -> pprFileEmbed path
+ CmmFileEmbed path _ -> pprFileEmbed path
CmmUninitialised bytes -> text ".space " <> int bytes
CmmStaticLit lit -> pprDataItem platform lit
diff --git a/compiler/GHC/CmmToAsm/X86/Ppr.hs b/compiler/GHC/CmmToAsm/X86/Ppr.hs
index 32b163357d..4e029902b8 100644
--- a/compiler/GHC/CmmToAsm/X86/Ppr.hs
+++ b/compiler/GHC/CmmToAsm/X86/Ppr.hs
@@ -184,7 +184,7 @@ pprDatas config (align, (CmmStaticsRaw lbl dats))
pprData :: NCGConfig -> CmmStatic -> SDoc
pprData _config (CmmString str) = pprString str
-pprData _config (CmmFileEmbed path) = pprFileEmbed path
+pprData _config (CmmFileEmbed path _) = pprFileEmbed path
pprData config (CmmUninitialised bytes)
= let platform = ncgPlatform config
diff --git a/compiler/GHC/StgToCmm.hs b/compiler/GHC/StgToCmm.hs
index 4efcf69d18..1ae0dcd6e0 100644
--- a/compiler/GHC/StgToCmm.hs
+++ b/compiler/GHC/StgToCmm.hs
@@ -188,10 +188,10 @@ cgTopBinding logger tmpfs cfg = \case
(lit,decl) = if asString
then mkByteStringCLit label str
- else mkFileEmbedLit label $ unsafePerformIO $ do
+ else unsafePerformIO $ do
bFile <- newTempName logger tmpfs (stgToCmmTmpDir cfg) TFL_CurrentModule ".dat"
BS.writeFile bFile str
- return bFile
+ return $ mkFileEmbedLit label bFile (BS.length str)
emitDecl decl
addBindC (litIdInfo (stgToCmmPlatform cfg) id mkLFStringLit lit)