Skip to content

GitLab

GHC
GHC
Commit 9e3add93 authored by Jessica Clarke's avatar Jessica Clarke Committed by Ben Gamari
Browse files
Options

Flags.hsc: Peek a CBool (Word8), not a Bool (Int32) 

Reviewers: austin, hvr, bgamari

Reviewed By: bgamari

Subscribers: rwbarton, thomie

Differential Revision: https://phabricator.haskell.org/D4093
parent 366182af
Hide whitespace changes
Inline Side-by-side
Showing with 78 additions and 39 deletions
libraries/base/GHC/RTS/Flags.hsc
View file @ 9e3add93
......@@ -364,20 +364,27 @@ getGCFlags = do
<*> #{peek GC_FLAGS, nurseryChunkSize} ptr
<*> #{peek GC_FLAGS, minOldGenSize} ptr
<*> #{peek GC_FLAGS, heapSizeSuggestion} ptr
<*> #{peek GC_FLAGS, heapSizeSuggestionAuto} ptr
<*> (toBool <$>
(#{peek GC_FLAGS, heapSizeSuggestionAuto} ptr :: IO CBool))
<*> #{peek GC_FLAGS, oldGenFactor} ptr
<*> #{peek GC_FLAGS, pcFreeHeap} ptr
<*> #{peek GC_FLAGS, generations} ptr
<*> #{peek GC_FLAGS, squeezeUpdFrames} ptr
<*> #{peek GC_FLAGS, compact} ptr
<*> (toBool <$>
(#{peek GC_FLAGS, squeezeUpdFrames} ptr :: IO CBool))
<*> (toBool <$>
(#{peek GC_FLAGS, compact} ptr :: IO CBool))
<*> #{peek GC_FLAGS, compactThreshold} ptr
<*> #{peek GC_FLAGS, sweep} ptr
<*> #{peek GC_FLAGS, ringBell} ptr
<*> (toBool <$>
(#{peek GC_FLAGS, sweep} ptr :: IO CBool))
<*> (toBool <$>
(#{peek GC_FLAGS, ringBell} ptr :: IO CBool))
<*> #{peek GC_FLAGS, idleGCDelayTime} ptr
<*> #{peek GC_FLAGS, doIdleGC} ptr
<*> (toBool <$>
(#{peek GC_FLAGS, doIdleGC} ptr :: IO CBool))
<*> #{peek GC_FLAGS, heapBase} ptr
<*> #{peek GC_FLAGS, allocLimitGrace} ptr
<*> #{peek GC_FLAGS, numa} ptr
<*> (toBool <$>
(#{peek GC_FLAGS, numa} ptr :: IO CBool))
<*> #{peek GC_FLAGS, numaMask} ptr
getParFlags :: IO ParFlags
......@@ -385,15 +392,19 @@ getParFlags = do
let ptr = (#ptr RTS_FLAGS, ParFlags) rtsFlagsPtr
ParFlags
<$> #{peek PAR_FLAGS, nCapabilities} ptr
<*> #{peek PAR_FLAGS, migrate} ptr
<*> (toBool <$>
(#{peek PAR_FLAGS, migrate} ptr :: IO CBool))
<*> #{peek PAR_FLAGS, maxLocalSparks} ptr
<*> #{peek PAR_FLAGS, parGcEnabled} ptr
<*> (toBool <$>
(#{peek PAR_FLAGS, parGcEnabled} ptr :: IO CBool))
<*> #{peek PAR_FLAGS, parGcGen} ptr
<*> #{peek PAR_FLAGS, parGcLoadBalancingEnabled} ptr
<*> (toBool <$>
(#{peek PAR_FLAGS, parGcLoadBalancingEnabled} ptr :: IO CBool))
<*> #{peek PAR_FLAGS, parGcLoadBalancingGen} ptr
<*> #{peek PAR_FLAGS, parGcNoSyncWithIdle} ptr
<*> #{peek PAR_FLAGS, parGcThreads} ptr
<*> #{peek PAR_FLAGS, setAffinity} ptr
<*> (toBool <$>
(#{peek PAR_FLAGS, setAffinity} ptr :: IO CBool))
getConcFlags :: IO ConcFlags
getConcFlags = do
......@@ -405,30 +416,49 @@ getMiscFlags :: IO MiscFlags
getMiscFlags = do
let ptr = (#ptr RTS_FLAGS, MiscFlags) rtsFlagsPtr
MiscFlags <$> #{peek MISC_FLAGS, tickInterval} ptr
<*> #{peek MISC_FLAGS, install_signal_handlers} ptr
<*> #{peek MISC_FLAGS, install_seh_handlers} ptr
<*> #{peek MISC_FLAGS, generate_dump_file} ptr
<*> #{peek MISC_FLAGS, machineReadable} ptr
<*> (toBool <$>
(#{peek MISC_FLAGS, install_signal_handlers} ptr :: IO CBool))
<*> (toBool <$>
(#{peek MISC_FLAGS, install_seh_handlers} ptr :: IO CBool))
<*> (toBool <$>
(#{peek MISC_FLAGS, generate_dump_file} ptr :: IO CBool))
<*> (toBool <$>
(#{peek MISC_FLAGS, machineReadable} ptr :: IO CBool))
<*> #{peek MISC_FLAGS, linkerMemBase} ptr
getDebugFlags :: IO DebugFlags
getDebugFlags = do
let ptr = (#ptr RTS_FLAGS, DebugFlags) rtsFlagsPtr
DebugFlags <$> #{peek DEBUG_FLAGS, scheduler} ptr
<*> #{peek DEBUG_FLAGS, interpreter} ptr
<*> #{peek DEBUG_FLAGS, weak} ptr
<*> #{peek DEBUG_FLAGS, gccafs} ptr
<*> #{peek DEBUG_FLAGS, gc} ptr
<*> #{peek DEBUG_FLAGS, block_alloc} ptr
<*> #{peek DEBUG_FLAGS, sanity} ptr
<*> #{peek DEBUG_FLAGS, stable} ptr
<*> #{peek DEBUG_FLAGS, prof} ptr
<*> #{peek DEBUG_FLAGS, linker} ptr
<*> #{peek DEBUG_FLAGS, apply} ptr
<*> #{peek DEBUG_FLAGS, stm} ptr
<*> #{peek DEBUG_FLAGS, squeeze} ptr
<*> #{peek DEBUG_FLAGS, hpc} ptr
<*> #{peek DEBUG_FLAGS, sparks} ptr
DebugFlags <$> (toBool <$>
(#{peek DEBUG_FLAGS, scheduler} ptr :: IO CBool))
<*> (toBool <$>
(#{peek DEBUG_FLAGS, interpreter} ptr :: IO CBool))
<*> (toBool <$>
(#{peek DEBUG_FLAGS, weak} ptr :: IO CBool))
<*> (toBool <$>
(#{peek DEBUG_FLAGS, gccafs} ptr :: IO CBool))
<*> (toBool <$>
(#{peek DEBUG_FLAGS, gc} ptr :: IO CBool))
<*> (toBool <$>
(#{peek DEBUG_FLAGS, block_alloc} ptr :: IO CBool))
<*> (toBool <$>
(#{peek DEBUG_FLAGS, sanity} ptr :: IO CBool))
<*> (toBool <$>
(#{peek DEBUG_FLAGS, stable} ptr :: IO CBool))
<*> (toBool <$>
(#{peek DEBUG_FLAGS, prof} ptr :: IO CBool))
<*> (toBool <$>
(#{peek DEBUG_FLAGS, linker} ptr :: IO CBool))
<*> (toBool <$>
(#{peek DEBUG_FLAGS, apply} ptr :: IO CBool))
<*> (toBool <$>
(#{peek DEBUG_FLAGS, stm} ptr :: IO CBool))
<*> (toBool <$>
(#{peek DEBUG_FLAGS, squeeze} ptr :: IO CBool))
<*> (toBool <$>
(#{peek DEBUG_FLAGS, hpc} ptr :: IO CBool))
<*> (toBool <$>
(#{peek DEBUG_FLAGS, sparks} ptr :: IO CBool))
getCCFlags :: IO CCFlags
getCCFlags = do
......@@ -444,8 +474,10 @@ getProfFlags = do
ProfFlags <$> (toEnum <$> #{peek PROFILING_FLAGS, doHeapProfile} ptr)
<*> #{peek PROFILING_FLAGS, heapProfileInterval} ptr
<*> #{peek PROFILING_FLAGS, heapProfileIntervalTicks} ptr
<*> #{peek PROFILING_FLAGS, includeTSOs} ptr
<*> #{peek PROFILING_FLAGS, showCCSOnException} ptr
<*> (toBool <$>
(#{peek PROFILING_FLAGS, includeTSOs} ptr :: IO CBool))
<*> (toBool <$>
(#{peek PROFILING_FLAGS, showCCSOnException} ptr :: IO CBool))
<*> #{peek PROFILING_FLAGS, maxRetainerSetSize} ptr
<*> #{peek PROFILING_FLAGS, ccsLength} ptr
<*> (peekCStringOpt =<< #{peek PROFILING_FLAGS, modSelector} ptr)
......@@ -461,15 +493,22 @@ getTraceFlags = do
let ptr = (#ptr RTS_FLAGS, TraceFlags) rtsFlagsPtr
TraceFlags <$> (toEnum . fromIntegral
<$> (#{peek TRACE_FLAGS, tracing} ptr :: IO CInt))
<*> #{peek TRACE_FLAGS, timestamp} ptr
<*> #{peek TRACE_FLAGS, scheduler} ptr
<*> #{peek TRACE_FLAGS, gc} ptr
<*> #{peek TRACE_FLAGS, sparks_sampled} ptr
<*> #{peek TRACE_FLAGS, sparks_full} ptr
<*> #{peek TRACE_FLAGS, user} ptr
<*> (toBool <$>
(#{peek TRACE_FLAGS, timestamp} ptr :: IO CBool))
<*> (toBool <$>
(#{peek TRACE_FLAGS, scheduler} ptr :: IO CBool))
<*> (toBool <$>
(#{peek TRACE_FLAGS, gc} ptr :: IO CBool))
<*> (toBool <$>
(#{peek TRACE_FLAGS, sparks_sampled} ptr :: IO CBool))
<*> (toBool <$>
(#{peek TRACE_FLAGS, sparks_full} ptr :: IO CBool))
<*> (toBool <$>
(#{peek TRACE_FLAGS, user} ptr :: IO CBool))
getTickyFlags :: IO TickyFlags
getTickyFlags = do
let ptr = (#ptr RTS_FLAGS, TickyFlags) rtsFlagsPtr
TickyFlags <$> #{peek TICKY_FLAGS, showTickyStats} ptr
TickyFlags <$> (toBool <$>
(#{peek TICKY_FLAGS, showTickyStats} ptr :: IO CBool))
<*> (peekFilePath =<< #{peek TICKY_FLAGS, tickyFile} ptr)
Markdown is supported
0% or .
You are about to add 0 people to the discussion. Proceed with caution.
Finish editing this message first!
Please register or to comment