Skip to content
GitLab
Projects
Groups
Snippets
/
Help
Help
Support
Community forum
Keyboard shortcuts
?
Submit feedback
Sign in / Register
Toggle navigation
Menu
Open sidebar
Glasgow Haskell Compiler
GHC
Commits
c031aeca
Commit
c031aeca
authored
May 08, 2012
by
pcapriotti
Browse files
Use RTS version of getMonotonicNSec on Windows (
#6061
)
parent
8dda2dfb
Changes
3
Hide whitespace changes
Inline
Side-by-side
libraries/base/GHC/Conc/Windows.hs
View file @
c031aeca
...
...
@@ -167,14 +167,9 @@ foreign import ccall unsafe "getOrSetGHCConcWindowsIOManagerThreadStore"
ensureIOManagerIsRunning
::
IO
()
ensureIOManagerIsRunning
|
threaded
=
initialize
IOManager
|
threaded
=
start
IOManager
Thread
|
otherwise
=
return
()
initializeIOManager
::
IO
()
initializeIOManager
=
do
initializeTimer
startIOManagerThread
startIOManagerThread
::
IO
()
startIOManagerThread
=
do
modifyMVar_
ioManagerThread
$
\
old
->
do
...
...
@@ -199,12 +194,13 @@ delayTime (Delay t _) = t
delayTime
(
DelaySTM
t
_
)
=
t
type
USecs
=
Word64
type
NSecs
=
Word64
foreign
import
ccall
unsafe
"getMonotonic
U
Sec"
getMonotonic
U
Sec
::
IO
U
Secs
foreign
import
ccall
unsafe
"getMonotonic
N
Sec"
getMonotonic
N
Sec
::
IO
N
Secs
foreign
import
ccall
unsafe
"initializeTimer"
initializeTimer
::
IO
()
getMonotonicUSec
::
IO
USecs
getMonotonicUSec
=
fmap
(`
div
`
1000
)
getMonotonicNSec
{-# NOINLINE prodding #-}
prodding
::
IORef
Bool
...
...
libraries/base/cbits/Win32Utils.c
View file @
c031aeca
...
...
@@ -110,50 +110,4 @@ void maperrno (void)
errno
=
EINVAL
;
}
// Number of ticks per second used by the QueryPerformanceFrequency
// implementaiton, represented by a 64-bit union type.
static
LARGE_INTEGER
qpc_frequency
=
{.
QuadPart
=
0
};
// Initialize qpc_frequency. This function should be called before any call to
// getMonotonicUSec. If QPC is not supported on this system, qpc_frequency is
// set to 0.
void
initializeTimer
()
{
BOOL
qpc_supported
=
QueryPerformanceFrequency
(
&
qpc_frequency
);
if
(
!
qpc_supported
)
{
qpc_frequency
.
QuadPart
=
0
;
}
}
HsWord64
getMonotonicUSec
()
{
if
(
qpc_frequency
.
QuadPart
)
{
// system_time is a 64-bit union type used to represent the
// tick count returned by QueryPerformanceCounter
LARGE_INTEGER
system_time
;
// get the tick count.
QueryPerformanceCounter
(
&
system_time
);
// compute elapsed seconds as double
double
secs
=
(
double
)
system_time
.
QuadPart
/
(
double
)
qpc_frequency
.
QuadPart
;
// return elapsed time in microseconds
return
(
HsWord64
)(
secs
*
1e6
);
}
else
// fallback to GetTickCount
{
// NOTE: GetTickCount is a 32-bit millisecond value, so it wraps around
// every 49 days.
DWORD
count
=
GetTickCount
();
// getTickCount is in milliseconds, so multiply it by 1000 to get
// microseconds.
return
(
HsWord64
)
count
*
1000
;
}
}
#endif
libraries/base/tests/Concurrent/ThreadDelay001.hs
View file @
c031aeca
...
...
@@ -9,7 +9,7 @@ import Control.Monad
import
System.Time
main
::
IO
()
main
=
mapM_
delay
(
0
:
take
11
(
iterate
(
*
5
)
1
))
main
=
mapM_
delay
(
0
:
take
7
(
iterate
(
*
5
)
1
00
))
delay
::
Int
->
IO
()
delay
n
=
do
...
...
Write
Preview
Supports
Markdown
0%
Try again
or
attach a new file
.
Cancel
You are about to add
0
people
to the discussion. Proceed with caution.
Finish editing this message first!
Cancel
Please
register
or
sign in
to comment