Skip to content
GitLab
Projects
Groups
Snippets
Help
Loading...
Help
What's new
10
Help
Support
Community forum
Keyboard shortcuts
?
Submit feedback
Sign in / Register
Toggle navigation
Open sidebar
jberryman
GHC
Commits
9cef40bd
Commit
9cef40bd
authored
Oct 07, 2006
by
tharris@microsoft.com
Browse files
Options
Browse Files
Download
Email Patches
Plain Diff
STM invariants
parent
87c36991
Changes
25
Expand all
Hide whitespace changes
Inline
Side-by-side
Showing
25 changed files
with
1041 additions
and
324 deletions
+1041
-324
compiler/prelude/primops.txt.pp
compiler/prelude/primops.txt.pp
+7
-0
includes/ClosureTypes.h
includes/ClosureTypes.h
+10
-8
includes/Closures.h
includes/Closures.h
+37
-19
includes/Cmm.h
includes/Cmm.h
+3
-2
includes/STM.h
includes/STM.h
+18
-6
includes/StgMiscClosures.h
includes/StgMiscClosures.h
+13
-5
includes/Storage.h
includes/Storage.h
+6
-2
includes/mkDerivedConstants.c
includes/mkDerivedConstants.c
+12
-1
rts/Capability.c
rts/Capability.c
+2
-1
rts/Capability.h
rts/Capability.h
+2
-1
rts/ClosureFlags.c
rts/ClosureFlags.c
+4
-2
rts/Exception.cmm
rts/Exception.cmm
+24
-2
rts/GC.c
rts/GC.c
+101
-21
rts/GCCompact.c
rts/GCCompact.c
+23
-5
rts/LdvProfile.c
rts/LdvProfile.c
+3
-1
rts/Linker.c
rts/Linker.c
+1
-0
rts/PrimOps.cmm
rts/PrimOps.cmm
+124
-55
rts/Printer.c
rts/Printer.c
+3
-1
rts/ProfHeap.c
rts/ProfHeap.c
+12
-2
rts/RaiseAsync.c
rts/RaiseAsync.c
+1
-0
rts/RetainerProfile.c
rts/RetainerProfile.c
+7
-7
rts/STM.c
rts/STM.c
+573
-170
rts/Sanity.c
rts/Sanity.c
+21
-4
rts/Schedule.c
rts/Schedule.c
+18
-4
rts/StgMiscClosures.cmm
rts/StgMiscClosures.cmm
+16
-5
No files found.
compiler/prelude/primops.txt.pp
View file @
9cef40bd
...
...
@@ -1282,6 +1282,13 @@ primop CatchSTMOp "catchSTM#" GenPrimOp
out_of_line = True
has_side_effects = True
primop Check "check#" GenPrimOp
(State# RealWorld -> (# State# RealWorld, a #) )
-> (State# RealWorld -> (# State# RealWorld, () #) )
with
out_of_line = True
has_side_effects = True
primop NewTVarOp "newTVar#" GenPrimOp
a
-> State# s -> (# State# s, TVar# s a #)
...
...
includes/ClosureTypes.h
View file @
9cef40bd
...
...
@@ -85,13 +85,15 @@
#define RBH 61
#define EVACUATED 62
#define REMOTE_REF 63
#define TVAR_WAIT_QUEUE 64
#define TVAR 65
#define TREC_CHUNK 66
#define TREC_HEADER 67
#define ATOMICALLY_FRAME 68
#define CATCH_RETRY_FRAME 69
#define CATCH_STM_FRAME 70
#define N_CLOSURE_TYPES 71
#define TVAR_WATCH_QUEUE 64
#define INVARIANT_CHECK_QUEUE 65
#define ATOMIC_INVARIANT 66
#define TVAR 67
#define TREC_CHUNK 68
#define TREC_HEADER 69
#define ATOMICALLY_FRAME 70
#define CATCH_RETRY_FRAME 71
#define CATCH_STM_FRAME 72
#define N_CLOSURE_TYPES 73
#endif
/* CLOSURETYPES_H */
includes/Closures.h
View file @
9cef40bd
...
...
@@ -331,7 +331,7 @@ typedef struct {
* space for these data structures at the cost of more complexity in the
* implementation:
*
* - In StgTVar, current_value and first_wa
i
t_queue_entry could be held in
* - In StgTVar, current_value and first_wat
ch
_queue_entry could be held in
* the same field: if any thread is waiting then its expected_value for
* the tvar is the current value.
*
...
...
@@ -345,24 +345,33 @@ typedef struct {
* (it immediately switches on frame->waiting anyway).
*/
typedef
struct
StgTVarWaitQueue_
{
typedef
struct
StgTRecHeader_
StgTRecHeader
;
typedef
struct
StgTVarWatchQueue_
{
StgHeader
header
;
struct
StgTSO_
*
waiting_tso
;
struct
StgTVarWa
i
tQueue_
*
next_queue_entry
;
struct
StgTVarWa
i
tQueue_
*
prev_queue_entry
;
}
StgTVarWa
i
tQueue
;
StgClosure
*
closure
;
// StgTSO or StgAtomicInvariant
struct
StgTVarWat
ch
Queue_
*
next_queue_entry
;
struct
StgTVarWat
ch
Queue_
*
prev_queue_entry
;
}
StgTVarWat
ch
Queue
;
typedef
struct
{
StgHeader
header
;
StgClosure
*
volatile
current_value
;
StgTVarWa
i
tQueue
*
volatile
first_wa
i
t_queue_entry
;
StgTVarWat
ch
Queue
*
volatile
first_wat
ch
_queue_entry
;
#if defined(THREADED_RTS)
StgInt
volatile
num_updates
;
#endif
}
StgTVar
;
typedef
struct
{
StgHeader
header
;
StgClosure
*
code
;
StgTRecHeader
*
last_execution
;
StgWord
lock
;
}
StgAtomicInvariant
;
/* new_value == expected_value for read-only accesses */
/* new_value is a StgTVarWa
i
tQueue entry when trec in state TREC_WAITING */
/* new_value is a StgTVarWat
ch
Queue entry when trec in state TREC_WAITING */
typedef
struct
{
StgTVar
*
tvar
;
StgClosure
*
expected_value
;
...
...
@@ -389,29 +398,38 @@ typedef enum {
TREC_WAITING
,
/* Transaction currently waiting */
}
TRecState
;
typedef
struct
StgTRecHeader_
{
typedef
struct
StgInvariantCheckQueue_
{
StgHeader
header
;
StgAtomicInvariant
*
invariant
;
StgTRecHeader
*
my_execution
;
struct
StgInvariantCheckQueue_
*
next_queue_entry
;
}
StgInvariantCheckQueue
;
struct
StgTRecHeader_
{
StgHeader
header
;
TRecState
state
;
struct
StgTRecHeader_
*
enclosing_trec
;
StgTRecChunk
*
current_chunk
;
}
StgTRecHeader
;
StgInvariantCheckQueue
*
invariants_to_check
;
};
typedef
struct
{
StgHeader
header
;
StgClosure
*
code
;
StgHeader
header
;
StgClosure
*
code
;
StgTVarWatchQueue
*
next_invariant_to_check
;
}
StgAtomicallyFrame
;
typedef
struct
{
StgHeader
header
;
StgClosure
*
handler
;
StgHeader
header
;
StgClosure
*
code
;
StgClosure
*
handler
;
}
StgCatchSTMFrame
;
typedef
struct
{
StgHeader
header
;
StgBool
running_alt_code
;
StgClosure
*
first_code
;
StgClosure
*
alt_code
;
StgTRecHeader
*
first_code_trec
;
StgHeader
header
;
StgBool
running_alt_code
;
StgClosure
*
first_code
;
StgClosure
*
alt_code
;
}
StgCatchRetryFrame
;
#if defined(PAR) || defined(GRAN)
...
...
includes/Cmm.h
View file @
9cef40bd
...
...
@@ -513,8 +513,9 @@
Misc junk
-------------------------------------------------------------------------- */
#define NO_TREC stg_NO_TREC_closure
#define END_TSO_QUEUE stg_END_TSO_QUEUE_closure
#define NO_TREC stg_NO_TREC_closure
#define END_TSO_QUEUE stg_END_TSO_QUEUE_closure
#define END_INVARIANT_CHECK_QUEUE stg_END_INVARIANT_CHECK_QUEUE_closure
#define dirtyTSO(tso) \
StgTSO_flags(tso) = StgTSO_flags(tso) | TSO_DIRTY::I32;
...
...
includes/STM.h
View file @
9cef40bd
...
...
@@ -66,14 +66,13 @@ extern StgTRecHeader *stmStartNestedTransaction(Capability *cap, StgTRecHeader *
);
/*
* Exit the current transaction context, abandoning any read/write
* operations performed within it and removing the thread from any
* tvar wait queues if it was waitin. Note that if nested transactions
* are not fully supported then this may leave the enclosing
* transaction contexts doomed to abort.
* Roll back the current transatcion context. NB: if this is a nested tx
* then we merge its read set into its parents. This is because a change
* to that read set could change whether or not the tx should abort.
*/
extern
void
stmAbortTransaction
(
Capability
*
cap
,
StgTRecHeader
*
trec
);
extern
void
stmFreeAbortedTRec
(
Capability
*
cap
,
StgTRecHeader
*
trec
);
/*
* Ensure that a subsequent commit / validation will fail. We use this
...
...
@@ -148,6 +147,18 @@ extern StgBool stmValidateNestOfTransactions(StgTRecHeader *trec);
is actually still valid.
*/
/*
* Fill in the trec's list of invariants that might be violated by the current
* transaction.
*/
extern
StgInvariantCheckQueue
*
stmGetInvariantsToCheck
(
Capability
*
cap
,
StgTRecHeader
*
trec
);
extern
void
stmAddInvariantToCheck
(
Capability
*
cap
,
StgTRecHeader
*
trec
,
StgClosure
*
code
);
/*
* Test whether the current transaction context is valid and, if so,
* commit its memory accesses to the heap. stmCommitTransaction must
...
...
@@ -218,7 +229,8 @@ extern void stmWriteTVar(Capability *cap,
/* NULLs */
#define END_STM_WAIT_QUEUE ((StgTVarWaitQueue *)(void *)&stg_END_STM_WAIT_QUEUE_closure)
#define END_STM_WATCH_QUEUE ((StgTVarWatchQueue *)(void *)&stg_END_STM_WATCH_QUEUE_closure)
#define END_INVARIANT_CHECK_QUEUE ((StgInvariantCheckQueue *)(void *)&stg_END_INVARIANT_CHECK_QUEUE_closure)
#define END_STM_CHUNK_LIST ((StgTRecChunk *)(void *)&stg_END_STM_CHUNK_LIST_closure)
#define NO_TREC ((StgTRecHeader *)(void *)&stg_NO_TREC_closure)
...
...
includes/StgMiscClosures.h
View file @
9cef40bd
...
...
@@ -136,11 +136,14 @@ RTS_INFO(stg_AP_info);
RTS_INFO
(
stg_AP_STACK_info
);
RTS_INFO
(
stg_dummy_ret_info
);
RTS_INFO
(
stg_raise_info
);
RTS_INFO
(
stg_TVAR_WAIT_QUEUE_info
);
RTS_INFO
(
stg_TVAR_WATCH_QUEUE_info
);
RTS_INFO
(
stg_INVARIANT_CHECK_QUEUE_info
);
RTS_INFO
(
stg_ATOMIC_INVARIANT_info
);
RTS_INFO
(
stg_TVAR_info
);
RTS_INFO
(
stg_TREC_CHUNK_info
);
RTS_INFO
(
stg_TREC_HEADER_info
);
RTS_INFO
(
stg_END_STM_WAIT_QUEUE_info
);
RTS_INFO
(
stg_END_STM_WATCH_QUEUE_info
);
RTS_INFO
(
stg_END_INVARIANT_CHECK_QUEUE_info
);
RTS_INFO
(
stg_END_STM_CHUNK_LIST_info
);
RTS_INFO
(
stg_NO_TREC_info
);
...
...
@@ -197,11 +200,14 @@ RTS_ENTRY(stg_AP_entry);
RTS_ENTRY
(
stg_AP_STACK_entry
);
RTS_ENTRY
(
stg_dummy_ret_entry
);
RTS_ENTRY
(
stg_raise_entry
);
RTS_ENTRY
(
stg_END_STM_WAIT_QUEUE_entry
);
RTS_ENTRY
(
stg_END_STM_WATCH_QUEUE_entry
);
RTS_ENTRY
(
stg_END_INVARIANT_CHECK_QUEUE_entry
);
RTS_ENTRY
(
stg_END_STM_CHUNK_LIST_entry
);
RTS_ENTRY
(
stg_NO_TREC_entry
);
RTS_ENTRY
(
stg_TVAR_entry
);
RTS_ENTRY
(
stg_TVAR_WAIT_QUEUE_entry
);
RTS_ENTRY
(
stg_TVAR_WATCH_QUEUE_entry
);
RTS_ENTRY
(
stg_INVARIANT_CHECK_QUEUE_entry
);
RTS_ENTRY
(
stg_ATOMIC_INVARIANT_entry
);
RTS_ENTRY
(
stg_TREC_CHUNK_entry
);
RTS_ENTRY
(
stg_TREC_HEADER_entry
);
...
...
@@ -224,7 +230,8 @@ RTS_CLOSURE(stg_NO_FINALIZER_closure);
RTS_CLOSURE
(
stg_dummy_ret_closure
);
RTS_CLOSURE
(
stg_forceIO_closure
);
RTS_CLOSURE
(
stg_END_STM_WAIT_QUEUE_closure
);
RTS_CLOSURE
(
stg_END_STM_WATCH_QUEUE_closure
);
RTS_CLOSURE
(
stg_END_INVARIANT_CHECK_QUEUE_closure
);
RTS_CLOSURE
(
stg_END_STM_CHUNK_LIST_closure
);
RTS_CLOSURE
(
stg_NO_TREC_closure
);
...
...
@@ -605,5 +612,6 @@ RTS_FUN(atomicallyzh_fast);
RTS_FUN
(
newTVarzh_fast
);
RTS_FUN
(
readTVarzh_fast
);
RTS_FUN
(
writeTVarzh_fast
);
RTS_FUN
(
checkzh_fast
);
#endif
/* STGMISCCLOSURES_H */
includes/Storage.h
View file @
9cef40bd
...
...
@@ -406,14 +406,18 @@ closure_sizeW_ (StgClosure *p, StgInfoTable *info)
return
tso_sizeW
((
StgTSO
*
)
p
);
case
BCO
:
return
bco_sizeW
((
StgBCO
*
)
p
);
case
TVAR_WA
I
T_QUEUE
:
return
sizeofW
(
StgTVarWa
i
tQueue
);
case
TVAR_WAT
CH
_QUEUE
:
return
sizeofW
(
StgTVarWat
ch
Queue
);
case
TVAR
:
return
sizeofW
(
StgTVar
);
case
TREC_CHUNK
:
return
sizeofW
(
StgTRecChunk
);
case
TREC_HEADER
:
return
sizeofW
(
StgTRecHeader
);
case
ATOMIC_INVARIANT
:
return
sizeofW
(
StgAtomicInvariant
);
case
INVARIANT_CHECK_QUEUE
:
return
sizeofW
(
StgInvariantCheckQueue
);
default:
return
sizeW_fromITBL
(
info
);
}
...
...
includes/mkDerivedConstants.c
View file @
9cef40bd
...
...
@@ -328,15 +328,26 @@ main(int argc, char *argv[])
closure_size
(
StgAtomicallyFrame
);
closure_field
(
StgAtomicallyFrame
,
code
);
closure_field
(
StgAtomicallyFrame
,
next_invariant_to_check
);
closure_field
(
StgInvariantCheckQueue
,
invariant
);
closure_field
(
StgInvariantCheckQueue
,
my_execution
);
closure_field
(
StgInvariantCheckQueue
,
next_queue_entry
);
closure_field
(
StgAtomicInvariant
,
code
);
closure_size
(
StgCatchSTMFrame
);
closure_field
(
StgCatchSTMFrame
,
handler
);
closure_field
(
StgCatchSTMFrame
,
code
);
closure_size
(
StgCatchRetryFrame
);
closure_field
(
StgCatchRetryFrame
,
running_alt_code
);
closure_field
(
StgCatchRetryFrame
,
first_code
);
closure_field
(
StgCatchRetryFrame
,
alt_code
);
closure_field
(
StgCatchRetryFrame
,
first_code_trec
);
closure_field
(
StgTVarWatchQueue
,
closure
);
closure_field
(
StgTVarWatchQueue
,
next_queue_entry
);
closure_field
(
StgTVarWatchQueue
,
prev_queue_entry
);
closure_size
(
StgWeak
);
closure_field
(
StgWeak
,
link
);
...
...
rts/Capability.c
View file @
9cef40bd
...
...
@@ -153,7 +153,8 @@ initCapability( Capability *cap, nat i )
cap
->
mut_lists
[
g
]
=
NULL
;
}
cap
->
free_tvar_wait_queues
=
END_STM_WAIT_QUEUE
;
cap
->
free_tvar_watch_queues
=
END_STM_WATCH_QUEUE
;
cap
->
free_invariant_check_queues
=
END_INVARIANT_CHECK_QUEUE
;
cap
->
free_trec_chunks
=
END_STM_CHUNK_LIST
;
cap
->
free_trec_headers
=
NO_TREC
;
cap
->
transaction_tokens
=
0
;
...
...
rts/Capability.h
View file @
9cef40bd
...
...
@@ -89,7 +89,8 @@ struct Capability_ {
#endif
// Per-capability STM-related data
StgTVarWaitQueue
*
free_tvar_wait_queues
;
StgTVarWatchQueue
*
free_tvar_watch_queues
;
StgInvariantCheckQueue
*
free_invariant_check_queues
;
StgTRecChunk
*
free_trec_chunks
;
StgTRecHeader
*
free_trec_headers
;
nat
transaction_tokens
;
...
...
rts/ClosureFlags.c
View file @
9cef40bd
...
...
@@ -90,7 +90,9 @@ StgWord16 closure_flags[] = {
/* RBH = */
(
_NS
|
_MUT
|
_UPT
),
/* EVACUATED = */
(
0
),
/* REMOTE_REF = */
(
_HNF
|
_NS
|
_UPT
),
/* TVAR_WAIT_QUEUE = */
(
_NS
|
_MUT
|
_UPT
),
/* TVAR_WATCH_QUEUE = */
(
_NS
|
_MUT
|
_UPT
),
/* INVARIANT_CHECK_QUEUE= */
(
_NS
|
_MUT
|
_UPT
),
/* ATOMIC_INVARIANT = */
(
_NS
|
_MUT
|
_UPT
),
/* TVAR = */
(
_HNF
|
_NS
|
_MUT
|
_UPT
),
/* TREC_CHUNK = */
(
_NS
|
_MUT
|
_UPT
),
/* TREC_HEADER = */
(
_NS
|
_MUT
|
_UPT
),
...
...
@@ -99,6 +101,6 @@ StgWord16 closure_flags[] = {
/* CATCH_STM_FRAME = */
(
_BTM
)
};
#if N_CLOSURE_TYPES != 7
1
#if N_CLOSURE_TYPES != 7
3
#error Closure types changed: update ClosureFlags.c!
#endif
rts/Exception.cmm
View file @
9cef40bd
...
...
@@ -344,12 +344,25 @@ retry_pop_stack:
if
(
frame_type
==
ATOMICALLY_FRAME
)
{
/* The exception has reached the edge of a memory transaction. Check that
* the transaction is valid. If not then perhaps the exception should
* not have been thrown: re-run the transaction */
W_
trec
;
* not have been thrown: re-run the transaction. "trec" will either be
* a top-level transaction running the atomic block, or a nested
* transaction running an invariant check. In the latter case we
* abort and de-allocate the top-level transaction that encloses it
* as well (we could just abandon its transaction record, but this makes
* sure it's marked as aborted and available for re-use). */
W_
trec
,
outer
;
W_
r
;
trec
=
StgTSO_trec
(
CurrentTSO
);
r
=
foreign
"
C
"
stmValidateNestOfTransactions
(
trec
"
ptr
"
);
"
ptr
"
outer
=
foreign
"
C
"
stmGetEnclosingTRec
(
trec
"
ptr
"
)
[];
foreign
"
C
"
stmAbortTransaction
(
MyCapability
()
"
ptr
"
,
trec
"
ptr
"
);
foreign
"
C
"
stmFreeAbortedTRec
(
MyCapability
()
"
ptr
"
,
trec
"
ptr
"
);
if
(
outer
!=
NO_TREC
)
{
foreign
"
C
"
stmAbortTransaction
(
MyCapability
()
"
ptr
"
,
outer
"
ptr
"
);
foreign
"
C
"
stmFreeAbortedTRec
(
MyCapability
()
"
ptr
"
,
outer
"
ptr
"
);
}
StgTSO_trec
(
CurrentTSO
)
=
NO_TREC
;
if
(
r
!=
0
)
{
// Transaction was valid: continue searching for a catch frame
...
...
@@ -400,6 +413,9 @@ retry_pop_stack:
* If exceptions were unblocked, arrange that they are unblocked
* again after executing the handler by pushing an
* unblockAsyncExceptions_ret stack frame.
*
* If we've reached an STM catch frame then roll back the nested
* transaction we were using.
*/
W_
frame
;
frame
=
Sp
;
...
...
@@ -410,6 +426,12 @@ retry_pop_stack:
Sp
(
0
)
=
stg_unblockAsyncExceptionszh_ret_info
;
}
}
else
{
W_
trec
,
outer
;
trec
=
StgTSO_trec
(
CurrentTSO
);
"
ptr
"
outer
=
foreign
"
C
"
stmGetEnclosingTRec
(
trec
"
ptr
"
)
[];
foreign
"
C
"
stmAbortTransaction
(
MyCapability
()
"
ptr
"
,
trec
"
ptr
"
)
[];
foreign
"
C
"
stmFreeAbortedTRec
(
MyCapability
()
"
ptr
"
,
trec
"
ptr
"
)
[];
StgTSO_trec
(
CurrentTSO
)
=
outer
;
Sp
=
Sp
+
SIZEOF_StgCatchSTMFrame
;
}
...
...
rts/GC.c
View file @
9cef40bd
...
...
@@ -2233,8 +2233,8 @@ loop:
case
TREC_HEADER
:
return
copy
(
q
,
sizeofW
(
StgTRecHeader
),
stp
);
case
TVAR_WA
I
T_QUEUE
:
return
copy
(
q
,
sizeofW
(
StgTVarWa
i
tQueue
),
stp
);
case
TVAR_WAT
CH
_QUEUE
:
return
copy
(
q
,
sizeofW
(
StgTVarWat
ch
Queue
),
stp
);
case
TVAR
:
return
copy
(
q
,
sizeofW
(
StgTVar
),
stp
);
...
...
@@ -2242,6 +2242,12 @@ loop:
case
TREC_CHUNK
:
return
copy
(
q
,
sizeofW
(
StgTRecChunk
),
stp
);
case
ATOMIC_INVARIANT
:
return
copy
(
q
,
sizeofW
(
StgAtomicInvariant
),
stp
);
case
INVARIANT_CHECK_QUEUE
:
return
copy
(
q
,
sizeofW
(
StgInvariantCheckQueue
),
stp
);
default:
barf
(
"evacuate: strange closure type %d"
,
(
int
)(
info
->
type
));
}
...
...
@@ -3112,16 +3118,16 @@ scavenge(step *stp)
}
#endif
case
TVAR_WA
I
T_QUEUE
:
case
TVAR_WAT
CH
_QUEUE
:
{
StgTVarWa
i
tQueue
*
wq
=
((
StgTVarWa
i
tQueue
*
)
p
);
StgTVarWat
ch
Queue
*
wq
=
((
StgTVarWat
ch
Queue
*
)
p
);
evac_gen
=
0
;
wq
->
waiting_tso
=
(
StgTSO
*
)
evacuate
((
StgClosure
*
)
wq
->
waiting_tso
);
wq
->
next_queue_entry
=
(
StgTVarWa
i
tQueue
*
)
evacuate
((
StgClosure
*
)
wq
->
next_queue_entry
);
wq
->
prev_queue_entry
=
(
StgTVarWa
i
tQueue
*
)
evacuate
((
StgClosure
*
)
wq
->
prev_queue_entry
);
wq
->
closure
=
(
StgClosure
*
)
evacuate
((
StgClosure
*
)
wq
->
closure
);
wq
->
next_queue_entry
=
(
StgTVarWat
ch
Queue
*
)
evacuate
((
StgClosure
*
)
wq
->
next_queue_entry
);
wq
->
prev_queue_entry
=
(
StgTVarWat
ch
Queue
*
)
evacuate
((
StgClosure
*
)
wq
->
prev_queue_entry
);
evac_gen
=
saved_evac_gen
;
failed_to_evac
=
rtsTrue
;
// mutable
p
+=
sizeofW
(
StgTVarWa
i
tQueue
);
p
+=
sizeofW
(
StgTVarWat
ch
Queue
);
break
;
}
...
...
@@ -3130,7 +3136,7 @@ scavenge(step *stp)
StgTVar
*
tvar
=
((
StgTVar
*
)
p
);
evac_gen
=
0
;
tvar
->
current_value
=
evacuate
((
StgClosure
*
)
tvar
->
current_value
);
tvar
->
first_wa
i
t_queue_entry
=
(
StgTVarWa
i
tQueue
*
)
evacuate
((
StgClosure
*
)
tvar
->
first_wa
i
t_queue_entry
);
tvar
->
first_wat
ch
_queue_entry
=
(
StgTVarWat
ch
Queue
*
)
evacuate
((
StgClosure
*
)
tvar
->
first_wat
ch
_queue_entry
);
evac_gen
=
saved_evac_gen
;
failed_to_evac
=
rtsTrue
;
// mutable
p
+=
sizeofW
(
StgTVar
);
...
...
@@ -3143,6 +3149,7 @@ scavenge(step *stp)
evac_gen
=
0
;
trec
->
enclosing_trec
=
(
StgTRecHeader
*
)
evacuate
((
StgClosure
*
)
trec
->
enclosing_trec
);
trec
->
current_chunk
=
(
StgTRecChunk
*
)
evacuate
((
StgClosure
*
)
trec
->
current_chunk
);
trec
->
invariants_to_check
=
(
StgInvariantCheckQueue
*
)
evacuate
((
StgClosure
*
)
trec
->
invariants_to_check
);
evac_gen
=
saved_evac_gen
;
failed_to_evac
=
rtsTrue
;
// mutable
p
+=
sizeofW
(
StgTRecHeader
);
...
...
@@ -3167,6 +3174,31 @@ scavenge(step *stp)
break
;
}
case
ATOMIC_INVARIANT
:
{
StgAtomicInvariant
*
invariant
=
((
StgAtomicInvariant
*
)
p
);
evac_gen
=
0
;
invariant
->
code
=
(
StgClosure
*
)
evacuate
(
invariant
->
code
);
invariant
->
last_execution
=
(
StgTRecHeader
*
)
evacuate
((
StgClosure
*
)
invariant
->
last_execution
);
evac_gen
=
saved_evac_gen
;
failed_to_evac
=
rtsTrue
;
// mutable
p
+=
sizeofW
(
StgAtomicInvariant
);
break
;
}
case
INVARIANT_CHECK_QUEUE
:
{
StgInvariantCheckQueue
*
queue
=
((
StgInvariantCheckQueue
*
)
p
);
evac_gen
=
0
;
queue
->
invariant
=
(
StgAtomicInvariant
*
)
evacuate
((
StgClosure
*
)
queue
->
invariant
);
queue
->
my_execution
=
(
StgTRecHeader
*
)
evacuate
((
StgClosure
*
)
queue
->
my_execution
);
queue
->
next_queue_entry
=
(
StgInvariantCheckQueue
*
)
evacuate
((
StgClosure
*
)
queue
->
next_queue_entry
);
evac_gen
=
saved_evac_gen
;
failed_to_evac
=
rtsTrue
;
// mutable
p
+=
sizeofW
(
StgInvariantCheckQueue
);
break
;
}
default:
barf
(
"scavenge: unimplemented/strange closure type %d @ %p"
,
info
->
type
,
p
);
...
...
@@ -3496,13 +3528,13 @@ linear_scan:
}
#endif
/* PAR */
case
TVAR_WA
I
T_QUEUE
:
case
TVAR_WAT
CH
_QUEUE
:
{
StgTVarWa
i
tQueue
*
wq
=
((
StgTVarWa
i
tQueue
*
)
p
);
StgTVarWat
ch
Queue
*
wq
=
((
StgTVarWat
ch
Queue
*
)
p
);
evac_gen
=
0
;
wq
->
waiting_tso
=
(
StgTSO
*
)
evacuate
((
StgClosure
*
)
wq
->
waiting_tso
);
wq
->
next_queue_entry
=
(
StgTVarWa
i
tQueue
*
)
evacuate
((
StgClosure
*
)
wq
->
next_queue_entry
);
wq
->
prev_queue_entry
=
(
StgTVarWa
i
tQueue
*
)
evacuate
((
StgClosure
*
)
wq
->
prev_queue_entry
);
wq
->
closure
=
(
StgClosure
*
)
evacuate
((
StgClosure
*
)
wq
->
closure
);
wq
->
next_queue_entry
=
(
StgTVarWat
ch
Queue
*
)
evacuate
((
StgClosure
*
)
wq
->
next_queue_entry
);
wq
->
prev_queue_entry
=
(
StgTVarWat
ch
Queue
*
)
evacuate
((
StgClosure
*
)
wq
->
prev_queue_entry
);
evac_gen
=
saved_evac_gen
;
failed_to_evac
=
rtsTrue
;
// mutable
break
;
...
...
@@ -3513,7 +3545,7 @@ linear_scan:
StgTVar
*
tvar
=
((
StgTVar
*
)
p
);
evac_gen
=
0
;
tvar
->
current_value
=
evacuate
((
StgClosure
*
)
tvar
->
current_value
);
tvar
->
first_wa
i
t_queue_entry
=
(
StgTVarWa
i
tQueue
*
)
evacuate
((
StgClosure
*
)
tvar
->
first_wa
i
t_queue_entry
);
tvar
->
first_wat
ch
_queue_entry
=
(
StgTVarWat
ch
Queue
*
)
evacuate
((
StgClosure
*
)
tvar
->
first_wat
ch
_queue_entry
);
evac_gen
=
saved_evac_gen
;
failed_to_evac
=
rtsTrue
;
// mutable
break
;
...
...
@@ -3542,11 +3574,35 @@ linear_scan:
evac_gen
=
0
;
trec
->
enclosing_trec
=
(
StgTRecHeader
*
)
evacuate
((
StgClosure
*
)
trec
->
enclosing_trec
);
trec
->
current_chunk
=
(
StgTRecChunk
*
)
evacuate
((
StgClosure
*
)
trec
->
current_chunk
);
trec
->
invariants_to_check
=
(
StgInvariantCheckQueue
*
)
evacuate
((
StgClosure
*
)
trec
->
invariants_to_check
);
evac_gen
=
saved_evac_gen
;
failed_to_evac
=
rtsTrue
;
// mutable
break
;
}
case
ATOMIC_INVARIANT
:
{
StgAtomicInvariant
*
invariant
=
((
StgAtomicInvariant
*
)
p
);
evac_gen
=
0
;
invariant
->
code
=
(
StgClosure
*
)
evacuate
(
invariant
->
code
);
invariant
->
last_execution
=
(
StgTRecHeader
*
)
evacuate
((
StgClosure
*
)
invariant
->
last_execution
);
evac_gen
=
saved_evac_gen
;
failed_to_evac
=
rtsTrue
;
// mutable
break
;
}
case
INVARIANT_CHECK_QUEUE
:
{
StgInvariantCheckQueue
*
queue
=
((
StgInvariantCheckQueue
*
)
p
);
evac_gen
=
0
;
queue
->
invariant
=
(
StgAtomicInvariant
*
)
evacuate
((
StgClosure
*
)
queue
->
invariant
);
queue
->
my_execution
=
(
StgTRecHeader
*
)
evacuate
((
StgClosure
*
)
queue
->
my_execution
);
queue
->
next_queue_entry
=
(
StgInvariantCheckQueue
*
)
evacuate
((
StgClosure
*
)
queue
->
next_queue_entry
);
evac_gen
=
saved_evac_gen
;
failed_to_evac
=
rtsTrue
;
// mutable
break
;
}
default:
barf
(
"scavenge_mark_stack: unimplemented/strange closure type %d @ %p"
,
info
->
type
,
p
);
...
...
@@ -3847,13 +3903,13 @@ scavenge_one(StgPtr p)
}
#endif
case
TVAR_WA
I
T_QUEUE
:
case
TVAR_WAT
CH
_QUEUE
:
{
StgTVarWa
i
tQueue
*
wq
=
((
StgTVarWa
i
tQueue
*
)
p
);
StgTVarWat
ch
Queue
*
wq
=
((
StgTVarWat
ch
Queue
*
)
p
);
evac_gen
=
0
;
wq
->
waiting_tso
=
(
StgTSO
*
)
evacuate
((
StgClosure
*
)
wq
->
waiting_tso
);
wq
->
next_queue_entry
=
(
StgTVarWa
i
tQueue
*
)
evacuate
((
StgClosure
*
)
wq
->
next_queue_entry
);
wq
->
prev_queue_entry
=
(
StgTVarWa
i
tQueue
*
)
evacuate
((
StgClosure
*
)
wq
->
prev_queue_entry
);
wq
->
closure
=
(
StgClosure
*
)
evacuate
((
StgClosure
*
)
wq
->
closure
);
wq
->
next_queue_entry
=
(
StgTVarWat
ch
Queue
*
)
evacuate
((
StgClosure
*
)
wq
->
next_queue_entry
);
wq
->
prev_queue_entry
=
(
StgTVarWat
ch
Queue
*
)
evacuate
((
StgClosure
*
)
wq
->
prev_queue_entry
);
evac_gen
=
saved_evac_gen
;
failed_to_evac
=
rtsTrue
;
// mutable
break
;
...
...
@@ -3864,7 +3920,7 @@ scavenge_one(StgPtr p)
StgTVar
*
tvar
=
((
StgTVar
*
)
p
);
evac_gen
=
0
;
tvar
->
current_value
=
evacuate
((
StgClosure
*
)
tvar
->
current_value
);
tvar
->
first_wa
i
t_queue_entry
=
(
StgTVarWa
i
tQueue
*
)
evacuate
((
StgClosure
*
)
tvar
->
first_wa
i
t_queue_entry
);
tvar
->
first_wat
ch
_queue_entry
=
(
StgTVarWat
ch
Queue
*
)
evacuate
((
StgClosure
*
)
tvar
->
first_wat
ch
_queue_entry
);
evac_gen
=
saved_evac_gen
;
failed_to_evac
=
rtsTrue
;
// mutable
break
;
...
...
@@ -3876,6 +3932,7 @@ scavenge_one(StgPtr p)
evac_gen
=
0
;
trec
->
enclosing_trec
=
(
StgTRecHeader
*
)
evacuate
((
StgClosure
*
)
trec
->
enclosing_trec
);
trec
->
current_chunk
=
(
StgTRecChunk
*
)
evacuate
((
StgClosure
*
)
trec
->
current_chunk
);
trec
->
invariants_to_check
=
(
StgInvariantCheckQueue
*
)
evacuate
((
StgClosure
*
)
trec
->
invariants_to_check
);
evac_gen
=
saved_evac_gen
;
failed_to_evac
=
rtsTrue
;
// mutable
break
;
...
...
@@ -3898,6 +3955,29 @@ scavenge_one(StgPtr p)
break
;
}
case
ATOMIC_INVARIANT
:
{
StgAtomicInvariant
*
invariant
=
((
StgAtomicInvariant
*
)
p
);
evac_gen
=
0
;
invariant
->
code
=
(
StgClosure
*
)
evacuate
(
invariant
->
code
);
invariant
->
last_execution
=
(
StgTRecHeader
*
)
evacuate
((
StgClosure
*
)
invariant
->
last_execution
);
evac_gen
=
saved_evac_gen
;
failed_to_evac
=
rtsTrue
;
// mutable
break
;
}
case
INVARIANT_CHECK_QUEUE
:
{
StgInvariantCheckQueue
*
queue
=
((
StgInvariantCheckQueue
*
)
p
);
evac_gen
=
0
;
queue
->
invariant
=
(
StgAtomicInvariant
*
)
evacuate
((
StgClosure
*
)
queue
->
invariant
);
queue
->
my_execution
=
(
StgTRecHeader
*
)
evacuate
((
StgClosure
*
)
queue
->
my_execution
);
queue
->
next_queue_entry
=
(
StgInvariantCheckQueue
*
)
evacuate
((
StgClosure
*
)
queue
->
next_queue_entry
);
evac_gen
=
saved_evac_gen
;
failed_to_evac
=
rtsTrue
;
// mutable
break
;
}
case
IND_OLDGEN
:
case
IND_OLDGEN_PERM
:
case
IND_STATIC
:
...
...
rts/GCCompact.c
View file @
9cef40bd
...
...
@@ -628,20 +628,20 @@ thread_obj (StgInfoTable *info, StgPtr p)
case
TSO
: