[Git][ghc/ghc][wip/osa1/std_string_thunks] 10 commits: remove a no-warn directive from GHC.Cmm.ContFlowOpt
Ben Gamari (@bgamari)
gitlab at gitlab.haskell.org
Fri Oct 21 13:59:41 UTC 2022
Ben Gamari pushed to branch wip/osa1/std_string_thunks at Glasgow Haskell Compiler / GHC
Commits:
8cd6f435 by Curran McConnell at 2022-10-21T02:58:01-04:00
remove a no-warn directive from GHC.Cmm.ContFlowOpt
This patch is motivated by the desire to remove the {-# OPTIONS_GHC
-fno-warn-incomplete-patterns #-} directive at the top of
GHC.Cmm.ContFlowOpt. (Based on the text in this coding standards doc, I
understand it's a goal of the project to remove such directives.) I
chose this task because I'm a new contributor to GHC, and it seemed like
a good way to get acquainted with the patching process.
In order to address the warning that arose when I removed the no-warn
directive, I added a case to removeUnreachableBlocksProc to handle the
CmmData constructor. Clearly, since this partial function has not been
erroring out in the wild, its inputs are always in practice wrapped by
the CmmProc constructor. Therefore the CmmData case is handled by a
precise panic (which is an improvement over the partial pattern match
from before).
- - - - -
a2af7c4c by Nicolas Trangez at 2022-10-21T02:58:39-04:00
build: get rid of `HAVE_TIME_H`
As advertized by `autoreconf`:
> All current systems provide time.h; it need not be checked for.
Hence, remove the check for it in `configure.ac` and remove conditional
inclusion of the header in `HAVE_TIME_H` blocks where applicable.
The `time.h` header was being included in various source files without a
`HAVE_TIME_H` guard already anyway.
- - - - -
25cdc630 by Nicolas Trangez at 2022-10-21T02:58:39-04:00
rts: remove use of `TIME_WITH_SYS_TIME`
`autoreconf` will insert an `m4_warning` when the obsolescent
`AC_HEADER_TIME` macro is used:
> Update your code to rely only on HAVE_SYS_TIME_H,
> then remove this warning and the obsolete code below it.
> All current systems provide time.h; it need not be checked for.
> Not all systems provide sys/time.h, but those that do, all allow
> you to include it and time.h simultaneously.
Presence of `sys/time.h` was already checked in an earlier
`AC_CHECK_HEADERS` invocation, so `AC_HEADER_TIME` can be dropped and
guards relying on `TIME_WITH_SYS_TIME` can be reworked to
(unconditionally) include `time.h` and include `sys/time.h` based on
`HAVE_SYS_TIME_H`.
Note the documentation of `AC_HEADER_TIME` in (at least) Autoconf 2.67
says
> This macro is obsolescent, as current systems can include both files
> when they exist. New programs need not use this macro.
- - - - -
1fe7921c by Eric Lindblad at 2022-10-21T02:59:21-04:00
runhaskell
- - - - -
e3b3986e by David Feuer at 2022-10-21T03:00:00-04:00
Document how to quote certain names with spaces
Quoting a name for Template Haskell is a bit tricky if the second
character of that name is a single quote. The User's Guide falsely
claimed that it was impossible. Document how to do it.
Fixes #22236
- - - - -
0eba81e8 by Krzysztof Gogolewski at 2022-10-21T03:00:00-04:00
Fix syntax
- - - - -
a4dbd102 by Ben Gamari at 2022-10-21T09:11:12-04:00
Fix manifest filename when writing Windows .rc files
As noted in #12971, we previously used `show` which resulted in
inappropriate escaping of non-ASCII characters.
- - - - -
30f0d9a9 by Ben Gamari at 2022-10-21T09:11:12-04:00
Write response files in UTF-8 on Windows
This reverts the workaround introduced in
f63c8ef33ec9666688163abe4ccf2d6c0428a7e7, which taught our response file
logic to write response files with the `latin1` encoding to workaround
`gcc`'s lacking Unicode support. This is now no longer necessary (and in
fact actively unhelpful) since we rather use Clang.
- - - - -
b8304648 by M Farkas-Dyck at 2022-10-21T09:11:56-04:00
Scrub some partiality in `GHC.Core.Opt.Simplify.Utils`.
- - - - -
eb43bf22 by Ömer Sinan Ağacan at 2022-10-21T09:59:27-04:00
Introduce a standard thunk for allocating strings
Currently for a top-level closure in the form
hey = unpackCString# x
we generate code like this:
Main.hey_entry() // [R1]
{ info_tbls: [(c2T4,
label: Main.hey_info
rep: HeapRep static { Thunk }
srt: Nothing)]
stack_info: arg_space: 8 updfr_space: Just 8
}
{offset
c2T4: // global
_rqm::P64 = R1;
if ((Sp + 8) - 24 < SpLim) (likely: False) goto c2T5; else goto c2T6;
c2T5: // global
R1 = _rqm::P64;
call (stg_gc_enter_1)(R1) args: 8, res: 0, upd: 8;
c2T6: // global
(_c2T1::I64) = call "ccall" arg hints: [PtrHint,
PtrHint] result hints: [PtrHint] newCAF(BaseReg, _rqm::P64);
if (_c2T1::I64 == 0) goto c2T3; else goto c2T2;
c2T3: // global
call (I64[_rqm::P64])() args: 8, res: 0, upd: 8;
c2T2: // global
I64[Sp - 16] = stg_bh_upd_frame_info;
I64[Sp - 8] = _c2T1::I64;
R2 = hey1_r2Gg_bytes;
Sp = Sp - 16;
call GHC.CString.unpackCString#_info(R2) args: 24, res: 0, upd: 24;
}
}
This code is generated for every string literal. Only difference between
top-level closures like this is the argument for the bytes of the string
(hey1_r2Gg_bytes in the code above).
With this patch we introduce a standard thunk in the RTS, called
stg_MK_STRING_info, that does what `unpackCString# x` does, except it
gets the bytes address from the payload. Using this, for the closure
above, we generate this:
Main.hey_closure" {
Main.hey_closure:
const stg_MK_STRING_info;
const 0; // padding for indirectee
const 0; // static link
const 0; // saved info
const hey1_r1Gg_bytes; // the payload
}
This is much smaller in code.
Metric Decrease:
T10421
T11195
T12150
T12425
T16577
T18282
T18698a
T18698b
Co-Authored By: Ben Gamari <ben at well-typed.com>
- - - - -
29 changed files:
- compiler/GHC/Cmm.hs
- compiler/GHC/Cmm/CLabel.hs
- compiler/GHC/Cmm/ContFlowOpt.hs
- compiler/GHC/Cmm/Info/Build.hs
- compiler/GHC/Cmm/Parser.y
- compiler/GHC/Cmm/Pipeline.hs
- compiler/GHC/Core/Opt/Simplify/Utils.hs
- compiler/GHC/Linker/Windows.hs
- compiler/GHC/StgToCmm/Bind.hs
- compiler/GHC/StgToCmm/Heap.hs
- compiler/GHC/StgToCmm/Utils.hs
- compiler/GHC/SysTools/Process.hs
- configure.ac
- docs/users_guide/exts/template_haskell.rst
- docs/users_guide/runghc.rst
- libraries/base/System/CPUTime/Posix/ClockGetTime.hsc
- libraries/base/aclocal.m4
- libraries/base/cbits/sysconf.c
- libraries/base/include/HsBase.h
- m4/fp_check_timer_create.m4
- rts/Prelude.h
- rts/RtsSymbols.c
- rts/RtsUtils.c
- rts/StgStdThunks.cmm
- rts/include/stg/MiscClosures.h
- rts/posix/Clock.h
- rts/posix/ticker/Pthread.c
- rts/posix/ticker/Setitimer.c
- rts/win32/GetTime.c
Changes:
=====================================
compiler/GHC/Cmm.hs
=====================================
@@ -301,6 +301,9 @@ data GenCmmStatics (rawOnly :: Bool) where
-> CmmInfoTable
-> CostCentreStack
-> [CmmLit] -- Payload
+ -> [CmmLit] -- Non-pointers that go to the end of the closure
+ -- This is used by stg_unpack_cstring closures.
+ -- See Note [unpack_cstring closures] in StgStdThunks.cmm.
-> GenCmmStatics 'False
-- | Static data, after SRTs are generated
@@ -432,8 +435,8 @@ pprInfoTable platform (CmmInfoTable { cit_lbl = lbl, cit_rep = rep
--
pprStatics :: Platform -> GenCmmStatics a -> SDoc
-pprStatics platform (CmmStatics lbl itbl ccs payload) =
- pdoc platform lbl <> colon <+> pdoc platform itbl <+> ppr ccs <+> pdoc platform payload
+pprStatics platform (CmmStatics lbl itbl ccs payload extras) =
+ pdoc platform lbl <> colon <+> pdoc platform itbl <+> ppr ccs <+> pdoc platform payload <+> ppr extras
pprStatics platform (CmmStaticsRaw lbl ds) = vcat ((pdoc platform lbl <> colon) : map (pprStatic platform) ds)
pprStatic :: Platform -> CmmStatic -> SDoc
=====================================
compiler/GHC/Cmm/CLabel.hs
=====================================
@@ -72,6 +72,8 @@ module GHC.Cmm.CLabel (
mkCAFBlackHoleInfoTableLabel,
mkRtsPrimOpLabel,
mkRtsSlowFastTickyCtrLabel,
+ mkRtsUnpackCStringLabel,
+ mkRtsUnpackCStringUtf8Label,
mkSelectorInfoLabel,
mkSelectorEntryLabel,
@@ -562,6 +564,8 @@ data RtsLabelInfo
| RtsApInfoTable Bool{-updatable-} Int{-arity-} -- ^ AP thunks
| RtsApEntry Bool{-updatable-} Int{-arity-}
+ | RtsUnpackCStringInfoTable
+ | RtsUnpackCStringUtf8InfoTable
| RtsPrimOp PrimOp
| RtsApFast NonDetFastString -- ^ _fast versions of generic apply
| RtsSlowFastTickyCtr String
@@ -734,7 +738,6 @@ mkApEntryLabel platform upd arity =
assert (arity > 0 && arity <= pc_MAX_SPEC_AP_SIZE (platformConstants platform)) $
RtsLabel (RtsApEntry upd arity)
-
-- A call to some primitive hand written Cmm code
mkPrimCallLabel :: PrimCall -> CLabel
mkPrimCallLabel (PrimCall str pkg)
@@ -852,6 +855,11 @@ mkRtsApFastLabel str = RtsLabel (RtsApFast (NonDetFastString str))
mkRtsSlowFastTickyCtrLabel :: String -> CLabel
mkRtsSlowFastTickyCtrLabel pat = RtsLabel (RtsSlowFastTickyCtr pat)
+-- | A standard string unpacking thunk. See Note [unpack_cstring closures] in
+-- StgStdThunks.cmm.
+mkRtsUnpackCStringLabel, mkRtsUnpackCStringUtf8Label :: CLabel
+mkRtsUnpackCStringLabel = RtsLabel RtsUnpackCStringInfoTable
+mkRtsUnpackCStringUtf8Label = RtsLabel RtsUnpackCStringUtf8InfoTable
-- Constructing Code Coverage Labels
mkHpcTicksLabel :: Module -> CLabel
@@ -958,6 +966,9 @@ hasIdLabelInfo _ = Nothing
hasCAF :: CLabel -> Bool
hasCAF (IdLabel _ _ (IdTickyInfo TickyRednCounts)) = False -- See Note [ticky for LNE]
hasCAF (IdLabel _ MayHaveCafRefs _) = True
+hasCAF (RtsLabel RtsUnpackCStringInfoTable) = True
+hasCAF (RtsLabel RtsUnpackCStringUtf8InfoTable) = True
+ -- The info table stg_MK_STRING_info is for thunks
hasCAF _ = False
-- Note [ticky for LNE]
@@ -1195,6 +1206,9 @@ labelType (CmmLabel _ _ _ CmmRet) = CodeLabel
labelType (RtsLabel (RtsSelectorInfoTable _ _)) = DataLabel
labelType (RtsLabel (RtsApInfoTable _ _)) = DataLabel
labelType (RtsLabel (RtsApFast _)) = CodeLabel
+labelType (RtsLabel RtsUnpackCStringInfoTable) = CodeLabel
+labelType (RtsLabel RtsUnpackCStringUtf8InfoTable)
+ = CodeLabel
labelType (RtsLabel _) = DataLabel
labelType (LocalBlockLabel _) = CodeLabel
labelType (SRTLabel _) = DataLabel
@@ -1525,6 +1539,11 @@ pprCLabel !platform !sty lbl = -- see Note [Bangs in CLabel]
RtsLabel (RtsSlowFastTickyCtr pat)
-> maybe_underscore $ text "SLOW_CALL_fast_" <> text pat <> text "_ctr"
+ RtsLabel RtsUnpackCStringInfoTable
+ -> maybe_underscore $ text "stg_unpack_cstring_info"
+ RtsLabel RtsUnpackCStringUtf8InfoTable
+ -> maybe_underscore $ text "stg_unpack_cstring_utf8_info"
+
LargeBitmapLabel u
-> maybe_underscore $ tempLabelPrefixOrUnderscore
<> char 'b' <> pprUniqueAlways u <> pp_cSEP <> text "btm"
=====================================
compiler/GHC/Cmm/ContFlowOpt.hs
=====================================
@@ -1,6 +1,5 @@
{-# LANGUAGE GADTs #-}
{-# LANGUAGE BangPatterns #-}
-{-# OPTIONS_GHC -fno-warn-incomplete-patterns #-}
{-# OPTIONS_GHC -Wno-incomplete-record-updates #-}
module GHC.Cmm.ContFlowOpt
( cmmCfgOpts
@@ -21,8 +20,10 @@ import GHC.Cmm
import GHC.Cmm.Utils
import GHC.Cmm.Switch (mapSwitchTargets, switchTargetsToList)
import GHC.Data.Maybe
-import GHC.Utils.Panic
+import GHC.Platform
import GHC.Utils.Misc
+import GHC.Utils.Outputable
+import GHC.Utils.Panic
import Control.Monad
@@ -422,9 +423,9 @@ predMap blocks = foldr add_preds mapEmpty blocks
add_preds block env = foldr add env (successors block)
where add lbl env = mapInsertWith (+) lbl 1 env
--- Removing unreachable blocks
-removeUnreachableBlocksProc :: CmmDecl -> CmmDecl
-removeUnreachableBlocksProc proc@(CmmProc info lbl live g)
+-- Remove unreachable blocks from procs
+removeUnreachableBlocksProc :: Platform -> CmmDecl -> CmmDecl
+removeUnreachableBlocksProc _ proc@(CmmProc info lbl live g)
| used_blocks `lengthLessThan` mapSize (toBlockMap g)
= CmmProc info' lbl live g'
| otherwise
@@ -446,3 +447,5 @@ removeUnreachableBlocksProc proc@(CmmProc info lbl live g)
used_lbls :: LabelSet
used_lbls = setFromList $ map entryLabel used_blocks
+removeUnreachableBlocksProc platform data'@(CmmData _ _) =
+ pprPanic "removeUnreachableBlocksProc: passed data declaration instead of procedure" (pdoc platform data')
=====================================
compiler/GHC/Cmm/Info/Build.hs
=====================================
@@ -576,7 +576,7 @@ cafAnalData
-> CAFSet
cafAnalData platform st = case st of
CmmStaticsRaw _lbl _data -> Set.empty
- CmmStatics _lbl _itbl _ccs payload ->
+ CmmStatics _lbl _itbl _ccs payload _extras ->
foldl' analyzeStatic Set.empty payload
where
analyzeStatic s lit =
@@ -741,7 +741,9 @@ getBlockLabels = mapMaybe getBlockLabel
getLabelledBlocks :: Platform -> CmmDecl -> [(SomeLabel, CAFfyLabel)]
getLabelledBlocks platform decl = case decl of
CmmData _ (CmmStaticsRaw _ _) -> []
- CmmData _ (CmmStatics lbl _ _ _) -> [ (DeclLabel lbl, mkCAFfyLabel platform lbl) ]
+ CmmData _ (CmmStatics lbl info _ _ _) -> [ (DeclLabel lbl, mkCAFfyLabel platform lbl)
+ | not (isThunkRep (cit_rep info))
+ ]
CmmProc top_info _ _ _ -> [ (BlockLabel blockId, caf_lbl)
| (blockId, info) <- mapToList (info_tbls top_info)
, let rep = cit_rep info
@@ -786,28 +788,48 @@ depAnalSRTs platform cafEnv cafEnv_static decls =
graph :: [SCC (SomeLabel, CAFfyLabel, Set CAFfyLabel)]
graph = stronglyConnCompFromEdgedVerticesOrd nodes
--- | Get @(Label, CAFfyLabel, Set CAFfyLabel)@ for each CAF block.
--- The @Set CafLabel@ represents the set of CAFfy things which this CAF's code
+-- | Get @(Maybe Label, CAFfyLabel, Set CAFfyLabel)@ for each CAF block.
+-- The @Set CAFfyLabel@ represents the set of CAFfy things which this CAF's code
-- depends upon.
--
--- CAFs are treated differently from other labelled blocks:
+-- - The 'Label' represents the entry code of the closure. This may be
+-- 'Nothing' if it is a standard closure type (e.g. @stg_unpack_cstring@; see
+-- Note [unpack_cstring closures] in StgStdThunks.cmm).
+-- - The 'CAFLabel' is the label of the CAF closure.
+-- - The @Set CAFLabel@ is the set of CAFfy closures which should be included
+-- in the closure's SRT.
+--
+-- Note that CAFs are treated differently from other labelled blocks:
--
-- - we never shortcut a reference to a CAF to the contents of its
-- SRT, since the point of SRTs is to keep CAFs alive.
--
-- - CAFs therefore don't take part in the dependency analysis in depAnalSRTs.
-- instead we generate their SRTs after everything else.
---
-getCAFs :: Platform -> CAFEnv -> [CmmDecl] -> [(Label, CAFfyLabel, Set CAFfyLabel)]
-getCAFs platform cafEnv decls =
- [ (g_entry g, mkCAFfyLabel platform topLbl, cafs)
- | CmmProc top_info topLbl _ g <- decls
- , Just info <- [mapLookup (g_entry g) (info_tbls top_info)]
- , let rep = cit_rep info
- , isStaticRep rep && isThunkRep rep
- , Just cafs <- [mapLookup (g_entry g) cafEnv]
- ]
+getCAFs :: Platform -> CAFEnv -> [CmmDecl] -> [(Maybe Label, CAFfyLabel, Set CAFfyLabel)]
+getCAFs platform cafEnv = mapMaybe getCAFLabel
+ where
+ getCAFLabel :: CmmDecl -> Maybe (Maybe Label, CAFfyLabel, Set CAFfyLabel)
+
+ getCAFLabel (CmmProc top_info top_lbl _ g)
+ | Just info <- mapLookup (g_entry g) (info_tbls top_info)
+ , let rep = cit_rep info
+ , isStaticRep rep && isThunkRep rep
+ , Just cafs <- mapLookup (g_entry g) cafEnv
+ = Just (Just (g_entry g), mkCAFfyLabel platform top_lbl, cafs)
+
+ | otherwise
+ = Nothing
+
+ getCAFLabel (CmmData _ (CmmStatics top_lbl info _ccs _payload _extras))
+ | isThunkRep (cit_rep info)
+ = Just (Nothing, mkCAFfyLabel platform top_lbl, Set.empty)
+
+ | otherwise
+ = Nothing
+ getCAFLabel (CmmData _ (CmmStaticsRaw _lbl _payload))
+ = Nothing
-- | Get the list of blocks that correspond to the entry points for
-- @FUN_STATIC@ closures. These are the blocks for which if we have an
@@ -882,7 +904,7 @@ doSRTs cfg moduleSRTInfo procs data_ = do
pprPanic "doSRTs" (text "Proc in static data list:" <+> pdoc platform decl)
CmmData _ static ->
case static of
- CmmStatics lbl _ _ _ -> (lbl, set)
+ CmmStatics lbl _ _ _ _ -> (lbl, set)
CmmStaticsRaw lbl _ -> (lbl, set)
(proc_envs, procss) = unzip procs
@@ -902,7 +924,7 @@ doSRTs cfg moduleSRTInfo procs data_ = do
sccs :: [SCC (SomeLabel, CAFfyLabel, Set CAFfyLabel)]
sccs = {-# SCC depAnalSRTs #-} depAnalSRTs platform cafEnv static_data_env decls
- cafsWithSRTs :: [(Label, CAFfyLabel, Set CAFfyLabel)]
+ cafsWithSRTs :: [(Maybe Label, CAFfyLabel, Set CAFfyLabel)]
cafsWithSRTs = getCAFs platform cafEnv decls
srtTraceM "doSRTs" (text "data:" <+> pdoc platform data_ $$
@@ -925,7 +947,7 @@ doSRTs cfg moduleSRTInfo procs data_ = do
flip runStateT moduleSRTInfo $ do
nonCAFs <- mapM (doSCC cfg staticFuns static_data_env) sccs
cAFs <- forM cafsWithSRTs $ \(l, cafLbl, cafs) ->
- oneSRT cfg staticFuns [BlockLabel l] [cafLbl]
+ oneSRT cfg staticFuns (map BlockLabel (maybeToList l)) [cafLbl]
True{-is a CAF-} cafs static_data_env
return (nonCAFs ++ cAFs)
@@ -1248,6 +1270,7 @@ buildSRT profile refs = do
[] -- no padding
[mkIntCLit platform 0] -- link field
[] -- no saved info
+ [] -- no extras
return (mkDataLits (Section Data lbl) lbl fields, SRTEntry lbl)
-- | Update info tables with references to their SRTs. Also generate
@@ -1263,10 +1286,10 @@ updInfoSRTs
updInfoSRTs _ _ _ _ (CmmData s (CmmStaticsRaw lbl statics))
= [CmmData s (CmmStaticsRaw lbl statics)]
-updInfoSRTs profile _ _ caffy (CmmData s (CmmStatics lbl itbl ccs payload))
+updInfoSRTs profile _ _ caffy (CmmData s (CmmStatics lbl itbl ccs payload extras))
= [CmmData s (CmmStaticsRaw lbl (map CmmStaticLit field_lits))]
where
- field_lits = mkStaticClosureFields profile itbl ccs caffy payload
+ field_lits = mkStaticClosureFields profile itbl ccs caffy payload extras
updInfoSRTs profile srt_env funSRTEnv caffy (CmmProc top_info top_l live g)
| Just (_,closure) <- maybeStaticClosure = [ proc, closure ]
@@ -1296,7 +1319,7 @@ updInfoSRTs profile srt_env funSRTEnv caffy (CmmProc top_info top_l live g)
Just srtEntries -> srtTrace "maybeStaticFun" (pdoc (profilePlatform profile) res)
(info_tbl { cit_rep = new_rep }, res)
where res = [ CmmLabel lbl | SRTEntry lbl <- srtEntries ]
- fields = mkStaticClosureFields profile info_tbl ccs caffy srtEntries
+ fields = mkStaticClosureFields profile info_tbl ccs caffy srtEntries []
new_rep = case cit_rep of
HeapRep sta ptrs nptrs ty ->
HeapRep sta (ptrs + length srtEntries) nptrs ty
=====================================
compiler/GHC/Cmm/Parser.y
=====================================
@@ -435,7 +435,7 @@ static :: { CmmParse [CmmStatic] }
mkStaticClosure profile (mkForeignLabel $3 Nothing ForeignLabelInExternalPackage IsData)
-- mkForeignLabel because these are only used
-- for CHARLIKE and INTLIKE closures in the RTS.
- dontCareCCS (map getLit lits) [] [] [] } }
+ dontCareCCS (map getLit lits) [] [] [] [] } }
-- arrays of closures required for the CHARLIKE & INTLIKE arrays
lits :: { [CmmParse CmmExpr] }
@@ -1248,7 +1248,7 @@ profilingInfo profile desc_str ty_str
staticClosure :: UnitId -> FastString -> FastString -> [CmmLit] -> CmmParse ()
staticClosure pkg cl_label info payload
= do profile <- getProfile
- let lits = mkStaticClosure profile (mkCmmInfoLabel pkg info) dontCareCCS payload [] [] []
+ let lits = mkStaticClosure profile (mkCmmInfoLabel pkg info) dontCareCCS payload [] [] [] []
code $ emitDataLits (mkCmmDataLabel pkg (NeedExternDecl True) cl_label) lits
foreignCall
=====================================
compiler/GHC/Cmm/Pipeline.hs
=====================================
@@ -156,7 +156,7 @@ cpsTop logger platform cfg proc =
return $ if cmmOptControlFlow cfg
then map (cmmCfgOptsProc splitting_proc_points) g
else g
- g <- return (map removeUnreachableBlocksProc g)
+ g <- return $ map (removeUnreachableBlocksProc platform) g
-- See Note [unreachable blocks]
dumps Opt_D_dump_cmm_cfg "Post control-flow optimisations" g
=====================================
compiler/GHC/Core/Opt/Simplify/Utils.hs
=====================================
@@ -42,7 +42,7 @@ module GHC.Core.Opt.Simplify.Utils (
isExitJoinId
) where
-import GHC.Prelude
+import GHC.Prelude hiding (head, init, last, tail)
import GHC.Core
import GHC.Types.Literal ( isLitRubbish )
@@ -84,6 +84,7 @@ import GHC.Utils.Trace
import Control.Monad ( when )
import Data.List ( sortBy )
+import qualified Data.List as Partial ( head )
{- *********************************************************************
* *
@@ -450,7 +451,7 @@ mkRhsStop ty is_rec bndr_dmd = Stop ty (RhsCtxt is_rec) (subDemandIfEvaluated bn
mkLazyArgStop :: OutType -> ArgInfo -> SimplCont
mkLazyArgStop ty fun_info = Stop ty (lazyArgContext fun_info) arg_sd
where
- arg_sd = subDemandIfEvaluated (head (ai_dmds fun_info))
+ arg_sd = subDemandIfEvaluated (Partial.head (ai_dmds fun_info))
-------------------
contIsRhs :: SimplCont -> Maybe RecFlag
@@ -592,7 +593,7 @@ contEvalContext k = case k of
-- then it *should* be "C(1,C(S,C(1,L))", so perhaps correct after all.
-- But for now we just panic:
ApplyToVal{} -> pprPanic "contEvalContext" (ppr k)
- StrictArg{sc_fun=fun_info} -> subDemandIfEvaluated (head (ai_dmds fun_info))
+ StrictArg{sc_fun=fun_info} -> subDemandIfEvaluated (Partial.head (ai_dmds fun_info))
StrictBind{sc_bndr=bndr} -> subDemandIfEvaluated (idDemandInfo bndr)
Select{} -> topSubDmd
-- Perhaps reconstruct the demand on the scrutinee by looking at field
@@ -1665,7 +1666,7 @@ rebuildLam :: SimplEnv
rebuildLam _env [] body _cont
= return body
-rebuildLam env bndrs body cont
+rebuildLam env bndrs@(bndr:_) body cont
= {-# SCC "rebuildLam" #-} try_eta bndrs body
where
rec_ids = seRecIds env
@@ -1682,7 +1683,7 @@ rebuildLam env bndrs body cont
| -- Try eta reduction
seDoEtaReduction env
, Just etad_lam <- tryEtaReduce rec_ids bndrs body eval_sd
- = do { tick (EtaReduction (head bndrs))
+ = do { tick (EtaReduction bndr)
; return etad_lam }
| -- Try eta expansion
@@ -1690,7 +1691,7 @@ rebuildLam env bndrs body cont
, seEtaExpand env
, any isRuntimeVar bndrs -- Only when there is at least one value lambda already
, Just body_arity <- exprEtaExpandArity (seArityOpts env) body
- = do { tick (EtaExpansion (head bndrs))
+ = do { tick (EtaExpansion bndr)
; let body' = etaExpandAT in_scope body_arity body
; traceSmpl "eta expand" (vcat [text "before" <+> ppr body
, text "after" <+> ppr body'])
@@ -2391,12 +2392,12 @@ mkCase mode scrut bndr alts_ty alts = mkCase1 mode scrut bndr alts_ty alts
-- 2. Eliminate Identity Case
--------------------------------------------------
-mkCase1 _mode scrut case_bndr _ alts@(Alt _ _ rhs1 : _) -- Identity case
+mkCase1 _mode scrut case_bndr _ alts@(Alt _ _ rhs1 : alts') -- Identity case
| all identity_alt alts
= do { tick (CaseIdentity case_bndr)
; return (mkTicks ticks $ re_cast scrut rhs1) }
where
- ticks = concatMap (\(Alt _ _ rhs) -> stripTicksT tickishFloatable rhs) (tail alts)
+ ticks = concatMap (\(Alt _ _ rhs) -> stripTicksT tickishFloatable rhs) alts'
identity_alt (Alt con args rhs) = check_eq rhs con args
check_eq (Cast rhs co) con args -- See Note [RHS casts]
=====================================
compiler/GHC/Linker/Windows.hs
=====================================
@@ -50,10 +50,8 @@ maybeCreateManifest logger tmpfs dflags exe_filename = do
newTempName logger tmpfs (tmpDir dflags) TFL_GhcSession (objectSuf dflags)
writeFile rc_filename $
- "1 24 MOVEABLE PURE " ++ show manifest_filename ++ "\n"
+ "1 24 MOVEABLE PURE \"" ++ manifest_filename ++ "\"\n"
-- magic numbers :-)
- -- show is a bit hackish above, but we need to escape the
- -- backslashes in the path.
runWindres logger dflags $ map GHC.SysTools.Option $
["--input="++rc_filename,
=====================================
compiler/GHC/StgToCmm/Bind.hs
=====================================
@@ -25,6 +25,8 @@ import GHC.Stg.Syntax
import GHC.Platform
import GHC.Platform.Profile
+import GHC.Builtin.Names (unpackCStringName, unpackCStringUtf8Name)
+
import GHC.StgToCmm.Config
import GHC.StgToCmm.Expr
import GHC.StgToCmm.Monad
@@ -87,6 +89,9 @@ cgTopRhsClosure platform rec id ccs upd_flag args body =
lf_info = mkClosureLFInfo platform id TopLevel [] upd_flag args
in (cg_id_info, gen_code lf_info closure_label)
where
+
+ gen_code :: LambdaFormInfo -> CLabel -> FCode ()
+
-- special case for a indirection (f = g). We create an IND_STATIC
-- closure pointing directly to the indirectee. This is exactly
-- what the CAF will eventually evaluate to anyway, we're just
@@ -101,11 +106,44 @@ cgTopRhsClosure platform rec id ccs upd_flag args body =
-- concurrent/should_run/4030 fails, for instance.
--
gen_code _ closure_label
- | StgApp f [] <- body, null args, isNonRec rec
+ | StgApp f [] <- body
+ , null args
+ , isNonRec rec
= do
cg_info <- getCgIdInfo f
emitDataCon closure_label indStaticInfoTable ccs [unLit (idInfoToAmode cg_info)]
+ -- Emit standard stg_unpack_cstring closures for top-level unpackCString# thunks.
+ --
+ -- Note that we do not do this for thunks enclosured in code ticks (e.g. hpc
+ -- ticks) since we want to ensure that these ticks are not lost (e.g.
+ -- resulting in Strings being reported by hpc as uncovered). However, we
+ -- don't worry about standard profiling ticks since unpackCString tends not
+ -- be terribly interesting in profiles. See Note [unpack_cstring closures] in
+ -- StgStdThunks.cmm.
+ gen_code _ closure_label
+ | null args
+ , StgApp f [arg] <- stripStgTicksTopE (not . tickishIsCode) body
+ , Just unpack <- is_string_unpack_op f
+ = do arg' <- getArgAmode (NonVoid arg)
+ case arg' of
+ CmmLit lit -> do
+ let info = CmmInfoTable
+ { cit_lbl = unpack
+ , cit_rep = HeapRep True 0 1 Thunk
+ , cit_prof = NoProfilingInfo
+ , cit_srt = Nothing
+ , cit_clo = Nothing
+ }
+ emitDecl $ CmmData (Section Data closure_label) $
+ CmmStatics closure_label info ccs [] [lit]
+ _ -> panic "cgTopRhsClosure.gen_code"
+ where
+ is_string_unpack_op f
+ | idName f == unpackCStringName = Just mkRtsUnpackCStringLabel
+ | idName f == unpackCStringUtf8Name = Just mkRtsUnpackCStringUtf8Label
+ | otherwise = Nothing
+
gen_code lf_info _closure_label
= do { profile <- getProfile
; let name = idName id
=====================================
compiler/GHC/StgToCmm/Heap.hs
=====================================
@@ -161,19 +161,20 @@ hpStore base vals = do
-- Layout of static closures
-----------------------------------------------------------
--- Make a static closure, adding on any extra padding needed for CAFs,
--- and adding a static link field if necessary.
-
+-- | Make a static closure, adding on any extra padding needed for CAFs, and
+-- adding a static link field if necessary.
mkStaticClosureFields
:: Profile
-> CmmInfoTable
-> CostCentreStack
-> CafInfo
- -> [CmmLit] -- Payload
+ -> [CmmLit] -- ^ Payload
+ -> [CmmLit] -- ^ Extra non-pointers that go to the end of the closure.
+ -- See Note [unpack_cstring closures] in StgStdThunks.cmm.
-> [CmmLit] -- The full closure
-mkStaticClosureFields profile info_tbl ccs caf_refs payload
+mkStaticClosureFields profile info_tbl ccs caf_refs payload extras
= mkStaticClosure profile info_lbl ccs payload padding
- static_link_field saved_info_field
+ static_link_field saved_info_field extras
where
platform = profilePlatform profile
info_lbl = cit_lbl info_tbl
@@ -218,14 +219,15 @@ mkStaticClosureFields profile info_tbl ccs caf_refs payload
-- in rts/sm/Storage.h
mkStaticClosure :: Profile -> CLabel -> CostCentreStack -> [CmmLit]
- -> [CmmLit] -> [CmmLit] -> [CmmLit] -> [CmmLit]
-mkStaticClosure profile info_lbl ccs payload padding static_link_field saved_info_field
+ -> [CmmLit] -> [CmmLit] -> [CmmLit] -> [CmmLit] -> [CmmLit]
+mkStaticClosure profile info_lbl ccs payload padding static_link_field saved_info_field extras
= [CmmLabel info_lbl]
++ staticProfHdr profile ccs
++ payload
++ padding
++ static_link_field
++ saved_info_field
+ ++ extras
-----------------------------------------------------------
-- Heap overflow checking
=====================================
compiler/GHC/StgToCmm/Utils.hs
=====================================
@@ -266,7 +266,7 @@ emitRODataLits lbl lits = emitDecl (mkRODataLits lbl lits)
emitDataCon :: CLabel -> CmmInfoTable -> CostCentreStack -> [CmmLit] -> FCode ()
emitDataCon lbl itbl ccs payload =
- emitDecl (CmmData (Section Data lbl) (CmmStatics lbl itbl ccs payload))
+ emitDecl (CmmData (Section Data lbl) (CmmStatics lbl itbl ccs payload []))
-------------------------------------------------------------------------
--
=====================================
compiler/GHC/SysTools/Process.hs
=====================================
@@ -170,11 +170,7 @@ runSomethingResponseFile logger tmpfs dflags filter_fn phase_name pgm args mb_en
getResponseFile args = do
fp <- newTempName logger tmpfs (tmpDir dflags) TFL_CurrentModule "rsp"
withFile fp WriteMode $ \h -> do
-#if defined(mingw32_HOST_OS)
- hSetEncoding h latin1
-#else
hSetEncoding h utf8
-#endif
hPutStr h $ unlines $ map escape args
return fp
=====================================
configure.ac
=====================================
@@ -845,7 +845,7 @@ dnl off_t, because it will affect the result of that test.
AC_SYS_LARGEFILE
dnl ** check for specific header (.h) files that we are interested in
-AC_CHECK_HEADERS([ctype.h dirent.h dlfcn.h errno.h fcntl.h grp.h limits.h locale.h nlist.h pthread.h pwd.h signal.h sys/param.h sys/mman.h sys/resource.h sys/select.h sys/time.h sys/timeb.h sys/timerfd.h sys/timers.h sys/times.h sys/utsname.h sys/wait.h termios.h time.h utime.h windows.h winsock.h sched.h])
+AC_CHECK_HEADERS([ctype.h dirent.h dlfcn.h errno.h fcntl.h grp.h limits.h locale.h nlist.h pthread.h pwd.h signal.h sys/param.h sys/mman.h sys/resource.h sys/select.h sys/time.h sys/timeb.h sys/timerfd.h sys/timers.h sys/times.h sys/utsname.h sys/wait.h termios.h utime.h windows.h winsock.h sched.h])
dnl sys/cpuset.h needs sys/param.h to be included first on FreeBSD 9.1; #7708
AC_CHECK_HEADERS([sys/cpuset.h], [], [],
@@ -857,9 +857,6 @@ AC_CHECK_HEADERS([sys/cpuset.h], [], [],
dnl ** check whether a declaration for `environ` is provided by libc.
FP_CHECK_ENVIRON
-dnl ** check if it is safe to include both <time.h> and <sys/time.h>
-AC_HEADER_TIME
-
dnl ** do we have long longs?
AC_CHECK_TYPES([long long])
=====================================
docs/users_guide/exts/template_haskell.rst
=====================================
@@ -159,13 +159,14 @@ The :extension:`TemplateHaskellQuotes` extension is considered safe under
general ``'``\ ⟨thing⟩ interprets ⟨thing⟩ in an expression
context.
- A name whose second character is a single quote (sadly) cannot be
- quoted in this way, because it will be parsed instead as a quoted
- character. For example, if the function is called ``f'7`` (which
- is a legal Haskell identifier), an attempt to quote it as ``'f'7``
- would be parsed as the character literal ``'f'`` followed by the
- numeric literal ``7``. There is no current escape mechanism in
- this (unusual) situation.
+ A name whose second character is a single quote cannot be quoted in
+ exactly this way, because it will be parsed instead as a quoted
+ character. For example, if the function is called ``f'7`` (which is a
+ legal Haskell identifier), an attempt to quote it as ``'f'7`` would be
+ parsed as the character literal ``'f'`` followed by the numeric literal
+ ``7``. As for promoted constructors (:ref:`promotion-syntax`), the
+ workaround is to add a space between the quote and the name. The name of
+ the function ``f'7`` is thus written ``' f'7``.
- ``''T`` has type ``Name``, and names the type constructor ``T``.
That is, ``''``\ ⟨thing⟩ interprets ⟨thing⟩ in a type context.
=====================================
docs/users_guide/runghc.rst
=====================================
@@ -7,7 +7,7 @@ Using runghc
single: runghc
single: runhaskell
-``runghc`` (or ``runhaskell``, which is its equivalent) allows you to run Haskell programs using the interpreter, instead of having to
+``runghc``/``runhaskell`` allows you to run Haskell programs using the interpreter, instead of having to
compile them first.
.. _runghc-introduction:
=====================================
libraries/base/System/CPUTime/Posix/ClockGetTime.hsc
=====================================
@@ -2,10 +2,8 @@
#include "HsFFI.h"
#include "HsBaseConfig.h"
-#if HAVE_TIME_H
#include <unistd.h>
#include <time.h>
-#endif
module System.CPUTime.Posix.ClockGetTime
( getCPUTime
=====================================
libraries/base/aclocal.m4
=====================================
@@ -78,9 +78,7 @@ AC_DEFUN([FPTOOLS_HTYPE_INCLUDES],
# include <signal.h>
#endif
-#if HAVE_TIME_H
-# include <time.h>
-#endif
+#include <time.h>
#if HAVE_TERMIOS_H
# include <termios.h>
=====================================
libraries/base/cbits/sysconf.c
=====================================
@@ -6,9 +6,7 @@
#endif
/* for CLK_TCK */
-#if HAVE_TIME_H
#include <time.h>
-#endif
long clk_tck(void) {
#if defined(CLK_TCK)
=====================================
libraries/base/include/HsBase.h
=====================================
@@ -74,9 +74,7 @@
# include <sys/timers.h>
# endif
#endif
-#if HAVE_TIME_H
#include <time.h>
-#endif
#if HAVE_SYS_TIMEB_H && !defined(__FreeBSD__)
#include <sys/timeb.h>
#endif
=====================================
m4/fp_check_timer_create.m4
=====================================
@@ -20,9 +20,7 @@ then
#if defined(HAVE_STDLIB_H)
#include <stdlib.h>
#endif
-#if defined(HAVE_TIME_H)
#include <time.h>
-#endif
#if defined(HAVE_SIGNAL_H)
#include <signal.h>
#endif
=====================================
rts/Prelude.h
=====================================
@@ -33,6 +33,7 @@ PRELUDE_CLOSURE(ghczmprim_GHCziTupleziPrim_Z0T_closure);
PRELUDE_CLOSURE(ghczmprim_GHCziTypes_True_closure);
PRELUDE_CLOSURE(ghczmprim_GHCziTypes_False_closure);
PRELUDE_CLOSURE(base_GHCziPack_unpackCString_closure);
+PRELUDE_CLOSURE(base_GHCziPack_unpackCStringUtf8_closure);
PRELUDE_CLOSURE(base_GHCziWeak_runFinalizzerBatch_closure);
PRELUDE_CLOSURE(base_GHCziWeakziFinalizze_runFinalizzerBatch_closure);
@@ -70,6 +71,7 @@ PRELUDE_CLOSURE(base_GHCziEventziWindows_processRemoteCompletion_closure);
PRELUDE_CLOSURE(base_GHCziTopHandler_flushStdHandles_closure);
PRELUDE_CLOSURE(base_GHCziTopHandler_runMainIO_closure);
+PRELUDE_INFO(ghczmprim_GHCziCString_unpackCStringzh_info);
PRELUDE_INFO(ghczmprim_GHCziTypes_Czh_con_info);
PRELUDE_INFO(ghczmprim_GHCziTypes_Izh_con_info);
PRELUDE_INFO(ghczmprim_GHCziTypes_Fzh_con_info);
=====================================
rts/RtsSymbols.c
=====================================
@@ -9,6 +9,7 @@
#include "ghcplatform.h"
#include "Rts.h"
#include "RtsSymbols.h"
+
#include "TopHandler.h"
#include "HsFFI.h"
#include "CloneStack.h"
@@ -713,7 +714,7 @@ extern char **environ;
SymI_HasProto(defaultRtsConfig) \
SymI_HasProto(initLinker) \
SymI_HasProto(initLinker_) \
- SymI_HasDataProto(stg_unpackClosurezh) \
+ SymI_HasDataProto(stg_unpackClosurezh) \
SymI_HasDataProto(stg_closureSizzezh) \
SymI_HasDataProto(stg_whereFromzh) \
SymI_HasDataProto(stg_getApStackValzh) \
@@ -976,6 +977,8 @@ extern char **environ;
SymI_HasDataProto(stg_sel_13_noupd_info) \
SymI_HasDataProto(stg_sel_14_noupd_info) \
SymI_HasDataProto(stg_sel_15_noupd_info) \
+ SymI_HasDataProto(stg_unpack_cstring_info) \
+ SymI_HasDataProto(stg_unpack_cstring_utf8_info) \
SymI_HasDataProto(stg_upd_frame_info) \
SymI_HasDataProto(stg_bh_upd_frame_info) \
SymI_HasProto(suspendThread) \
=====================================
rts/RtsUtils.c
=====================================
@@ -15,9 +15,7 @@
#include "Schedule.h"
#include "RtsFlags.h"
-#if defined(HAVE_TIME_H)
#include <time.h>
-#endif
/* HACK: On Mac OS X 10.4 (at least), time.h doesn't declare ctime_r with
* _POSIX_C_SOURCE. If this is the case, we declare it ourselves.
=====================================
rts/StgStdThunks.cmm
=====================================
@@ -13,6 +13,9 @@
#include "Cmm.h"
#include "Updates.h"
+import ghczmprim_GHCziCString_unpackCStringzh_info;
+import ghczmprim_GHCziCString_unpackCStringUtf8zh_info;
+
/* -----------------------------------------------------------------------------
The code for a thunk that simply extracts a field from a
single-constructor datatype depends only on the offset of the field
@@ -286,3 +289,100 @@ INFO_TABLE(stg_ap_7_upd,7,0,THUNK,"stg_ap_7_upd_info","stg_ap_7_upd_info")
StgThunk_payload(node,6));
}
}
+
+/* -----------------------------------------------------------------------------
+ Making strings
+ -------------------------------------------------------------------------- */
+
+/*
+ * Note [unpack_cstring closures]
+ * ~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~
+ * Strings are extremely common. In Core they will typically manifest as the
+ * a pair of top-level bindings:
+ *
+ * s :: String
+ * s = unpackCString# s#
+ *
+ * s# :: Addr#
+ * s# = "hello world"#
+ *
+ * It turns out that `s` is a non-trivial amount of code which is duplicated
+ * for every `String` literal. To avoid this duplicate, we have a standard
+ * string-unpacking closure, unpack_cstring. Note that currently we only do
+ * this for ASCII strings; strings mentioning non-ASCII characters are
+ * represented by CAF applications of unpackCStringUtf8# as before.
+ *
+ * unpack_cstring closures are similar to standard THUNK_STATIC closures but
+ * with a non-GC pointer to a C-string at the end (the "extra" pointer).
+ * We must place this extra pointer at the end of the closure to ensure that
+ * it has a similar layout to a normal THUNK_STATIC closure, which has no space
+ * for free variables (since these would be contained in the thunk's code and SRT).
+ *
+ * When it is evaluated, an stg_unpack_cstring closure is updated to be an
+ * indirection to the resulting [Char], just as a normal unpackCString# thunk
+ * would be.
+ *
+ * Closure layout:
+ *
+ * ┌───────────────────┐ ┌──► ┌──────────────────────────┐
+ * │ stg_unpack_cstring│ │ │ "hello world ..." │
+ * ├───────────────────┤ │ └──────────────────────────┘
+ * │ indirectee │ │
+ * ├───────────────────┤ │
+ * │ static_link │ │
+ * ├───────────────────┤ │
+ * │ saved_info │ │
+ * ├───────────────────┤ │
+ * │ the_string ─┼───────┘
+ * └───────────────────┘
+ *
+ */
+
+stg_do_unpack_cstring(P_ node, P_ newCAF_ret) {
+ STK_CHK_PP(WDS(SIZEOF_StgUpdateFrame), stg_do_unpack_cstring, node, newCAF_ret);
+ W_ str;
+ str = StgThunk_payload(node, 2);
+ push (UPDATE_FRAME_FIELDS(,,stg_bh_upd_frame_info, CCCS, 0, newCAF_ret)) {
+ jump %ENTRY_CODE(ghczmprim_GHCziCString_unpackCStringzh_info)(node, str);
+ }
+}
+
+INFO_TABLE(stg_unpack_cstring, 0, 0, THUNK_STATIC, "stg_unpack_cstring", "stg_unpack_cstring")
+ (P_ node)
+{
+ W_ newCAF_ret;
+ (newCAF_ret) = ccall newCAF(BaseReg "ptr", node "ptr");
+
+ if (newCAF_ret == 0) {
+ // We raced with another thread to evaluate the CAF and they won;
+ // `node` should now be an indirection.
+ ENTER(node);
+ } else {
+ jump stg_do_unpack_cstring(node, newCAF_ret);
+ }
+}
+
+stg_do_unpack_cstring_utf8(P_ node, P_ newCAF_ret) {
+ STK_CHK_PP(WDS(SIZEOF_StgUpdateFrame), stg_do_unpack_cstring_utf8, node, newCAF_ret);
+ W_ str;
+ str = StgThunk_payload(node, 2);
+ push (UPDATE_FRAME_FIELDS(,,stg_bh_upd_frame_info, CCCS, 0, newCAF_ret)) {
+ jump %ENTRY_CODE(ghczmprim_GHCziCString_unpackCStringUtf8zh_info)(node, str);
+ }
+}
+
+INFO_TABLE(stg_unpack_cstring_utf8, 0, 0, THUNK_STATIC, "stg_unpack_cstring_utf8", "stg_unpack_cstring_utf8")
+ (P_ node)
+{
+ W_ newCAF_ret;
+ (newCAF_ret) = ccall newCAF(BaseReg "ptr", node "ptr");
+
+ if (newCAF_ret == 0) {
+ // We raced with another thread to evaluate the CAF and they won;
+ // `node` should now be an indirection.
+ ENTER(node);
+ } else {
+ jump stg_do_unpack_cstring_utf8(node, newCAF_ret);
+ }
+}
+
=====================================
rts/include/stg/MiscClosures.h
=====================================
@@ -318,6 +318,10 @@ RTS_THUNK(stg_ap_5_upd);
RTS_THUNK(stg_ap_6_upd);
RTS_THUNK(stg_ap_7_upd);
+// Standard entry for `unpackCString# str` thunks
+RTS_ENTRY(stg_unpack_cstring);
+RTS_ENTRY(stg_unpack_cstring_utf8);
+
/* standard application routines (see also utils/genapply,
* and GHC.StgToCmm.ArgRep).
*/
=====================================
rts/posix/Clock.h
=====================================
@@ -12,9 +12,7 @@
# include <unistd.h>
#endif
-#if defined(HAVE_TIME_H)
-# include <time.h>
-#endif
+#include <time.h>
#if defined(HAVE_SYS_TIME_H)
# include <sys/time.h>
=====================================
rts/posix/ticker/Pthread.c
=====================================
@@ -44,17 +44,10 @@
#include "Schedule.h"
#include "posix/Clock.h"
-/* As recommended in the autoconf manual */
-# if defined(TIME_WITH_SYS_TIME)
-# include <sys/time.h>
-# include <time.h>
-# else
-# if defined(HAVE_SYS_TIME_H)
-# include <sys/time.h>
-# else
-# include <time.h>
-# endif
-# endif
+#include <time.h>
+#if HAVE_SYS_TIME_H
+# include <sys/time.h>
+#endif
#if defined(HAVE_SIGNAL_H)
# include <signal.h>
=====================================
rts/posix/ticker/Setitimer.c
=====================================
@@ -15,17 +15,10 @@
#include "posix/Clock.h"
#include "posix/Signals.h"
-/* As recommended in the autoconf manual */
-# if defined(TIME_WITH_SYS_TIME)
-# include <sys/time.h>
-# include <time.h>
-# else
-# if defined(HAVE_SYS_TIME_H)
-# include <sys/time.h>
-# else
-# include <time.h>
-# endif
-# endif
+#include <time.h>
+#if HAVE_SYS_TIME_H
+# include <sys/time.h>
+#endif
#if defined(HAVE_SIGNAL_H)
# include <signal.h>
=====================================
rts/win32/GetTime.c
=====================================
@@ -11,9 +11,7 @@
#include <windows.h>
-#if defined(HAVE_TIME_H)
-# include <time.h>
-#endif
+#include <time.h>
/* Convert FILETIMEs into secs */
View it on GitLab: https://gitlab.haskell.org/ghc/ghc/-/compare/f7ab503ae5949906caa3f7a2e681455952a385b6...eb43bf22f1439aa74cf8f9fa53710ba42a002597
--
View it on GitLab: https://gitlab.haskell.org/ghc/ghc/-/compare/f7ab503ae5949906caa3f7a2e681455952a385b6...eb43bf22f1439aa74cf8f9fa53710ba42a002597
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/20221021/291af86c/attachment-0001.html>
More information about the ghc-commits
mailing list