StablePtr.c 10.8 KB
Newer Older
1 2
/* -*- tab-width: 4 -*- */

3 4
/* -----------------------------------------------------------------------------
 *
5
 * (c) The GHC Team, 1998-2002
6
 *
David Feuer's avatar
David Feuer committed
7
 * Stable pointers
8 9 10
 *
 * ---------------------------------------------------------------------------*/

11
#include "PosixSource.h"
12
#include "Rts.h"
Simon Marlow's avatar
Simon Marlow committed
13 14
#include "RtsAPI.h"

15
#include "Hash.h"
Ben Gamari's avatar
Ben Gamari committed
16
#include "LongPause.h"
17
#include "RtsUtils.h"
Simon Marlow's avatar
Simon Marlow committed
18
#include "Trace.h"
David Feuer's avatar
David Feuer committed
19
#include "StablePtr.h"
20

21 22
#include <string.h>

23 24 25 26 27 28 29 30 31 32 33 34 35 36 37 38 39 40 41 42 43 44 45 46 47 48 49 50 51 52 53 54 55 56 57 58 59 60
/* Comment from ADR's implementation in old RTS:

  This files (together with @ghc/runtime/storage/PerformIO.lhc@ and a
  small change in @HpOverflow.lc@) consists of the changes in the
  runtime system required to implement "Stable Pointers". But we're
  getting a bit ahead of ourselves --- what is a stable pointer and what
  is it used for?

  When Haskell calls C, it normally just passes over primitive integers,
  floats, bools, strings, etc.  This doesn't cause any problems at all
  for garbage collection because the act of passing them makes a copy
  from the heap, stack or wherever they are onto the C-world stack.
  However, if we were to pass a heap object such as a (Haskell) @String@
  and a garbage collection occured before we finished using it, we'd run
  into problems since the heap object might have been moved or even
  deleted.

  So, if a C call is able to cause a garbage collection or we want to
  store a pointer to a heap object between C calls, we must be careful
  when passing heap objects. Our solution is to keep a table of all
  objects we've given to the C-world and to make sure that the garbage
  collector collects these objects --- updating the table as required to
  make sure we can still find the object.


  Of course, all this rather begs the question: why would we want to
  pass a boxed value?

  One very good reason is to preserve laziness across the language
  interface. Rather than evaluating an integer or a string because it
  {\em might\/} be required by the C function, we can wait until the C
  function actually wants the value and then force an evaluation.

  Another very good reason (the motivating reason!) is that the C code
  might want to execute an object of sort $IO ()$ for the side-effects
  it will produce. For example, this is used when interfacing to an X
  widgets library to allow a direct implementation of callbacks.

61 62 63 64 65
  One final reason is that we may want to store composite Haskell
  values in data structures implemented in the C side. Serializing and
  deserializing these structures into unboxed form suitable for C may
  be more expensive than maintaining the extra layer of indirection of
  stable pointers.
66 67 68 69 70 71 72 73 74

  The @makeStablePointer :: a -> IO (StablePtr a)@ function
  converts a value into a stable pointer.  It is part of the @PrimIO@
  monad, because we want to be sure we don't allocate one twice by
  accident, and then only free one of the copies.

  \begin{verbatim}
  makeStablePtr#  :: a -> State# RealWorld -> (# RealWorld, a #)
  freeStablePtr#  :: StablePtr# a -> State# RealWorld -> State# RealWorld
75
  deRefStablePtr# :: StablePtr# a -> State# RealWorld ->
76 77 78 79 80 81
        (# State# RealWorld, a #)
  \end{verbatim}

  There may be additional functions on the C side to allow evaluation,
  application, etc of a stable pointer.

82 83 84 85 86 87 88
  Stable Pointers are exported to the outside world as indices and not
  pointers, because the stable pointer table is allowed to be
  reallocated for growth. The table is never shrunk for its space to
  be reclaimed.

  Future plans for stable ptrs include distinguishing them by the
  generation of the pointed object. See
89
  https://gitlab.haskell.org/ghc/ghc/issues/7670 for details.
90 91
*/

92 93
spEntry *stable_ptr_table = NULL;
static spEntry *stable_ptr_free = NULL;
94
static unsigned int SPT_size = 0;
95
#define INIT_SPT_SIZE 64
96

97 98 99 100 101 102 103 104 105 106 107 108 109 110 111
/* Each time the stable pointer table is enlarged, we temporarily retain the old
 * version to ensure dereferences are thread-safe (see Note [Enlarging the
 * stable pointer table]).  Since we double the size of the table each time, we
 * can (theoretically) enlarge it at most N times on an N-bit machine.  Thus,
 * there will never be more than N old versions of the table.
 */
#if SIZEOF_VOID_P == 4
#define MAX_N_OLD_SPTS 32
#elif SIZEOF_VOID_P == 8
#define MAX_N_OLD_SPTS 64
#else
#error unknown SIZEOF_VOID_P
#endif

static spEntry *old_SPTs[MAX_N_OLD_SPTS];
112
static uint32_t n_old_SPTs = 0;
113

Ben Gamari's avatar
Ben Gamari committed
114
#if defined(THREADED_RTS)
David Feuer's avatar
David Feuer committed
115
Mutex stable_ptr_mutex;
116
#endif
117

Simon Marlow's avatar
Simon Marlow committed
118 119
static void enlargeStablePtrTable(void);

Simon Marlow's avatar
Simon Marlow committed
120 121 122 123 124 125
/* -----------------------------------------------------------------------------
 * We must lock the StablePtr table during GC, to prevent simultaneous
 * calls to freeStablePtr().
 * -------------------------------------------------------------------------- */

void
David Feuer's avatar
David Feuer committed
126
stablePtrLock(void)
Simon Marlow's avatar
Simon Marlow committed
127
{
David Feuer's avatar
David Feuer committed
128
    initStablePtrTable();
Ben Gamari's avatar
Ben Gamari committed
129
    ACQUIRE_LOCK_CHECKED(&stable_ptr_mutex, "stable_ptr_mutex");
Simon Marlow's avatar
Simon Marlow committed
130 131 132
}

void
David Feuer's avatar
David Feuer committed
133
stablePtrUnlock(void)
Simon Marlow's avatar
Simon Marlow committed
134
{
David Feuer's avatar
David Feuer committed
135
    RELEASE_LOCK(&stable_ptr_mutex);
Simon Marlow's avatar
Simon Marlow committed
136 137 138
}

/* -----------------------------------------------------------------------------
David Feuer's avatar
David Feuer committed
139
 * Initialising the table
Simon Marlow's avatar
Simon Marlow committed
140 141
 * -------------------------------------------------------------------------- */

142
STATIC_INLINE void
143
initSpEntryFreeList(spEntry *table, uint32_t n, spEntry *free)
144 145 146 147 148 149
{
  spEntry *p;
  for (p = table + n - 1; p >= table; p--) {
      p->addr = (P_)free;
      free = p;
  }
150 151 152 153
  stable_ptr_free = table;
}

void
David Feuer's avatar
David Feuer committed
154
initStablePtrTable(void)
155
{
156 157
    if (SPT_size > 0) return;
    SPT_size = INIT_SPT_SIZE;
158
    stable_ptr_table = stgMallocBytes(SPT_size * sizeof(spEntry),
159 160 161
                                      "initStablePtrTable");
    initSpEntryFreeList(stable_ptr_table,INIT_SPT_SIZE,NULL);

Ben Gamari's avatar
Ben Gamari committed
162
#if defined(THREADED_RTS)
David Feuer's avatar
David Feuer committed
163
    initMutex(&stable_ptr_mutex);
164
#endif
165 166
}

Simon Marlow's avatar
Simon Marlow committed
167
/* -----------------------------------------------------------------------------
David Feuer's avatar
David Feuer committed
168
 * Enlarging the table
Simon Marlow's avatar
Simon Marlow committed
169 170
 * -------------------------------------------------------------------------- */

David Feuer's avatar
David Feuer committed
171
// Must be holding stable_ptr_mutex
Simon Marlow's avatar
Simon Marlow committed
172 173 174
static void
enlargeStablePtrTable(void)
{
175
    uint32_t old_SPT_size = SPT_size;
176
    spEntry *new_stable_ptr_table;
Simon Marlow's avatar
Simon Marlow committed
177 178 179

    // 2nd and subsequent times
    SPT_size *= 2;
180 181 182 183 184

    /* We temporarily retain the old version instead of freeing it; see Note
     * [Enlarging the stable pointer table].
     */
    new_stable_ptr_table =
185
        stgMallocBytes(SPT_size * sizeof(spEntry),
186 187 188
                       "enlargeStablePtrTable");
    memcpy(new_stable_ptr_table,
           stable_ptr_table,
189
           old_SPT_size * sizeof(spEntry));
190 191 192 193 194 195 196 197
    ASSERT(n_old_SPTs < MAX_N_OLD_SPTS);
    old_SPTs[n_old_SPTs++] = stable_ptr_table;

    /* When using the threaded RTS, the update of stable_ptr_table is assumed to
     * be atomic, so that another thread simultaneously dereferencing a stable
     * pointer will always read a valid address.
     */
    stable_ptr_table = new_stable_ptr_table;
Simon Marlow's avatar
Simon Marlow committed
198 199 200 201

    initSpEntryFreeList(stable_ptr_table + old_SPT_size, old_SPT_size, NULL);
}

202 203 204 205 206 207 208 209 210 211 212 213 214 215 216 217
/* Note [Enlarging the stable pointer table]
 *
 * To enlarge the stable pointer table, we allocate a new table, copy the
 * existing entries, and then store the old version of the table in old_SPTs
 * until we free it during GC.  By not immediately freeing the old version
 * (or equivalently by not growing the table using realloc()), we ensure that
 * another thread simultaneously dereferencing a stable pointer using the old
 * version can safely access the table without causing a segfault (see Trac
 * #10296).
 *
 * Note that because the stable pointer table is doubled in size each time it is
 * enlarged, the total memory needed to store the old versions is always less
 * than that required to hold the current version.
 */


Simon Marlow's avatar
Simon Marlow committed
218 219 220 221
/* -----------------------------------------------------------------------------
 * Freeing entries and tables
 * -------------------------------------------------------------------------- */

222 223 224
static void
freeOldSPTs(void)
{
225
    uint32_t i;
226 227 228 229 230 231 232

    for (i = 0; i < n_old_SPTs; i++) {
        stgFree(old_SPTs[i]);
    }
    n_old_SPTs = 0;
}

233
void
David Feuer's avatar
David Feuer committed
234
exitStablePtrTable(void)
235
{
236 237 238 239 240
    if (stable_ptr_table)
        stgFree(stable_ptr_table);
    stable_ptr_table = NULL;
    SPT_size = 0;

241 242
    freeOldSPTs();

Ben Gamari's avatar
Ben Gamari committed
243
#if defined(THREADED_RTS)
David Feuer's avatar
David Feuer committed
244
    closeMutex(&stable_ptr_mutex);
245
#endif
246 247
}

Simon Marlow's avatar
Simon Marlow committed
248 249 250 251 252 253 254 255 256 257 258 259 260 261 262 263 264
STATIC_INLINE void
freeSpEntry(spEntry *sp)
{
    sp->addr = (P_)stable_ptr_free;
    stable_ptr_free = sp;
}

void
freeStablePtrUnsafe(StgStablePtr sp)
{
    ASSERT((StgWord)sp < SPT_size);
    freeSpEntry(&stable_ptr_table[(StgWord)sp]);
}

void
freeStablePtr(StgStablePtr sp)
{
David Feuer's avatar
David Feuer committed
265
    stablePtrLock();
Simon Marlow's avatar
Simon Marlow committed
266
    freeStablePtrUnsafe(sp);
David Feuer's avatar
David Feuer committed
267
    stablePtrUnlock();
Simon Marlow's avatar
Simon Marlow committed
268 269 270 271 272 273
}

/* -----------------------------------------------------------------------------
 * Looking up
 * -------------------------------------------------------------------------- */

274 275 276
StgStablePtr
getStablePtr(StgPtr p)
{
277
  StgWord sp;
278

David Feuer's avatar
David Feuer committed
279
  stablePtrLock();
280 281 282 283
  if (!stable_ptr_free) enlargeStablePtrTable();
  sp = stable_ptr_free - stable_ptr_table;
  stable_ptr_free  = (spEntry*)(stable_ptr_free->addr);
  stable_ptr_table[sp].addr = p;
David Feuer's avatar
David Feuer committed
284
  stablePtrUnlock();
285
  return (StgStablePtr)(sp);
286 287 288 289 290 291
}

/* -----------------------------------------------------------------------------
 * Treat stable pointers as roots for the garbage collector.
 * -------------------------------------------------------------------------- */

292 293 294 295 296 297 298 299 300 301 302 303 304 305 306 307
#define FOR_EACH_STABLE_PTR(p, CODE)                                    \
    do {                                                                \
        spEntry *p;                                                     \
        spEntry *__end_ptr = &stable_ptr_table[SPT_size];               \
        for (p = stable_ptr_table; p < __end_ptr; p++) {                \
            /* Internal pointers are free slots. NULL is last in free */ \
            /* list. */                                                 \
            if (p->addr &&                                              \
                (p->addr < (P_)stable_ptr_table || p->addr >= (P_)__end_ptr)) \
            {                                                           \
                do { CODE } while(0);                                   \
            }                                                           \
        }                                                               \
    } while(0)

void
David Feuer's avatar
David Feuer committed
308
markStablePtrTable(evac_fn evac, void *user)
309
{
310 311 312 313 314
    /* Since no other thread can currently be dereferencing a stable pointer, it
     * is safe to free the old versions of the table.
     */
    freeOldSPTs();

David Feuer's avatar
David Feuer committed
315
    FOR_EACH_STABLE_PTR(p, evac(user, (StgClosure **)&p->addr););
316
}
317

318 319
/* -----------------------------------------------------------------------------
 * Thread the stable pointer table for compacting GC.
320
 *
321
 * Here we must call the supplied evac function for each pointer into
322
 * the heap from the stable tables, because the compacting
323 324
 * collector may move the object it points to.
 * -------------------------------------------------------------------------- */
325

David Feuer's avatar
David Feuer committed
326
void
327
threadStablePtrTable( evac_fn evac, void *user )
328
{
329 330
    FOR_EACH_STABLE_PTR(p, evac(user, (StgClosure **)&p->addr););
}