Commit f05e7d3f authored by simonmar's avatar simonmar
Browse files

[project @ 2002-10-18 09:51:03 by simonmar]

Add atomicModifyIORef, as discussed on the FFI list.
parent c7566eea
-----------------------------------------------------------------------
-- $Id: primops.txt.pp,v 1.21 2002/06/26 08:18:38 stolz Exp $
-- $Id: primops.txt.pp,v 1.22 2002/10/18 09:51:04 simonmar Exp $
--
-- Primitive Operations
--
......@@ -1274,6 +1274,18 @@ primop SameMutVarOp "sameMutVar#" GenPrimOp
with
usage = { mangle SameMutVarOp [mkP, mkP] mkM }
-- not really the right type, but we don't know about pairs here. The
-- correct type is
--
-- MutVar# s a -> (a -> (a,b)) -> State# s -> (# State# s, b #)
--
primop AtomicModifyMutVarOp "atomicModifyMutVar#" GenPrimOp
MutVar# s a -> (a -> b) -> State# s -> (# State# s, c #)
with
usage = { mangle AtomicModifyMutVarOp [mkP, mkM, mkP] mkM }
has_side_effects = True
out_of_line = True
------------------------------------------------------------------------
section "Exceptions"
------------------------------------------------------------------------
......
/* -----------------------------------------------------------------------------
* $Id: PrimOps.h,v 1.97 2002/09/06 14:34:14 simonmar Exp $
* $Id: PrimOps.h,v 1.98 2002/10/18 09:51:04 simonmar Exp $
*
* (c) The GHC Team, 1998-2000
*
......@@ -218,7 +218,7 @@ extern StgInt isFloatNegativeZero(StgFloat f);
-------------------------------------------------------------------------- */
EXTFUN_RTS(newMutVarzh_fast);
EXTFUN_RTS(atomicModifyMutVarzh_fast);
/* -----------------------------------------------------------------------------
MVar PrimOps.
......
/* -----------------------------------------------------------------------------
* $Id: PrimOps.hc,v 1.100 2002/07/17 09:21:50 simonmar Exp $
* $Id: PrimOps.hc,v 1.101 2002/10/18 09:51:03 simonmar Exp $
*
* (c) The GHC Team, 1998-2000
*
......@@ -350,6 +350,60 @@ FN_(newMutVarzh_fast)
FE_
}
FN_(atomicModifyMutVarzh_fast)
{
StgMutVar* mv;
StgClosure *z, *x, *y, *r;
FB_
/* Args: R1.p :: MutVar#, R2.p :: a -> (a,b) */
/* If x is the current contents of the MutVar#, then
We want to make the new contents point to
(sel_0 (f x))
and the return value is
(sel_1 (f x))
obviously we can share (f x).
z = [stg_ap_2 f x] (max (HS + 2) MIN_UPD_SIZE)
y = [stg_sel_0 z] (max (HS + 1) MIN_UPD_SIZE)
r = [stg_sel_1 z] (max (HS + 1) MIN_UPD_SIZE)
*/
#define THUNK_SIZE(n) (sizeofW(StgHeader) + stg_max((n), MIN_UPD_SIZE))
#define SIZE (THUNK_SIZE(2) + THUNK_SIZE(1) + THUNK_SIZE(1))
HP_CHK_GEN_TICKY(SIZE, R1_PTR|R2_PTR, atomicModifyMutVarzh_fast,);
CCS_ALLOC(CCCS,SIZE);
x = ((StgMutVar *)R1.cl)->var;
TICK_ALLOC_UP_THK(2,0); // XXX
z = (StgClosure *) Hp - THUNK_SIZE(2) + 1;
SET_HDR(z, &stg_ap_2_upd_info, CCCS);
z->payload[0] = R2.cl;
z->payload[1] = x;
TICK_ALLOC_UP_THK(1,1); // XXX
y = (StgClosure *) (StgPtr)z - THUNK_SIZE(1);
SET_HDR(y, &stg_sel_0_upd_info, CCCS);
y->payload[0] = z;
((StgMutVar *)R1.cl)->var = y;
TICK_ALLOC_UP_THK(1,1); // XXX
r = (StgClosure *) (StgPtr)y - THUNK_SIZE(1);
SET_HDR(r, &stg_sel_1_upd_info, CCCS);
r->payload[0] = z;
RET_P(r);
JMP_(ENTRY_CODE(Sp[0]));
FE_
}
/* -----------------------------------------------------------------------------
Foreign Object Primitives
-------------------------------------------------------------------------- */
......
Supports Markdown
0% or .
You are about to add 0 people to the discussion. Proceed with caution.
Finish editing this message first!
Please register or to comment