rts/Stable.c

   1 /* -----------------------------------------------------------------------------
   2  *
   3  * (c) The GHC Team, 1998-2002
   4  *
   5  * Stable names and stable pointers.
   6  *
   7  * ---------------------------------------------------------------------------*/
   8
   9 #include "PosixSource.h"
  10 #include "Rts.h"
  11 #include "RtsAPI.h"
  12
  13 #include "Hash.h"
  14 #include "RtsUtils.h"
  15 #include "Trace.h"
  16 #include "Stable.h"
  17
  18 /* Comment from ADR's implementation in old RTS:
  19
  20   This files (together with @ghc/runtime/storage/PerformIO.lhc@ and a
  21   small change in @HpOverflow.lc@) consists of the changes in the
  22   runtime system required to implement "Stable Pointers". But we're
  23   getting a bit ahead of ourselves --- what is a stable pointer and what
  24   is it used for?
  25
  26   When Haskell calls C, it normally just passes over primitive integers,
  27   floats, bools, strings, etc.  This doesn't cause any problems at all
  28   for garbage collection because the act of passing them makes a copy
  29   from the heap, stack or wherever they are onto the C-world stack.
  30   However, if we were to pass a heap object such as a (Haskell) @String@
  31   and a garbage collection occured before we finished using it, we'd run
  32   into problems since the heap object might have been moved or even
  33   deleted.
  34
  35   So, if a C call is able to cause a garbage collection or we want to
  36   store a pointer to a heap object between C calls, we must be careful
  37   when passing heap objects. Our solution is to keep a table of all
  38   objects we've given to the C-world and to make sure that the garbage
  39   collector collects these objects --- updating the table as required to
  40   make sure we can still find the object.
  41
  42
  43   Of course, all this rather begs the question: why would we want to
  44   pass a boxed value?
  45
  46   One very good reason is to preserve laziness across the language
  47   interface. Rather than evaluating an integer or a string because it
  48   {\em might\/} be required by the C function, we can wait until the C
  49   function actually wants the value and then force an evaluation.
  50
  51   Another very good reason (the motivating reason!) is that the C code
  52   might want to execute an object of sort $IO ()$ for the side-effects
  53   it will produce. For example, this is used when interfacing to an X
  54   widgets library to allow a direct implementation of callbacks.
  55
  56
  57   The @makeStablePointer :: a -> IO (StablePtr a)@ function
  58   converts a value into a stable pointer.  It is part of the @PrimIO@
  59   monad, because we want to be sure we don't allocate one twice by
  60   accident, and then only free one of the copies.
  61
  62   \begin{verbatim}
  63   makeStablePtr#  :: a -> State# RealWorld -> (# RealWorld, a #)
  64   freeStablePtr#  :: StablePtr# a -> State# RealWorld -> State# RealWorld
  65   deRefStablePtr# :: StablePtr# a -> State# RealWorld ->
  66         (# State# RealWorld, a #)
  67   \end{verbatim}
  68
  69   There may be additional functions on the C side to allow evaluation,
  70   application, etc of a stable pointer.
  71
  72 */
  73
  74 snEntry *stable_ptr_table = NULL;
  75 static snEntry *stable_ptr_free = NULL;
  76
  77 static unsigned int SPT_size = 0;
  78
  79 #ifdef THREADED_RTS
  80 static Mutex stable_mutex;
  81 #endif
  82
  83 static void enlargeStablePtrTable(void);
  84
  85 /* This hash table maps Haskell objects to stable names, so that every
  86  * call to lookupStableName on a given object will return the same
  87  * stable name.
  88  *
  89  * OLD COMMENTS about reference counting follow.  The reference count
  90  * in a stable name entry is now just a counter.
  91  *
  92  * Reference counting
  93  * ------------------
  94  * A plain stable name entry has a zero reference count, which means
  95  * the entry will dissappear when the object it points to is
  96  * unreachable.  For stable pointers, we need an entry that sticks
  97  * around and keeps the object it points to alive, so each stable name
  98  * entry has an associated reference count.
  99  *
 100  * A stable pointer has a weighted reference count N attached to it
 101  * (actually in its upper 5 bits), which represents the weight
 102  * 2^(N-1).  The stable name entry keeps a 32-bit reference count, which
 103  * represents any weight between 1 and 2^32 (represented as zero).
 104  * When the weight is 2^32, the stable name table owns "all" of the
 105  * stable pointers to this object, and the entry can be garbage
 106  * collected if the object isn't reachable.
 107  *
 108  * A new stable pointer is given the weight log2(W/2), where W is the
 109  * weight stored in the table entry.  The new weight in the table is W
 110  * - 2^log2(W/2).
 111  *
 112  * A stable pointer can be "split" into two stable pointers, by
 113  * dividing the weight by 2 and giving each pointer half.
 114  * When freeing a stable pointer, the weight of the pointer is added
 115  * to the weight stored in the table entry.
 116  * */
 117
 118 static HashTable *addrToStableHash = NULL;
 119
 120 #define INIT_SPT_SIZE 64
 121
 122 STATIC_INLINE void
 123 initFreeList(snEntry *table, nat n, snEntry *free)
 124 {
 125   snEntry *p;
 126
 127   for (p = table + n - 1; p >= table; p--) {
 128     p->addr   = (P_)free;
 129     p->old    = NULL;
 130     p->ref    = 0;
 131     p->sn_obj = NULL;
 132     free = p;
 133   }
 134   stable_ptr_free = table;
 135 }
 136
 137 void
 138 initStablePtrTable(void)
 139 {
 140         if (SPT_size > 0)
 141                 return;
 142
 143     SPT_size = INIT_SPT_SIZE;
 144     stable_ptr_table = stgMallocBytes(SPT_size * sizeof(snEntry),
 145                                       "initStablePtrTable");
 146
 147     /* we don't use index 0 in the stable name table, because that
 148      * would conflict with the hash table lookup operations which
 149      * return NULL if an entry isn't found in the hash table.
 150      */
 151     initFreeList(stable_ptr_table+1,INIT_SPT_SIZE-1,NULL);
 152     addrToStableHash = allocHashTable();
 153
 154 #ifdef THREADED_RTS
 155     initMutex(&stable_mutex);
 156 #endif
 157 }
 158
 159 void
 160 exitStablePtrTable(void)
 161 {
 162   if (addrToStableHash)
 163     freeHashTable(addrToStableHash, NULL);
 164   addrToStableHash = NULL;
 165   if (stable_ptr_table)
 166     stgFree(stable_ptr_table);
 167   stable_ptr_table = NULL;
 168   SPT_size = 0;
 169 #ifdef THREADED_RTS
 170   closeMutex(&stable_mutex);
 171 #endif
 172 }
 173
 174 /*
 175  * get at the real stuff...remove indirections.
 176  * It untags pointers before dereferencing and
 177  * retags the real stuff with its tag (if there
 178  * is any) when returning.
 179  *
 180  * ToDo: move to a better home.
 181  */
 182 static
 183 StgClosure*
 184 removeIndirections(StgClosure* p)
 185 {
 186   StgWord tag = GET_CLOSURE_TAG(p);
 187   StgClosure* q = UNTAG_CLOSURE(p);
 188
 189   while (get_itbl(q)->type == IND ||
 190          get_itbl(q)->type == IND_STATIC ||
 191          get_itbl(q)->type == IND_OLDGEN ||
 192          get_itbl(q)->type == IND_PERM ||
 193          get_itbl(q)->type == IND_OLDGEN_PERM ) {
 194       q = ((StgInd *)q)->indirectee;
 195       tag = GET_CLOSURE_TAG(q);
 196       q = UNTAG_CLOSURE(q);
 197   }
 198
 199   return TAG_CLOSURE(tag,q);
 200 }
 201
 202 static StgWord
 203 lookupStableName_(StgPtr p)
 204 {
 205   StgWord sn;
 206   void* sn_tmp;
 207
 208   if (stable_ptr_free == NULL) {
 209     enlargeStablePtrTable();
 210   }
 211
 212   /* removing indirections increases the likelihood
 213    * of finding a match in the stable name hash table.
 214    */
 215   p = (StgPtr)removeIndirections((StgClosure*)p);
 216
 217   // register the untagged pointer.  This just makes things simpler.
 218   p = (StgPtr)UNTAG_CLOSURE((StgClosure*)p);
 219
 220   sn_tmp = lookupHashTable(addrToStableHash,(W_)p);
 221   sn = (StgWord)sn_tmp;
 222
 223   if (sn != 0) {
 224     ASSERT(stable_ptr_table[sn].addr == p);
 225     debugTrace(DEBUG_stable, "cached stable name %ld at %p",sn,p);
 226     return sn;
 227   } else {
 228     sn = stable_ptr_free - stable_ptr_table;
 229     stable_ptr_free  = (snEntry*)(stable_ptr_free->addr);
 230     stable_ptr_table[sn].ref = 0;
 231     stable_ptr_table[sn].addr = p;
 232     stable_ptr_table[sn].sn_obj = NULL;
 233     /* debugTrace(DEBUG_stable, "new stable name %d at %p\n",sn,p); */
 234
 235     /* add the new stable name to the hash table */
 236     insertHashTable(addrToStableHash, (W_)p, (void *)sn);
 237
 238     return sn;
 239   }
 240 }
 241
 242 StgWord
 243 lookupStableName(StgPtr p)
 244 {
 245     StgWord res;
 246
 247     initStablePtrTable();
 248     ACQUIRE_LOCK(&stable_mutex);
 249     res = lookupStableName_(p);
 250     RELEASE_LOCK(&stable_mutex);
 251     return res;
 252 }
 253
 254 STATIC_INLINE void
 255 freeStableName(snEntry *sn)
 256 {
 257   ASSERT(sn->sn_obj == NULL);
 258   if (sn->addr != NULL) {
 259       removeHashTable(addrToStableHash, (W_)sn->addr, NULL);
 260   }
 261   sn->addr = (P_)stable_ptr_free;
 262   stable_ptr_free = sn;
 263 }
 264
 265 StgStablePtr
 266 getStablePtr(StgPtr p)
 267 {
 268   StgWord sn;
 269
 270   initStablePtrTable();
 271   ACQUIRE_LOCK(&stable_mutex);
 272   sn = lookupStableName_(p);
 273   stable_ptr_table[sn].ref++;
 274   RELEASE_LOCK(&stable_mutex);
 275   return (StgStablePtr)(sn);
 276 }
 277
 278 void
 279 freeStablePtr(StgStablePtr sp)
 280 {
 281     snEntry *sn;
 282
 283         initStablePtrTable();
 284     ACQUIRE_LOCK(&stable_mutex);
 285
 286     sn = &stable_ptr_table[(StgWord)sp];
 287
 288     ASSERT((StgWord)sp < SPT_size  &&  sn->addr != NULL  &&  sn->ref > 0);
 289
 290     sn->ref--;
 291
 292     // If this entry has no StableName attached, then just free it
 293     // immediately.  This is important; it might be a while before the
 294     // next major GC which actually collects the entry.
 295     if (sn->sn_obj == NULL && sn->ref == 0) {
 296         freeStableName(sn);
 297     }
 298
 299     RELEASE_LOCK(&stable_mutex);
 300 }
 301
 302 static void
 303 enlargeStablePtrTable(void)
 304 {
 305   nat old_SPT_size = SPT_size;
 306
 307     // 2nd and subsequent times
 308   SPT_size *= 2;
 309   stable_ptr_table =
 310     stgReallocBytes(stable_ptr_table,
 311                       SPT_size * sizeof(snEntry),
 312                       "enlargeStablePtrTable");
 313
 314   initFreeList(stable_ptr_table + old_SPT_size, old_SPT_size, NULL);
 315 }
 316
 317 /* -----------------------------------------------------------------------------
 318  * We must lock the StablePtr table during GC, to prevent simultaneous
 319  * calls to freeStablePtr().
 320  * -------------------------------------------------------------------------- */
 321
 322 void
 323 stablePtrPreGC(void)
 324 {
 325     ACQUIRE_LOCK(&stable_mutex);
 326 }
 327
 328 void
 329 stablePtrPostGC(void)
 330 {
 331     RELEASE_LOCK(&stable_mutex);
 332 }
 333
 334 /* -----------------------------------------------------------------------------
 335  * Treat stable pointers as roots for the garbage collector.
 336  *
 337  * A stable pointer is any stable name entry with a ref > 0.  We'll
 338  * take the opportunity to zero the "keep" flags at the same time.
 339  * -------------------------------------------------------------------------- */
 340
 341 void
 342 markStablePtrTable(evac_fn evac, void *user)
 343 {
 344     snEntry *p, *end_stable_ptr_table;
 345     StgPtr q;
 346
 347     end_stable_ptr_table = &stable_ptr_table[SPT_size];
 348
 349     // Mark all the stable *pointers* (not stable names).
 350     // _starting_ at index 1; index 0 is unused.
 351     for (p = stable_ptr_table+1; p < end_stable_ptr_table; p++) {
 352         q = p->addr;
 353
 354         // Internal pointers are free slots.  If q == NULL, it's a
 355         // stable name where the object has been GC'd, but the
 356         // StableName object (sn_obj) is still alive.
 357         if (q && (q < (P_)stable_ptr_table || q >= (P_)end_stable_ptr_table)) {
 358
 359             // save the current addr away: we need to be able to tell
 360             // whether the objects moved in order to be able to update
 361             // the hash table later.
 362             p->old = p->addr;
 363
 364             // if the ref is non-zero, treat addr as a root
 365             if (p->ref != 0) {
 366                 evac(user, (StgClosure **)&p->addr);
 367             }
 368         }
 369     }
 370 }
 371
 372 /* -----------------------------------------------------------------------------
 373  * Thread the stable pointer table for compacting GC.
 374  *
 375  * Here we must call the supplied evac function for each pointer into
 376  * the heap from the stable pointer table, because the compacting
 377  * collector may move the object it points to.
 378  * -------------------------------------------------------------------------- */
 379
 380 void
 381 threadStablePtrTable( evac_fn evac, void *user )
 382 {
 383     snEntry *p, *end_stable_ptr_table;
 384     StgPtr q;
 385
 386     end_stable_ptr_table = &stable_ptr_table[SPT_size];
 387
 388     for (p = stable_ptr_table+1; p < end_stable_ptr_table; p++) {
 389
 390         if (p->sn_obj != NULL) {
 391             evac(user, (StgClosure **)&p->sn_obj);
 392         }
 393
 394         q = p->addr;
 395         if (q && (q < (P_)stable_ptr_table || q >= (P_)end_stable_ptr_table)) {
 396             evac(user, (StgClosure **)&p->addr);
 397         }
 398     }
 399 }
 400
 401 /* -----------------------------------------------------------------------------
 402  * Garbage collect any dead entries in the stable pointer table.
 403  *
 404  * A dead entry has:
 405  *
 406  *          - a zero reference count
 407  *          - a dead sn_obj
 408  *
 409  * Both of these conditions must be true in order to re-use the stable
 410  * name table entry.  We can re-use stable name table entries for live
 411  * heap objects, as long as the program has no StableName objects that
 412  * refer to the entry.
 413  * -------------------------------------------------------------------------- */
 414
 415 void
 416 gcStablePtrTable( void )
 417 {
 418     snEntry *p, *end_stable_ptr_table;
 419     StgPtr q;
 420
 421     end_stable_ptr_table = &stable_ptr_table[SPT_size];
 422
 423     // NOTE: _starting_ at index 1; index 0 is unused.
 424     for (p = stable_ptr_table + 1; p < end_stable_ptr_table; p++) {
 425
 426         // Update the pointer to the StableName object, if there is one
 427         if (p->sn_obj != NULL) {
 428             p->sn_obj = isAlive(p->sn_obj);
 429         }
 430
 431         // Internal pointers are free slots.  If q == NULL, it's a
 432         // stable name where the object has been GC'd, but the
 433         // StableName object (sn_obj) is still alive.
 434         q = p->addr;
 435         if (q && (q < (P_)stable_ptr_table || q >= (P_)end_stable_ptr_table)) {
 436
 437             // StableNames only:
 438             if (p->ref == 0) {
 439                 if (p->sn_obj == NULL) {
 440                     // StableName object is dead
 441                     freeStableName(p);
 442                     debugTrace(DEBUG_stable, "GC'd Stable name %ld",
 443                                (long)(p - stable_ptr_table));
 444                     continue;
 445
 446                 } else {
 447                   p->addr = (StgPtr)isAlive((StgClosure *)p->addr);
 448                   debugTrace(DEBUG_stable,
 449                              "stable name %ld still alive at %p, ref %ld\n",
 450                              (long)(p - stable_ptr_table), p->addr, p->ref);
 451                 }
 452             }
 453         }
 454     }
 455 }
 456
 457 /* -----------------------------------------------------------------------------
 458  * Update the StablePtr/StableName hash table
 459  *
 460  * The boolean argument 'full' indicates that a major collection is
 461  * being done, so we might as well throw away the hash table and build
 462  * a new one.  For a minor collection, we just re-hash the elements
 463  * that changed.
 464  * -------------------------------------------------------------------------- */
 465
 466 void
 467 updateStablePtrTable(rtsBool full)
 468 {
 469     snEntry *p, *end_stable_ptr_table;
 470
 471     if (full && addrToStableHash != NULL) {
 472         freeHashTable(addrToStableHash,NULL);
 473         addrToStableHash = allocHashTable();
 474     }
 475
 476     end_stable_ptr_table = &stable_ptr_table[SPT_size];
 477
 478     // NOTE: _starting_ at index 1; index 0 is unused.
 479     for (p = stable_ptr_table + 1; p < end_stable_ptr_table; p++) {
 480
 481         if (p->addr == NULL) {
 482             if (p->old != NULL) {
 483                 // The target has been garbage collected.  Remove its
 484                 // entry from the hash table.
 485                 removeHashTable(addrToStableHash, (W_)p->old, NULL);
 486                 p->old = NULL;
 487             }
 488         }
 489         else if (p->addr < (P_)stable_ptr_table
 490                  || p->addr >= (P_)end_stable_ptr_table) {
 491             // Target still alive, Re-hash this stable name
 492             if (full) {
 493                 insertHashTable(addrToStableHash, (W_)p->addr,
 494                                 (void *)(p - stable_ptr_table));
 495             } else if (p->addr != p->old) {
 496                 removeHashTable(addrToStableHash, (W_)p->old, NULL);
 497                 insertHashTable(addrToStableHash, (W_)p->addr,
 498                                 (void *)(p - stable_ptr_table));
 499             }
 500         }
 501     }
 502 }