rts/Stable.c

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