Commit 55472d77 authored by tharris's avatar tharris

[project @ 2005-05-27 14:47:08 by tharris]

Update STM implementation for SMP builds
parent 6a18febc
......@@ -327,6 +327,7 @@ typedef struct {
StgClosure* value;
} StgMVar;
/* STM data structures
*
* StgTVar defines the only type that can be updated through the STM
......@@ -354,8 +355,9 @@ typedef struct StgTVarWaitQueue_ {
typedef struct {
StgHeader header;
StgClosure *current_value;
StgTVarWaitQueue *first_wait_queue_entry;
StgClosure *volatile current_value;
StgTVarWaitQueue *volatile first_wait_queue_entry;
struct StgTRecHeader_ *volatile last_update_by;
} StgTVar;
/* new_value == expected_value for read-only accesses */
......@@ -364,6 +366,7 @@ typedef struct {
StgTVar *tvar;
StgClosure *expected_value;
StgClosure *new_value;
struct StgTRecHeader_ *saw_update_by;
} TRecEntry;
#define TREC_CHUNK_NUM_ENTRIES 256
......@@ -377,8 +380,7 @@ typedef struct StgTRecChunk_ {
typedef enum {
TREC_ACTIVE, /* Transaction in progress, outcome undecided */
TREC_CANNOT_COMMIT, /* Transaction in progress, inconsistent writes performed */
TREC_MUST_ABORT, /* Transaction in progress, inconsistent / out of date reads */
TREC_CONDEMNED, /* Transaction in progress, inconsistent / out of date reads */
TREC_COMMITTED, /* Transaction has committed, now updating tvars */
TREC_ABORTED, /* Transaction has aborted, now reverting tvars */
TREC_WAITING, /* Transaction currently waiting */
......
......@@ -22,6 +22,7 @@
#ifndef REGS_H
#define REGS_H
#include "gmp.h" // Needs MP_INT definition
/*
* This is the table that holds shadow-locations for all the STG
......@@ -90,6 +91,13 @@ typedef struct StgRegTable_ {
struct bdescr_ *rCurrentNursery; /* Hp/HpLim point into this block */
struct bdescr_ *rCurrentAlloc; /* for allocation using allocate() */
StgWord rHpAlloc; /* number of *bytes* being allocated in heap */
// rmp_tmp1..rmp_result2 are only used in SMP builds to avoid per-thread temps
// in bss, but currently always incldue here so we just run mkDerivedConstants once
StgInt rmp_tmp_w;
MP_INT rmp_tmp1;
MP_INT rmp_tmp2;
MP_INT rmp_result1;
MP_INT rmp_result2;
#if defined(SMP) || defined(PAR)
StgSparkPool rSparks; /* per-task spark pool */
#endif
......
......@@ -26,6 +26,9 @@
/*
* XCHG - the atomic exchange instruction. Used for locking closures
* during updates (see LOCK_CLOSURE below) and the MVar primops.
*
* NB: the xchg instruction is implicitly locked, so we do not need
* a lock prefix here.
*/
INLINE_HEADER StgWord
xchg(StgPtr p, StgWord w)
......@@ -40,6 +43,20 @@ xchg(StgPtr p, StgWord w)
return result;
}
/*
* CMPXCHG - the single-word atomic compare-and-exchange instruction. Used
* in the STM implementation.
*/
INLINE_HEADER StgWord
cas(StgVolatilePtr p, StgWord o, StgWord n)
{
__asm__ __volatile__ (
"lock cmpxchg %3,%1"
:"=a"(o), "=m" (*(volatile unsigned int *)p)
:"0" (o), "r" (n));
return o;
}
INLINE_HEADER StgInfoTable *
lockClosure(StgClosure *p)
{
......
......@@ -8,60 +8,38 @@
STM.h defines the C-level interface to the STM.
The interface is designed so that all of the operations return
directly: if the specified StgTSO should block then the Haskell
scheduler's data structures are updated within the STM
implementation, rather than blocking the native thread.
The design follows that of the PPoPP 2005 paper "Composable memory
transactions" extended to include fine-grained locking of TVars.
This interface can be supported by many different implementations,
in particular it is left unspecified:
- Whether nested transactions are fully supported.
Three different implementations can be built. In overview:
STM_UNIPROC -- no locking at all: not safe for concurrent invocations
A simple implementation would count the number of
stmStartTransaction operations that a thread invokes and only
attempt to really commit it to the heap when the corresponding
number of stmCommitTransaction calls have been made. This
prevents enclosed transactions from being aborted without also
aborting all of the outer ones.
STM_CG_LOCK -- coarse-grained locking : a single mutex protects all
TVars
The current implementation does support proper nesting.
- Whether stmWait and stmReWait are blocking.
A simple implementation would always return 'false' from these
operations, signalling that the calling thread should immediately
retry its transaction.
A fuller implementation would block the thread and return 'True'
when it is safe for the thread to block.
The current implementation does provide stmWait and stmReWait
operations which can block the caller's TSO.
- Whether the transactional read, write, commit and validate
operations are blocking or non-blocking.
A simple implementation would use an internal lock to prevent
concurrent execution of any STM operations. (This does not
prevent multiple threads having concurrent transactions, merely
the concurrent execution of say stmCommitTransaction by two
threads at the same time).
STM_FG_LOCKS -- per-TVar exclusion : each TVar can be owned by at
most one TRec at any time. This allows dynamically
non-conflicting transactions to commit in parallel.
The implementation treats reads optimisitcally --
extra versioning information is retained in the
saw_update_by field of the TVars so that they do not
need to be locked for reading.
A fuller implementation would offer obstruction-free or lock-free
progress guarantees, as in our OOPSLA 2003 paper.
STM.C contains more details about the locking schemes used.
The current implementation is lock-free for simple uncontended
operations, but uses an internal lock on SMP systems in some
cases. This aims to provide good performance on uniprocessors:
it substantially streamlines the design, when compared with the
OOPSLA paper, and on a uniprocessor we can be sure that threads
are never pre-empted within STM operations.
*/
#ifndef STM_H
#define STM_H
#ifdef SMP
//#define STM_CG_LOCK
#define STM_FG_LOCKS
#else
#define STM_UNIPROC
#endif
#ifdef __cplusplus
extern "C" {
#endif
......@@ -86,7 +64,9 @@ extern void stmPreGCHook(void);
/* Create and enter a new transaction context */
extern StgTRecHeader *stmStartTransaction(StgTRecHeader *outer);
extern StgTRecHeader *stmStartTransaction(StgRegTable *reg, StgTRecHeader *outer);
extern StgTRecHeader *stmStartNestedTransaction(StgRegTable *reg, StgTRecHeader *outer
);
/*
* Exit the current transaction context, abandoning any read/write
......@@ -118,16 +98,36 @@ extern StgTRecHeader *stmGetEnclosingTRec(StgTRecHeader *trec);
/*----------------------------------------------------------------------
Validate/commit/wait/rewait operations
--------------------------------------
Validation
----------
Test whether the specified transaction record, and all those within which
it is nested, are still valid.
Note: the caller can assume that once stmValidateTransaction has
returned FALSE for a given trec then that transaction will never
again be valid -- we rely on this in Schedule.c when kicking invalid
threads at GC (in case they are stuck looping)
*/
extern StgBool stmValidateNestOfTransactions(StgTRecHeader *trec);
/*----------------------------------------------------------------------
Commit/wait/rewait operations
-----------------------------
These four operations return boolean results which should be interpreted
as follows:
true => The transaction context was definitely valid
true => The transaction record was definitely valid
false => The transaction record may not have been valid
false => The transaction context may not have been valid
Note that, for nested operations, validity here is solely in terms
of the specified trec: it does not say whether those that it may be
nested are themselves valid. Callers can check this with
stmValidateNestOfTransactions.
The user of the STM should ensure that it is always safe to assume that a
transaction context is not valid when in fact it is (i.e. to return false in
......@@ -151,16 +151,6 @@ extern StgTRecHeader *stmGetEnclosingTRec(StgTRecHeader *trec);
is actually still valid.
*/
/*
* Test whether the current transaction context is valid, i.e. whether
* it is still possible for it to commit successfully. Note: we assume that
* once stmValidateTransaction has returned FALSE for a given transaction then
* that transaction will never again be valid -- we rely on this in Schedule.c when
* kicking invalid threads at GC (in case they are stuck looping)
*/
extern StgBool stmValidateTransaction(StgTRecHeader *trec);
/*
* Test whether the current transaction context is valid and, if so,
* commit its memory accesses to the heap. stmCommitTransaction must
......@@ -168,7 +158,8 @@ extern StgBool stmValidateTransaction(StgTRecHeader *trec);
* been committed to.
*/
extern StgBool stmCommitTransaction(StgTRecHeader *trec);
extern StgBool stmCommitTransaction(StgRegTable *reg, StgTRecHeader *trec);
extern StgBool stmCommitNestedTransaction(StgRegTable *reg, StgTRecHeader *trec);
/*
* Test whether the current transaction context is valid and, if so,
......@@ -177,7 +168,9 @@ extern StgBool stmCommitTransaction(StgTRecHeader *trec);
* if the thread is already waiting.
*/
extern StgBool stmWait(StgTSO *tso, StgTRecHeader *trec);
extern StgBool stmWait(StgRegTable *reg,
StgTSO *tso,
StgTRecHeader *trec);
/*
* Test whether the current transaction context is valid and, if so,
......@@ -189,16 +182,6 @@ extern StgBool stmWait(StgTSO *tso, StgTRecHeader *trec);
extern StgBool stmReWait(StgTSO *tso);
/*
* Merge the accesses made so far in the second trec into the first trec.
* Note that the resulting trec is only intended to be used in wait operations.
* This avoids defining what happens if "trec" and "other" contain conflicting
* updates.
*/
extern StgBool stmMergeForWaiting(StgTRecHeader *trec, StgTRecHeader *other);
/*----------------------------------------------------------------------
Data access operations
......@@ -210,14 +193,16 @@ extern StgBool stmMergeForWaiting(StgTRecHeader *trec, StgTRecHeader *other);
* thread's current transaction.
*/
extern StgClosure *stmReadTVar(StgTRecHeader *trec,
extern StgClosure *stmReadTVar(StgRegTable *reg,
StgTRecHeader *trec,
StgTVar *tvar);
/* Update the logical contents of 'tvar' within the context of the
* thread's current transaction.
*/
extern void stmWriteTVar(StgTRecHeader *trec,
extern void stmWriteTVar(StgRegTable *reg,
StgTRecHeader *trec,
StgTVar *tvar,
StgClosure *new_value);
......
......@@ -114,6 +114,7 @@ typedef void StgVoid;
typedef struct StgClosure_ StgClosure;
typedef StgClosure* StgClosurePtr;
typedef StgWord* StgPtr; /* pointer into closure */
typedef StgWord volatile* StgVolatilePtr; /* pointer to volatile word */
typedef StgWord StgOffset; /* byte offset within closure */
typedef struct StgTSO_* StgTSOPtr;
......
......@@ -241,6 +241,13 @@ main(int argc, char *argv[])
field_offset(StgRegTable, rCurrentNursery);
field_offset(StgRegTable, rHpAlloc);
// Needed for SMP builds
field_offset(StgRegTable, rmp_tmp_w);
field_offset(StgRegTable, rmp_tmp1);
field_offset(StgRegTable, rmp_tmp2);
field_offset(StgRegTable, rmp_result1);
field_offset(StgRegTable, rmp_result2);
def_offset("stgGCEnter1", FUN_OFFSET(stgGCEnter1));
def_offset("stgGCFun", FUN_OFFSET(stgGCFun));
......@@ -370,6 +377,7 @@ main(int argc, char *argv[])
closure_size(StgTVar);
closure_field(StgTVar,current_value);
closure_field(StgTVar,first_wait_queue_entry);
closure_field(StgTVar,last_update_by);
closure_size(StgBCO);
closure_field(StgBCO, instrs);
......
......@@ -345,7 +345,7 @@ retry_pop_stack:
W_ trec;
W_ r;
trec = StgTSO_trec(CurrentTSO);
r = foreign "C" stmValidateTransaction(trec "ptr");
r = foreign "C" stmValidateNestOfTransactions(trec "ptr");
foreign "C" stmAbortTransaction(trec "ptr");
StgTSO_trec(CurrentTSO) = NO_TREC;
if (r) {
......@@ -355,7 +355,7 @@ retry_pop_stack:
} else {
// Transaction was not valid: we retry the exception (otherwise continue
// with a further call to raiseExceptionHelper)
"ptr" trec = foreign "C" stmStartTransaction(NO_TREC "ptr");
"ptr" trec = foreign "C" stmStartTransaction(BaseReg "ptr", NO_TREC "ptr");
StgTSO_trec(CurrentTSO) = trec;
R1 = StgAtomicallyFrame_code(Sp);
Sp_adj(-1);
......
......@@ -2871,6 +2871,7 @@ scavenge(step *stp)
evac_gen = 0;
tvar->current_value = evacuate((StgClosure*)tvar->current_value);
tvar->first_wait_queue_entry = (StgTVarWaitQueue *)evacuate((StgClosure*)tvar->first_wait_queue_entry);
tvar->last_update_by = (StgTRecHeader *)evacuate((StgClosure*)tvar->last_update_by);
evac_gen = saved_evac_gen;
failed_to_evac = rtsTrue; // mutable
p += sizeofW(StgTVar);
......@@ -3216,6 +3217,7 @@ linear_scan:
evac_gen = 0;
tvar->current_value = evacuate((StgClosure*)tvar->current_value);
tvar->first_wait_queue_entry = (StgTVarWaitQueue *)evacuate((StgClosure*)tvar->first_wait_queue_entry);
tvar->last_update_by = (StgTRecHeader *)evacuate((StgClosure*)tvar->last_update_by);
evac_gen = saved_evac_gen;
failed_to_evac = rtsTrue; // mutable
break;
......@@ -3528,6 +3530,7 @@ scavenge_one(StgPtr p)
evac_gen = 0;
tvar->current_value = evacuate((StgClosure*)tvar->current_value);
tvar->first_wait_queue_entry = (StgTVarWaitQueue *)evacuate((StgClosure*)tvar->first_wait_queue_entry);
tvar->last_update_by = (StgTRecHeader *)evacuate((StgClosure*)tvar->last_update_by);
evac_gen = saved_evac_gen;
failed_to_evac = rtsTrue; // mutable
break;
......
......@@ -675,6 +675,7 @@ thread_obj (StgInfoTable *info, StgPtr p)
StgTVar *tvar = (StgTVar *)p;
thread((StgPtr)&tvar->current_value);
thread((StgPtr)&tvar->first_wait_queue_entry);
thread((StgPtr)&tvar->last_update_by);
return p + sizeofW(StgTVar);
}
......
......@@ -527,6 +527,7 @@ word64ToIntegerzh_fast
/* ToDo: this is shockingly inefficient */
#ifndef SMP
section "bss" {
mp_tmp1:
bits8 [SIZEOF_MP_INT];
......@@ -538,101 +539,120 @@ section "bss" {
}
section "bss" {
result1:
mp_result1:
bits8 [SIZEOF_MP_INT];
}
section "bss" {
result2:
mp_result2:
bits8 [SIZEOF_MP_INT];
}
#endif
#define GMP_TAKE2_RET1(name,mp_fun) \
name \
{ \
CInt s1, s2; \
W_ d1, d2; \
\
/* call doYouWantToGC() */ \
MAYBE_GC(R2_PTR & R4_PTR, name); \
\
s1 = W_TO_INT(R1); \
d1 = R2; \
s2 = W_TO_INT(R3); \
d2 = R4; \
\
MP_INT__mp_alloc(mp_tmp1) = W_TO_INT(StgArrWords_words(d1)); \
MP_INT__mp_size(mp_tmp1) = (s1); \
MP_INT__mp_d(mp_tmp1) = BYTE_ARR_CTS(d1); \
MP_INT__mp_alloc(mp_tmp2) = W_TO_INT(StgArrWords_words(d2)); \
MP_INT__mp_size(mp_tmp2) = (s2); \
MP_INT__mp_d(mp_tmp2) = BYTE_ARR_CTS(d2); \
\
foreign "C" mpz_init(result1); \
\
/* Perform the operation */ \
foreign "C" mp_fun(result1,mp_tmp1,mp_tmp2); \
\
RET_NP(TO_W_(MP_INT__mp_size(result1)), \
MP_INT__mp_d(result1) - SIZEOF_StgArrWords); \
}
#define GMP_TAKE1_RET1(name,mp_fun) \
name \
{ \
CInt s1; \
W_ d1; \
\
/* call doYouWantToGC() */ \
MAYBE_GC(R2_PTR, name); \
\
d1 = R2; \
s1 = W_TO_INT(R1); \
\
MP_INT__mp_alloc(mp_tmp1) = W_TO_INT(StgArrWords_words(d1)); \
MP_INT__mp_size(mp_tmp1) = (s1); \
MP_INT__mp_d(mp_tmp1) = BYTE_ARR_CTS(d1); \
\
foreign "C" mpz_init(result1); \
\
/* Perform the operation */ \
foreign "C" mp_fun(result1,mp_tmp1); \
\
RET_NP(TO_W_(MP_INT__mp_size(result1)), \
MP_INT__mp_d(result1) - SIZEOF_StgArrWords); \
}
#ifdef SMP
#define FETCH_MP_TEMP(X) \
W_ X; \
X = BaseReg + (OFFSET_StgRegTable_r ## X);
#else
#define FETCH_MP_TEMP(X) /* Nothing */
#endif
#define GMP_TAKE2_RET2(name,mp_fun) \
name \
{ \
CInt s1, s2; \
W_ d1, d2; \
\
/* call doYouWantToGC() */ \
MAYBE_GC(R2_PTR & R4_PTR, name); \
\
s1 = W_TO_INT(R1); \
d1 = R2; \
s2 = W_TO_INT(R3); \
d2 = R4; \
\
MP_INT__mp_alloc(mp_tmp1) = W_TO_INT(StgArrWords_words(d1)); \
MP_INT__mp_size(mp_tmp1) = (s1); \
MP_INT__mp_d(mp_tmp1) = BYTE_ARR_CTS(d1); \
MP_INT__mp_alloc(mp_tmp2) = W_TO_INT(StgArrWords_words(d2)); \
MP_INT__mp_size(mp_tmp2) = (s2); \
MP_INT__mp_d(mp_tmp2) = BYTE_ARR_CTS(d2); \
\
foreign "C" mpz_init(result1); \
foreign "C" mpz_init(result2); \
\
/* Perform the operation */ \
foreign "C" mp_fun(result1,result2,mp_tmp1,mp_tmp2); \
\
RET_NPNP(TO_W_(MP_INT__mp_size(result1)), \
MP_INT__mp_d(result1) - SIZEOF_StgArrWords, \
TO_W_(MP_INT__mp_size(result2)), \
MP_INT__mp_d(result2) - SIZEOF_StgArrWords); \
#define GMP_TAKE2_RET1(name,mp_fun) \
name \
{ \
CInt s1, s2; \
W_ d1, d2; \
FETCH_MP_TEMP(mp_tmp1); \
FETCH_MP_TEMP(mp_tmp2); \
FETCH_MP_TEMP(mp_result1) \
FETCH_MP_TEMP(mp_result2); \
\
/* call doYouWantToGC() */ \
MAYBE_GC(R2_PTR & R4_PTR, name); \
\
s1 = W_TO_INT(R1); \
d1 = R2; \
s2 = W_TO_INT(R3); \
d2 = R4; \
\
MP_INT__mp_alloc(mp_tmp1) = W_TO_INT(StgArrWords_words(d1)); \
MP_INT__mp_size(mp_tmp1) = (s1); \
MP_INT__mp_d(mp_tmp1) = BYTE_ARR_CTS(d1); \
MP_INT__mp_alloc(mp_tmp2) = W_TO_INT(StgArrWords_words(d2)); \
MP_INT__mp_size(mp_tmp2) = (s2); \
MP_INT__mp_d(mp_tmp2) = BYTE_ARR_CTS(d2); \
\
foreign "C" mpz_init(mp_result1 "ptr"); \
\
/* Perform the operation */ \
foreign "C" mp_fun(mp_result1 "ptr",mp_tmp1 "ptr",mp_tmp2 "ptr"); \
\
RET_NP(TO_W_(MP_INT__mp_size(mp_result1)), \
MP_INT__mp_d(mp_result1) - SIZEOF_StgArrWords); \
}
#define GMP_TAKE1_RET1(name,mp_fun) \
name \
{ \
CInt s1; \
W_ d1; \
FETCH_MP_TEMP(mp_tmp1); \
FETCH_MP_TEMP(mp_result1) \
\
/* call doYouWantToGC() */ \
MAYBE_GC(R2_PTR, name); \
\
d1 = R2; \
s1 = W_TO_INT(R1); \
\
MP_INT__mp_alloc(mp_tmp1) = W_TO_INT(StgArrWords_words(d1)); \
MP_INT__mp_size(mp_tmp1) = (s1); \
MP_INT__mp_d(mp_tmp1) = BYTE_ARR_CTS(d1); \
\
foreign "C" mpz_init(mp_result1 "ptr"); \
\
/* Perform the operation */ \
foreign "C" mp_fun(mp_result1 "ptr",mp_tmp1 "ptr"); \
\
RET_NP(TO_W_(MP_INT__mp_size(mp_result1)), \
MP_INT__mp_d(mp_result1) - SIZEOF_StgArrWords); \
}
#define GMP_TAKE2_RET2(name,mp_fun) \
name \
{ \
CInt s1, s2; \
W_ d1, d2; \
FETCH_MP_TEMP(mp_tmp1); \
FETCH_MP_TEMP(mp_tmp2); \
FETCH_MP_TEMP(mp_result1) \
FETCH_MP_TEMP(mp_result2) \
\
/* call doYouWantToGC() */ \
MAYBE_GC(R2_PTR & R4_PTR, name); \
\
s1 = W_TO_INT(R1); \
d1 = R2; \
s2 = W_TO_INT(R3); \
d2 = R4; \
\
MP_INT__mp_alloc(mp_tmp1) = W_TO_INT(StgArrWords_words(d1)); \
MP_INT__mp_size(mp_tmp1) = (s1); \
MP_INT__mp_d(mp_tmp1) = BYTE_ARR_CTS(d1); \
MP_INT__mp_alloc(mp_tmp2) = W_TO_INT(StgArrWords_words(d2)); \
MP_INT__mp_size(mp_tmp2) = (s2); \
MP_INT__mp_d(mp_tmp2) = BYTE_ARR_CTS(d2); \
\
foreign "C" mpz_init(mp_result1 "ptr"); \
foreign "C" mpz_init(mp_result2 "ptr"); \
\
/* Perform the operation */ \
foreign "C" mp_fun(mp_result1 "ptr",mp_result2 "ptr",mp_tmp1 "ptr",mp_tmp2 "ptr"); \
\
RET_NPNP(TO_W_(MP_INT__mp_size(mp_result1)), \
MP_INT__mp_d(mp_result1) - SIZEOF_StgArrWords, \
TO_W_(MP_INT__mp_size(mp_result2)), \
MP_INT__mp_d(mp_result2) - SIZEOF_StgArrWords); \
}
GMP_TAKE2_RET1(plusIntegerzh_fast, mpz_add)
......@@ -650,17 +670,20 @@ GMP_TAKE1_RET1(complementIntegerzh_fast, mpz_com)
GMP_TAKE2_RET2(quotRemIntegerzh_fast, mpz_tdiv_qr)
GMP_TAKE2_RET2(divModIntegerzh_fast, mpz_fdiv_qr)
#ifndef SMP
section "bss" {
aa: W_; // NB. aa is really an mp_limb_t
mp_tmp_w: W_; // NB. mp_tmp_w is really an here mp_limb_t
}
#endif
gcdIntzh_fast
{
/* R1 = the first Int#; R2 = the second Int# */
W_ r;
FETCH_MP_TEMP(mp_tmp_w);
W_[aa] = R1;
r = foreign "C" mpn_gcd_1(aa, 1, R2);
W_[mp_tmp_w] = R1;
r = foreign "C" mpn_gcd_1(mp_tmp_w "ptr", 1, R2);
R1 = r;
/* Result parked in R1, return via info-pointer at TOS */
......@@ -806,14 +829,12 @@ integer2Wordzh_fast
jump %ENTRY_CODE(Sp(0));
}
section "bss" {
exponent: W_;
}
decodeFloatzh_fast
{
W_ p;
F_ arg;
FETCH_MP_TEMP(mp_tmp1);
FETCH_MP_TEMP(mp_tmp_w);
/* arguments: F1 = Float# */
arg = F1;
......@@ -828,10 +849,10 @@ decodeFloatzh_fast
MP_INT__mp_d(mp_tmp1) = BYTE_ARR_CTS(p);
/* Perform the operation */
foreign "C" __decodeFloat(mp_tmp1,exponent,arg);
foreign "C" __decodeFloat(mp_tmp1 "ptr",mp_tmp_w "ptr" ,arg);
/* returns: (Int# (expn), Int#, ByteArray#) */
RET_NNP(W_[exponent], TO_W_(MP_INT__mp_size(mp_tmp1)), p);
RET_NNP(W_[mp_tmp_w], TO_W_(MP_INT__mp_size(mp_tmp1)), p);
}
#define DOUBLE_MANTISSA_SIZE SIZEOF_DOUBLE
......@@ -841,6 +862,8 @@ decodeDoublezh_fast
{
D_ arg;
W_ p;
FETCH_MP_TEMP(mp_tmp1);
FETCH_MP_TEMP(mp_tmp_w);
/* arguments: D1 = Double# */
arg = D1;
......@@ -855,10 +878,10 @@ decodeDoublezh_fast
MP_INT__mp_d(mp_tmp1) = BYTE_ARR_CTS(p);
/* Perform the operation */
foreign "C" __decodeDouble(mp_tmp1,exponent,arg);
foreign "C" __decodeDouble(mp_tmp1 "ptr", mp_tmp_w "ptr",arg);
/* returns: (Int# (expn), Int#, ByteArray#) */
RET_NNP(W_[exponent], TO_W_(MP_INT__mp_size(mp_tmp1)), p);
RET_NNP(W_[mp_tmp_w], TO_W_(MP_INT__mp_size(mp_tmp1)), p);
}
/* -----------------------------------------------------------------------------
......@@ -969,7 +992,7 @@ INFO_TABLE_RET(stg_catch_retry_frame,
frame = Sp;
trec = StgTSO_trec(CurrentTSO);
"ptr" outer = foreign "C" stmGetEnclosingTRec(trec "ptr");
r = foreign "C" stmCommitTransaction(trec "ptr");
r = foreign "C" stmCommitNestedTransaction(BaseReg "ptr", trec "ptr");
if (r) {
/* Succeeded (either first branch or second branch) */
StgTSO_trec(CurrentT