/*......................................................................*/
+#define IF_STM_UNIPROC(__X) do { } while (0)
+#define IF_STM_CG_LOCK(__X) do { } while (0)
+#define IF_STM_FG_LOCKS(__X) do { } while (0)
+
#if defined(STM_UNIPROC)
+#undef IF_STM_UNIPROC
+#define IF_STM_UNIPROC(__X) do { __X } while (0)
static const StgBool use_read_phase = FALSE;
static void lock_stm(StgTRecHeader *trec STG_UNUSED) {
StgClosure *result;
TRACE("%p : cond_lock_tvar(%p, %p)\n", trec, s, expected);
result = s -> current_value;
- TRACE("%p : %d\n", (result == expected) ? "success" : "failure");
+ TRACE("%p : %s\n", trec, (result == expected) ? "success" : "failure");
return (result == expected);
}
#endif
#if defined(STM_CG_LOCK) /*........................................*/
+#undef IF_STM_CG_LOCK
+#define IF_STM_CG_LOCK(__X) do { __X } while (0)
static const StgBool use_read_phase = FALSE;
static volatile StgTRecHeader *smp_locked = NULL;
#if defined(STM_FG_LOCKS) /*...................................*/
+#undef IF_STM_FG_LOCKS
+#define IF_STM_FG_LOCKS(__X) do { __X } while (0)
static const StgBool use_read_phase = TRUE;
static void lock_stm(StgTRecHeader *trec STG_UNUSED) {
// Helper functions for thread blocking and unblocking
static void park_tso(StgTSO *tso) {
- ACQUIRE_LOCK(&sched_mutex);
ASSERT(tso -> why_blocked == NotBlocked);
tso -> why_blocked = BlockedOnSTM;
tso -> block_info.closure = (StgClosure *) END_TSO_QUEUE;
- RELEASE_LOCK(&sched_mutex);
TRACE("park_tso on tso=%p\n", tso);
}
-static void unpark_tso(StgTSO *tso) {
+static void unpark_tso(Capability *cap, StgTSO *tso) {
// We will continue unparking threads while they remain on one of the wait
// queues: it's up to the thread itself to remove it from the wait queues
// if it decides to do so when it is scheduled.
if (tso -> why_blocked == BlockedOnSTM) {
TRACE("unpark_tso on tso=%p\n", tso);
- ACQUIRE_LOCK(&sched_mutex);
- tso -> why_blocked = NotBlocked;
- PUSH_ON_RUN_QUEUE(tso);
- RELEASE_LOCK(&sched_mutex);
+ unblockOne(cap,tso);
} else {
TRACE("spurious unpark_tso on tso=%p\n", tso);
}
}
-static void unpark_waiters_on(StgTVar *s) {
+static void unpark_waiters_on(Capability *cap, StgTVar *s) {
StgTVarWaitQueue *q;
TRACE("unpark_waiters_on tvar=%p\n", s);
for (q = s -> first_wait_queue_entry;
q != END_STM_WAIT_QUEUE;
q = q -> next_queue_entry) {
- unpark_tso(q -> waiting_tso);
+ unpark_tso(cap, q -> waiting_tso);
}
}
// Helper functions for allocation and initialization
-static StgTVarWaitQueue *new_stg_tvar_wait_queue(StgRegTable *reg,
+static StgTVarWaitQueue *new_stg_tvar_wait_queue(Capability *cap,
StgTSO *waiting_tso) {
StgTVarWaitQueue *result;
- result = (StgTVarWaitQueue *)allocateLocal(reg, sizeofW(StgTVarWaitQueue));
+ result = (StgTVarWaitQueue *)allocateLocal(cap, sizeofW(StgTVarWaitQueue));
SET_HDR (result, &stg_TVAR_WAIT_QUEUE_info, CCS_SYSTEM);
result -> waiting_tso = waiting_tso;
return result;
}
-static StgTRecChunk *new_stg_trec_chunk(StgRegTable *reg) {
+static StgTRecChunk *new_stg_trec_chunk(Capability *cap) {
StgTRecChunk *result;
- result = (StgTRecChunk *)allocateLocal(reg, sizeofW(StgTRecChunk));
+ result = (StgTRecChunk *)allocateLocal(cap, sizeofW(StgTRecChunk));
SET_HDR (result, &stg_TREC_CHUNK_info, CCS_SYSTEM);
result -> prev_chunk = END_STM_CHUNK_LIST;
result -> next_entry_idx = 0;
return result;
}
-static StgTRecHeader *new_stg_trec_header(StgRegTable *reg,
+static StgTRecHeader *new_stg_trec_header(Capability *cap,
StgTRecHeader *enclosing_trec) {
StgTRecHeader *result;
- result = (StgTRecHeader *) allocateLocal(reg, sizeofW(StgTRecHeader));
+ result = (StgTRecHeader *) allocateLocal(cap, sizeofW(StgTRecHeader));
SET_HDR (result, &stg_TREC_HEADER_info, CCS_SYSTEM);
result -> enclosing_trec = enclosing_trec;
- result -> current_chunk = new_stg_trec_chunk(reg);
+ result -> current_chunk = new_stg_trec_chunk(cap);
if (enclosing_trec == NO_TREC) {
result -> state = TREC_ACTIVE;
return result;
}
+static StgTVar *new_tvar(Capability *cap,
+ StgClosure *new_value) {
+ StgTVar *result;
+ result = (StgTVar *)allocateLocal(cap, sizeofW(StgTVar));
+ SET_HDR (result, &stg_TVAR_info, CCS_SYSTEM);
+ result -> current_value = new_value;
+ result -> first_wait_queue_entry = END_STM_WAIT_QUEUE;
+#if defined(SMP)
+ result -> last_update_by = NO_TREC;
+#endif
+ return result;
+}
+
/*......................................................................*/
// Helper functions for managing waiting lists
-static void build_wait_queue_entries_for_trec(StgRegTable *reg,
+static void build_wait_queue_entries_for_trec(Capability *cap,
StgTSO *tso,
StgTRecHeader *trec) {
ASSERT(trec != NO_TREC);
ACQ_ASSERT(s -> current_value == trec);
NACQ_ASSERT(s -> current_value == e -> expected_value);
fq = s -> first_wait_queue_entry;
- q = new_stg_tvar_wait_queue(reg, tso);
+ q = new_stg_tvar_wait_queue(cap, tso);
q -> next_queue_entry = fq;
q -> prev_queue_entry = END_STM_WAIT_QUEUE;
if (fq != END_STM_WAIT_QUEUE) {
/*......................................................................*/
-static TRecEntry *get_new_entry(StgRegTable *reg,
+static TRecEntry *get_new_entry(Capability *cap,
StgTRecHeader *t) {
TRecEntry *result;
StgTRecChunk *c;
} else {
// Current chunk is full: allocate a fresh one
StgTRecChunk *nc;
- nc = new_stg_trec_chunk(reg);
+ nc = new_stg_trec_chunk(cap);
nc -> prev_chunk = c;
nc -> next_entry_idx = 1;
t -> current_chunk = nc;
/*......................................................................*/
-static void merge_update_into(StgRegTable *reg,
+static void merge_update_into(Capability *cap,
StgTRecHeader *t,
StgTVar *tvar,
StgClosure *expected_value,
if (!found) {
// No entry so far in this trec
TRecEntry *ne;
- ne = get_new_entry(reg, t);
+ ne = get_new_entry(cap, t);
ne -> tvar = tvar;
ne -> expected_value = expected_value;
ne -> new_value = new_value;
BREAK_FOR_EACH;
}
} else {
- TRACE("%p : will need to check %p\n", trec, s);
- if (s -> current_value != e -> expected_value) {
- TRACE("%p : doesn't match\n", trec);
- result = FALSE;
- BREAK_FOR_EACH;
- }
- e -> saw_update_by = s -> last_update_by;
- if (s -> current_value != e -> expected_value) {
- TRACE("%p : doesn't match (race)\n", trec);
- result = FALSE;
- BREAK_FOR_EACH;
- } else {
- TRACE("%p : need to check update by %p\n", trec, e -> saw_update_by);
- }
+ ASSERT(use_read_phase);
+ IF_STM_FG_LOCKS({
+ TRACE("%p : will need to check %p\n", trec, s);
+ if (s -> current_value != e -> expected_value) {
+ TRACE("%p : doesn't match\n", trec);
+ result = FALSE;
+ BREAK_FOR_EACH;
+ }
+ e -> saw_update_by = s -> last_update_by;
+ if (s -> current_value != e -> expected_value) {
+ TRACE("%p : doesn't match (race)\n", trec);
+ result = FALSE;
+ BREAK_FOR_EACH;
+ } else {
+ TRACE("%p : need to check update by %p\n", trec, e -> saw_update_by);
+ }
+ });
}
});
}
// Keir Fraser's PhD dissertation "Practical lock-free programming" discuss
// this kind of algorithm.
-static StgBool check_read_only(StgTRecHeader *trec) {
+static StgBool check_read_only(StgTRecHeader *trec STG_UNUSED) {
StgBool result = TRUE;
- FOR_EACH_ENTRY(trec, e, {
- StgTVar *s;
- s = e -> tvar;
- if (entry_is_read_only(e)) {
- TRACE("%p : check_read_only for TVar %p, saw %p\n", trec, s, e -> saw_update_by);
- if (s -> last_update_by != e -> saw_update_by) {
- // ||s -> current_value != e -> expected_value) {
- TRACE("%p : mismatch\n", trec);
- result = FALSE;
- BREAK_FOR_EACH;
+ ASSERT (use_read_phase);
+ IF_STM_FG_LOCKS({
+ FOR_EACH_ENTRY(trec, e, {
+ StgTVar *s;
+ s = e -> tvar;
+ if (entry_is_read_only(e)) {
+ TRACE("%p : check_read_only for TVar %p, saw %p\n", trec, s, e -> saw_update_by);
+ if (s -> last_update_by != e -> saw_update_by) {
+ // ||s -> current_value != e -> expected_value) {
+ TRACE("%p : mismatch\n", trec);
+ result = FALSE;
+ BREAK_FOR_EACH;
+ }
}
- }
+ });
});
return result;
/*......................................................................*/
-StgTRecHeader *stmStartTransaction(StgRegTable *reg,
+StgTRecHeader *stmStartTransaction(Capability *cap,
StgTRecHeader *outer) {
StgTRecHeader *t;
TRACE("%p : stmStartTransaction\n", outer);
- t = new_stg_trec_header(reg, outer);
+ t = new_stg_trec_header(cap, outer);
TRACE("%p : stmStartTransaction()=%p\n", outer, t);
return t;
}
/*......................................................................*/
-StgBool stmCommitTransaction(StgRegTable *reg STG_UNUSED, StgTRecHeader *trec) {
+StgBool stmCommitTransaction(Capability *cap, StgTRecHeader *trec) {
int result;
+
TRACE("%p : stmCommitTransaction()\n", trec);
ASSERT (trec != NO_TREC);
ASSERT (trec -> enclosing_trec == NO_TREC);
if (use_read_phase) {
TRACE("%p : doing read check\n", trec);
result = check_read_only(trec);
+ TRACE("%p : read-check %s\n", trec, result ? "succeeded" : "failed");
}
if (result) {
// at the end of the call to validate_and_acquire_ownership. This forms the
// linearization point of the commit.
- TRACE("%p : read-check succeeded\n", trec);
FOR_EACH_ENTRY(trec, e, {
StgTVar *s;
s = e -> tvar;
ACQ_ASSERT(tvar_is_locked(s, trec));
TRACE("%p : writing %p to %p, waking waiters\n", trec, e -> new_value, s);
- unpark_waiters_on(s);
- s -> last_update_by = trec;
+ unpark_waiters_on(cap,s);
+ IF_STM_FG_LOCKS({
+ s -> last_update_by = trec;
+ });
unlock_tvar(trec, s, e -> new_value, TRUE);
}
ACQ_ASSERT(!tvar_is_locked(s, trec));
/*......................................................................*/
-StgBool stmCommitNestedTransaction(StgRegTable *reg, StgTRecHeader *trec) {
+StgBool stmCommitNestedTransaction(Capability *cap, StgTRecHeader *trec) {
StgTRecHeader *et;
int result;
ASSERT (trec != NO_TREC && trec -> enclosing_trec != NO_TREC);
if (entry_is_update(e)) {
unlock_tvar(trec, s, e -> expected_value, FALSE);
}
- merge_update_into(reg, et, s, e -> expected_value, e -> new_value);
+ merge_update_into(cap, et, s, e -> expected_value, e -> new_value);
ACQ_ASSERT(s -> current_value != trec);
});
} else {
/*......................................................................*/
-StgBool stmWait(StgRegTable *reg, StgTSO *tso, StgTRecHeader *trec) {
+StgBool stmWait(Capability *cap, StgTSO *tso, StgTRecHeader *trec) {
int result;
TRACE("%p : stmWait(%p)\n", trec, tso);
ASSERT (trec != NO_TREC);
// Put ourselves to sleep. We retain locks on all the TVars involved
// until we are sound asleep : (a) on the wait queues, (b) BlockedOnSTM
// in the TSO, (c) TREC_WAITING in the Trec.
- build_wait_queue_entries_for_trec(reg, tso, trec);
+ build_wait_queue_entries_for_trec(cap, tso, trec);
park_tso(tso);
trec -> state = TREC_WAITING;
/*......................................................................*/
-StgClosure *stmReadTVar(StgRegTable *reg,
+StgClosure *stmReadTVar(Capability *cap,
StgTRecHeader *trec,
StgTVar *tvar) {
StgTRecHeader *entry_in;
result = entry -> new_value;
} else {
// Entry found in another trec
- TRecEntry *new_entry = get_new_entry(reg, trec);
+ TRecEntry *new_entry = get_new_entry(cap, trec);
new_entry -> tvar = tvar;
new_entry -> expected_value = entry -> expected_value;
new_entry -> new_value = entry -> new_value;
} else {
// No entry found
StgClosure *current_value = read_current_value(trec, tvar);
- TRecEntry *new_entry = get_new_entry(reg, trec);
+ TRecEntry *new_entry = get_new_entry(cap, trec);
new_entry -> tvar = tvar;
new_entry -> expected_value = current_value;
new_entry -> new_value = current_value;
/*......................................................................*/
-void stmWriteTVar(StgRegTable *reg,
+void stmWriteTVar(Capability *cap,
StgTRecHeader *trec,
StgTVar *tvar,
StgClosure *new_value) {
entry -> new_value = new_value;
} else {
// Entry found in another trec
- TRecEntry *new_entry = get_new_entry(reg, trec);
+ TRecEntry *new_entry = get_new_entry(cap, trec);
new_entry -> tvar = tvar;
new_entry -> expected_value = entry -> expected_value;
new_entry -> new_value = new_value;
} else {
// No entry found
StgClosure *current_value = read_current_value(trec, tvar);
- TRecEntry *new_entry = get_new_entry(reg, trec);
+ TRecEntry *new_entry = get_new_entry(cap, trec);
new_entry -> tvar = tvar;
new_entry -> expected_value = current_value;
new_entry -> new_value = new_value;
/*......................................................................*/
+StgTVar *stmNewTVar(Capability *cap,
+ StgClosure *new_value) {
+ StgTVar *result;
+ result = new_tvar(cap, new_value);
+ return result;
+}
+
+/*......................................................................*/
+
projects / ghc-hetmet.git / blobdiff