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_PERM) {
 192       q = ((StgInd *)q)->indirectee;
 193       tag = GET_CLOSURE_TAG(q);
 194       q = UNTAG_CLOSURE(q);
 195   }
 196
 197   return TAG_CLOSURE(tag,q);
 198 }
 199
 200 static StgWord
 201 lookupStableName_(StgPtr p)
 202 {
 203   StgWord sn;
 204   void* sn_tmp;
 205
 206   if (stable_ptr_free == NULL) {
 207     enlargeStablePtrTable();
 208   }
 209
 210   /* removing indirections increases the likelihood
 211    * of finding a match in the stable name hash table.
 212    */
 213   p = (StgPtr)removeIndirections((StgClosure*)p);
 214
 215   // register the untagged pointer.  This just makes things simpler.
 216   p = (StgPtr)UNTAG_CLOSURE((StgClosure*)p);
 217
 218   sn_tmp = lookupHashTable(addrToStableHash,(W_)p);
 219   sn = (StgWord)sn_tmp;
 220
 221   if (sn != 0) {
 222     ASSERT(stable_ptr_table[sn].addr == p);
 223     debugTrace(DEBUG_stable, "cached stable name %ld at %p",sn,p);
 224     return sn;
 225   } else {
 226     sn = stable_ptr_free - stable_ptr_table;
 227     stable_ptr_free  = (snEntry*)(stable_ptr_free->addr);
 228     stable_ptr_table[sn].ref = 0;
 229     stable_ptr_table[sn].addr = p;
 230     stable_ptr_table[sn].sn_obj = NULL;
 231     /* debugTrace(DEBUG_stable, "new stable name %d at %p\n",sn,p); */
 232
 233     /* add the new stable name to the hash table */
 234     insertHashTable(addrToStableHash, (W_)p, (void *)sn);
 235
 236     return sn;
 237   }
 238 }
 239
 240 StgWord
 241 lookupStableName(StgPtr p)
 242 {
 243     StgWord res;
 244
 245     initStablePtrTable();
 246     ACQUIRE_LOCK(&stable_mutex);
 247     res = lookupStableName_(p);
 248     RELEASE_LOCK(&stable_mutex);
 249     return res;
 250 }
 251
 252 STATIC_INLINE void
 253 freeStableName(snEntry *sn)
 254 {
 255   ASSERT(sn->sn_obj == NULL);
 256   if (sn->addr != NULL) {
 257       removeHashTable(addrToStableHash, (W_)sn->addr, NULL);
 258   }
 259   sn->addr = (P_)stable_ptr_free;
 260   stable_ptr_free = sn;
 261 }
 262
 263 StgStablePtr
 264 getStablePtr(StgPtr p)
 265 {
 266   StgWord sn;
 267
 268   initStablePtrTable();
 269   ACQUIRE_LOCK(&stable_mutex);
 270   sn = lookupStableName_(p);
 271   stable_ptr_table[sn].ref++;
 272   RELEASE_LOCK(&stable_mutex);
 273   return (StgStablePtr)(sn);
 274 }
 275
 276 void
 277 freeStablePtr(StgStablePtr sp)
 278 {
 279     snEntry *sn;
 280
 281         initStablePtrTable();
 282     ACQUIRE_LOCK(&stable_mutex);
 283
 284     sn = &stable_ptr_table[(StgWord)sp];
 285
 286     ASSERT((StgWord)sp < SPT_size  &&  sn->addr != NULL  &&  sn->ref > 0);
 287
 288     sn->ref--;
 289
 290     // If this entry has no StableName attached, then just free it
 291     // immediately.  This is important; it might be a while before the
 292     // next major GC which actually collects the entry.
 293     if (sn->sn_obj == NULL && sn->ref == 0) {
 294         freeStableName(sn);
 295     }
 296
 297     RELEASE_LOCK(&stable_mutex);
 298 }
 299
 300 static void
 301 enlargeStablePtrTable(void)
 302 {
 303   nat old_SPT_size = SPT_size;
 304
 305     // 2nd and subsequent times
 306   SPT_size *= 2;
 307   stable_ptr_table =
 308     stgReallocBytes(stable_ptr_table,
 309                       SPT_size * sizeof(snEntry),
 310                       "enlargeStablePtrTable");
 311
 312   initFreeList(stable_ptr_table + old_SPT_size, old_SPT_size, NULL);
 313 }
 314
 315 /* -----------------------------------------------------------------------------
 316  * We must lock the StablePtr table during GC, to prevent simultaneous
 317  * calls to freeStablePtr().
 318  * -------------------------------------------------------------------------- */
 319
 320 void
 321 stablePtrPreGC(void)
 322 {
 323     ACQUIRE_LOCK(&stable_mutex);
 324 }
 325
 326 void
 327 stablePtrPostGC(void)
 328 {
 329     RELEASE_LOCK(&stable_mutex);
 330 }
 331
 332 /* -----------------------------------------------------------------------------
 333  * Treat stable pointers as roots for the garbage collector.
 334  *
 335  * A stable pointer is any stable name entry with a ref > 0.  We'll
 336  * take the opportunity to zero the "keep" flags at the same time.
 337  * -------------------------------------------------------------------------- */
 338
 339 void
 340 markStablePtrTable(evac_fn evac, void *user)
 341 {
 342     snEntry *p, *end_stable_ptr_table;
 343     StgPtr q;
 344
 345     end_stable_ptr_table = &stable_ptr_table[SPT_size];
 346
 347     // Mark all the stable *pointers* (not stable names).
 348     // _starting_ at index 1; index 0 is unused.
 349     for (p = stable_ptr_table+1; p < end_stable_ptr_table; p++) {
 350         q = p->addr;
 351
 352         // Internal pointers are free slots.  If q == NULL, it's a
 353         // stable name where the object has been GC'd, but the
 354         // StableName object (sn_obj) is still alive.
 355         if (q && (q < (P_)stable_ptr_table || q >= (P_)end_stable_ptr_table)) {
 356
 357             // save the current addr away: we need to be able to tell
 358             // whether the objects moved in order to be able to update
 359             // the hash table later.
 360             p->old = p->addr;
 361
 362             // if the ref is non-zero, treat addr as a root
 363             if (p->ref != 0) {
 364                 evac(user, (StgClosure **)&p->addr);
 365             }
 366         }
 367     }
 368 }
 369
 370 /* -----------------------------------------------------------------------------
 371  * Thread the stable pointer table for compacting GC.
 372  *
 373  * Here we must call the supplied evac function for each pointer into
 374  * the heap from the stable pointer table, because the compacting
 375  * collector may move the object it points to.
 376  * -------------------------------------------------------------------------- */
 377
 378 void
 379 threadStablePtrTable( evac_fn evac, void *user )
 380 {
 381     snEntry *p, *end_stable_ptr_table;
 382     StgPtr q;
 383
 384     end_stable_ptr_table = &stable_ptr_table[SPT_size];
 385
 386     for (p = stable_ptr_table+1; p < end_stable_ptr_table; p++) {
 387
 388         if (p->sn_obj != NULL) {
 389             evac(user, (StgClosure **)&p->sn_obj);
 390         }
 391
 392         q = p->addr;
 393         if (q && (q < (P_)stable_ptr_table || q >= (P_)end_stable_ptr_table)) {
 394             evac(user, (StgClosure **)&p->addr);
 395         }
 396     }
 397 }
 398
 399 /* -----------------------------------------------------------------------------
 400  * Garbage collect any dead entries in the stable pointer table.
 401  *
 402  * A dead entry has:
 403  *
 404  *          - a zero reference count
 405  *          - a dead sn_obj
 406  *
 407  * Both of these conditions must be true in order to re-use the stable
 408  * name table entry.  We can re-use stable name table entries for live
 409  * heap objects, as long as the program has no StableName objects that
 410  * refer to the entry.
 411  * -------------------------------------------------------------------------- */
 412
 413 void
 414 gcStablePtrTable( void )
 415 {
 416     snEntry *p, *end_stable_ptr_table;
 417     StgPtr q;
 418
 419     end_stable_ptr_table = &stable_ptr_table[SPT_size];
 420
 421     // NOTE: _starting_ at index 1; index 0 is unused.
 422     for (p = stable_ptr_table + 1; p < end_stable_ptr_table; p++) {
 423
 424         // Update the pointer to the StableName object, if there is one
 425         if (p->sn_obj != NULL) {
 426             p->sn_obj = isAlive(p->sn_obj);
 427         }
 428
 429         // Internal pointers are free slots.  If q == NULL, it's a
 430         // stable name where the object has been GC'd, but the
 431         // StableName object (sn_obj) is still alive.
 432         q = p->addr;
 433         if (q && (q < (P_)stable_ptr_table || q >= (P_)end_stable_ptr_table)) {
 434
 435             // StableNames only:
 436             if (p->ref == 0) {
 437                 if (p->sn_obj == NULL) {
 438                     // StableName object is dead
 439                     freeStableName(p);
 440                     debugTrace(DEBUG_stable, "GC'd Stable name %ld",
 441                                (long)(p - stable_ptr_table));
 442                     continue;
 443
 444                 } else {
 445                   p->addr = (StgPtr)isAlive((StgClosure *)p->addr);
 446                   debugTrace(DEBUG_stable,
 447                              "stable name %ld still alive at %p, ref %ld\n",
 448                              (long)(p - stable_ptr_table), p->addr, p->ref);
 449                 }
 450             }
 451         }
 452     }
 453 }
 454
 455 /* -----------------------------------------------------------------------------
 456  * Update the StablePtr/StableName hash table
 457  *
 458  * The boolean argument 'full' indicates that a major collection is
 459  * being done, so we might as well throw away the hash table and build
 460  * a new one.  For a minor collection, we just re-hash the elements
 461  * that changed.
 462  * -------------------------------------------------------------------------- */
 463
 464 void
 465 updateStablePtrTable(rtsBool full)
 466 {
 467     snEntry *p, *end_stable_ptr_table;
 468
 469     if (full && addrToStableHash != NULL) {
 470         freeHashTable(addrToStableHash,NULL);
 471         addrToStableHash = allocHashTable();
 472     }
 473
 474     end_stable_ptr_table = &stable_ptr_table[SPT_size];
 475
 476     // NOTE: _starting_ at index 1; index 0 is unused.
 477     for (p = stable_ptr_table + 1; p < end_stable_ptr_table; p++) {
 478
 479         if (p->addr == NULL) {
 480             if (p->old != NULL) {
 481                 // The target has been garbage collected.  Remove its
 482                 // entry from the hash table.
 483                 removeHashTable(addrToStableHash, (W_)p->old, NULL);
 484                 p->old = NULL;
 485             }
 486         }
 487         else if (p->addr < (P_)stable_ptr_table
 488                  || p->addr >= (P_)end_stable_ptr_table) {
 489             // Target still alive, Re-hash this stable name
 490             if (full) {
 491                 insertHashTable(addrToStableHash, (W_)p->addr,
 492                                 (void *)(p - stable_ptr_table));
 493             } else if (p->addr != p->old) {
 494                 removeHashTable(addrToStableHash, (W_)p->old, NULL);
 495                 insertHashTable(addrToStableHash, (W_)p->addr,
 496                                 (void *)(p - stable_ptr_table));
 497             }
 498         }
 499     }
 500 }