Skip to content
GitLab
Menu
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
2a6f193b
Commit
2a6f193b
authored
Nov 17, 2014
by
Simon Marlow
Browse files
Fix a bug introduced with allocation counters
parent
a2c0a8dd
Changes
4
Hide whitespace changes
Inline
Side-by-side
rts/Schedule.c
View file @
2a6f193b
...
...
@@ -2233,6 +2233,9 @@ suspendThread (StgRegTable *reg, rtsBool interruptible)
task
->
incall
->
suspended_tso
=
tso
;
task
->
incall
->
suspended_cap
=
cap
;
// Otherwise allocate() will write to invalid memory.
cap
->
r
.
rCurrentTSO
=
NULL
ACQUIRE_LOCK
(
&
cap
->
lock
);
suspendTask
(
cap
,
task
);
...
...
testsuite/tests/ffi/should_run/all.T
View file @
2a6f193b
...
...
@@ -209,3 +209,7 @@ test('T8083',
compile_and_run
,
['
T8083_c.c
'])
test
('
ffi023
',
[
omit_ways
(['
ghci
']),
extra_clean
(['
ffi023_c.o
']),
extra_run_opts
('
1000 4
')
],
compile_and_run
,
['
ffi023_c.c
'])
testsuite/tests/ffi/should_run/ffi023.hs
0 → 100644
View file @
2a6f193b
-- Tests for a bug fixed in
module
Main
where
import
System.Environment
import
Control.Concurrent
import
Control.Monad
foreign
import
ccall
safe
"out"
out
::
Int
->
IO
Int
foreign
export
ccall
"incall"
incall
::
Int
->
IO
Int
incall
::
Int
->
IO
Int
incall
x
=
return
$
x
+
1
main
=
do
[
n
,
m
]
<-
fmap
(
fmap
read
)
getArgs
ms
<-
replicateM
m
$
do
v
<-
newEmptyMVar
forkIO
$
do
mapM
out
[
0
..
n
];
putMVar
v
()
return
v
mapM_
takeMVar
ms
testsuite/tests/ffi/should_run/ffi023_c.c
0 → 100644
View file @
2a6f193b
#include "ffi023_stub.h"
#include "HsFFI.h"
#include "Rts.h"
HsInt
out
(
HsInt
x
)
{
performMajorGC
();
return
incall
(
x
);
}
Simon Peyton Jones
@simonpj
mentioned in commit
535644fa
·
Nov 18, 2014
mentioned in commit
535644fa
mentioned in commit 535644facb7fb35baacd3e4fd0c8181eadb24379
Toggle commit list
Write
Preview
Supports
Markdown
0%
Try again
or
attach a new file
.
Attach a 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