[Git][ghc/ghc][wip/js-staging] JS: Note on JS .o file order, fix .o files
doyougnu (@doyougnu)
gitlab at gitlab.haskell.org
Thu Oct 13 02:20:29 UTC 2022
doyougnu pushed to branch wip/js-staging at Glasgow Haskell Compiler / GHC
Commits:
1913cd1d by doyougnu at 2022-10-12T22:18:49-04:00
JS: Note on JS .o file order, fix .o files
To be specific:
1. add Note [JS Backend .o file procedure]
2. ensure that .o files are touch'd in JS backend postHsc phase. This
fixes "missing object file" errors produced by
'GHC.Driver.Main.checkObjects'.
- - - - -
2 changed files:
- compiler/GHC/Driver/Pipeline/Execute.hs
- compiler/GHC/StgToJS/Linker/Linker.hs
Changes:
=====================================
compiler/GHC/Driver/Pipeline/Execute.hs
=====================================
@@ -346,7 +346,34 @@ runAsPhase with_cpp pipe_env hsc_env location input_fn = do
return output_fn
--- | Embed .js files into .o files
+-- Note [JS Backend .o file procedure ]
+-- ~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~
+--
+-- The JS backend breaks some of the assumptions on file generation order
+-- because it directly produces .o files. This violation breaks some of the
+-- assumptions on file timestamps, particularly in the postHsc phase. The
+-- postHsc phase for the JS backend is performed in 'runJsPhase'. Consider
+-- what the NCG does:
+--
+-- With other NCG backends we have the following order:
+-- 1. The backend produces a .s file
+-- 2. Then we write the interface file, .hi
+-- 3. Then we generate a .o file in a postHsc phase (calling the asm phase etc.)
+--
+-- For the JS Backend this order is different
+-- 1. The JS Backend _directly_ produces .o files (via
+-- 'GHC.StgToJS.Linker.Linker.embedJsFile')
+-- 2. Then we write the interface file. Notice that this breaks the ordering
+-- of .hi > .o (step 2 and step 3 in the NCG above).
+--
+-- This violation results in timestamp checks which pass on the NCG but fail
+-- in the JS backend. In particular, checks that compare 'ms_obj_date', and
+-- 'ms_iface_date' in 'GHC.Unit.Module.ModSummary'.
+--
+-- Thus to fix this ordering we touch the object files we generated earlier
+-- to ensure these timestamps abide by the proper ordering.
+
+-- | Run the JS Backend postHsc phase.
runJsPhase :: PipeEnv -> HscEnv -> FilePath -> IO FilePath
runJsPhase pipe_env hsc_env input_fn = do
let dflags = hsc_dflags hsc_env
@@ -355,7 +382,16 @@ runJsPhase pipe_env hsc_env input_fn = do
let unit_env = hsc_unit_env hsc_env
output_fn <- phaseOutputFilenameNew StopLn pipe_env hsc_env Nothing
- embedJsFile logger dflags tmpfs unit_env input_fn output_fn
+
+ -- if the input filename is the same as the output, then we've probably
+ -- generated the object ourselves. In this case, we touch the object file to
+ -- ensure the timestamp is refreshed, see Note [ JS Backend .o Files ]. If
+ -- they are not the same then we embed the .js file into a .o file with the
+ -- addition of a header
+ if (input_fn /= output_fn)
+ then embedJsFile logger dflags tmpfs unit_env input_fn output_fn
+ else touchObjectFile logger dflags output_fn
+
return output_fn
=====================================
compiler/GHC/StgToJS/Linker/Linker.hs
=====================================
@@ -811,54 +811,50 @@ embedJsFile :: Logger -> DynFlags -> TmpFs -> UnitEnv -> FilePath -> FilePath ->
embedJsFile logger dflags tmpfs unit_env input_fn output_fn = do
let profiling = False -- FIXME: add support for profiling way
- -- if the input filename is the same as the output, then we've probably
- -- generated the object ourselves, we leave the file alone
- when (input_fn /= output_fn) $ do
-
- -- the header lets the linker recognize processed JavaScript files
- -- But don't add JavaScript header to object files!
-
- is_js_obj <- if True
- then pure False
- else isJsObjectFile input_fn
- -- FIXME (Sylvain 2022-09): this call makes the
- -- testsuite go into a loop, I don't know why yet!
- -- Disabling it for now.
-
- if is_js_obj
- then copyWithHeader "" input_fn output_fn
- else do
- -- header appended to JS files stored as .o to recognize them.
- let header = "//JavaScript\n"
- jsFileNeedsCpp input_fn >>= \case
- False -> copyWithHeader header input_fn output_fn
- True -> do
-
- -- append common CPP definitions to the .js file.
- -- They define macros that avoid directly wiring zencoded names
- -- in RTS JS files
- pp_fn <- newTempName logger tmpfs (tmpDir dflags) TFL_CurrentModule "js"
- payload <- B.readFile input_fn
- B.writeFile pp_fn (commonCppDefs profiling <> payload)
-
- -- run CPP on the input JS file
- js_fn <- newTempName logger tmpfs (tmpDir dflags) TFL_CurrentModule "js"
- let
- cpp_opts = CppOpts
- { cppUseCc = True
- , cppLinePragmas = False -- LINE pragmas aren't JS compatible
- }
- extra_opts = []
- doCpp logger
- tmpfs
- dflags
- unit_env
- cpp_opts
- extra_opts
- pp_fn
- js_fn
- -- add header to recognize the object as a JS file
- copyWithHeader header js_fn output_fn
+ -- the header lets the linker recognize processed JavaScript files
+ -- But don't add JavaScript header to object files!
+
+ is_js_obj <- if True
+ then pure False
+ else isJsObjectFile input_fn
+ -- FIXME (Sylvain 2022-09): this call makes the
+ -- testsuite go into a loop, I don't know why yet!
+ -- Disabling it for now.
+
+ if is_js_obj
+ then copyWithHeader "" input_fn output_fn
+ else do
+ -- header appended to JS files stored as .o to recognize them.
+ let header = "//JavaScript\n"
+ jsFileNeedsCpp input_fn >>= \case
+ False -> copyWithHeader header input_fn output_fn
+ True -> do
+
+ -- append common CPP definitions to the .js file.
+ -- They define macros that avoid directly wiring zencoded names
+ -- in RTS JS files
+ pp_fn <- newTempName logger tmpfs (tmpDir dflags) TFL_CurrentModule "js"
+ payload <- B.readFile input_fn
+ B.writeFile pp_fn (commonCppDefs profiling <> payload)
+
+ -- run CPP on the input JS file
+ js_fn <- newTempName logger tmpfs (tmpDir dflags) TFL_CurrentModule "js"
+ let
+ cpp_opts = CppOpts
+ { cppUseCc = True
+ , cppLinePragmas = False -- LINE pragmas aren't JS compatible
+ }
+ extra_opts = []
+ doCpp logger
+ tmpfs
+ dflags
+ unit_env
+ cpp_opts
+ extra_opts
+ pp_fn
+ js_fn
+ -- add header to recognize the object as a JS file
+ copyWithHeader header js_fn output_fn
jsFileNeedsCpp :: FilePath -> IO Bool
jsFileNeedsCpp fn = do
View it on GitLab: https://gitlab.haskell.org/ghc/ghc/-/commit/1913cd1da770c7258178f1e71b8de81fa7383a04
--
View it on GitLab: https://gitlab.haskell.org/ghc/ghc/-/commit/1913cd1da770c7258178f1e71b8de81fa7383a04
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/20221012/687a5b41/attachment-0001.html>
More information about the ghc-commits
mailing list