Stable.c 18.3 KB
 Simon Marlow committed Feb 14, 2013 1 2 /* -*- tab-width: 4 -*- */  simonm committed Jan 27, 1999 3 4 /* ----------------------------------------------------------------------------- *  simonmar committed Dec 19, 2002 5  * (c) The GHC Team, 1998-2002  simonm committed Jan 27, 1999 6 7 8 9 10  * * Stable names and stable pointers. * * ---------------------------------------------------------------------------*/  sewardj committed Aug 14, 2001 11 #include "PosixSource.h"  simonm committed Jan 27, 1999 12 #include "Rts.h"  Simon Marlow committed Aug 02, 2009 13 14 #include "RtsAPI.h"  simonm committed Jan 27, 1999 15 16 #include "Hash.h" #include "RtsUtils.h"  Simon Marlow committed Jun 08, 2006 17 #include "Trace.h"  Simon Marlow committed Oct 24, 2006 18 #include "Stable.h"  simonm committed Jan 27, 1999 19 20 21 22 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  /* 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.  Simon Marlow committed Feb 14, 2013 58 59 60 61 62  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.  simonm committed Jan 27, 1999 63 64 65 66 67 68 69 70 71  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  Simon Marlow committed Feb 14, 2013 72  deRefStablePtr# :: StablePtr# a -> State# RealWorld ->  simonm committed Jan 27, 1999 73 74 75 76 77 78  (# State# RealWorld, a #) \end{verbatim} There may be additional functions on the C side to allow evaluation, application, etc of a stable pointer.  Simon Marlow committed Feb 14, 2013 79 80 81 82 83 84 85 86  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 http://hackage.haskell.org/trac/ghc/ticket/7670 for details.  simonm committed Jan 27, 1999 87 88 */  Simon Marlow committed Feb 14, 2013 89 90 91 92 snEntry *stable_name_table = NULL; static snEntry *stable_name_free = NULL; static unsigned int SNT_size = 0; #define INIT_SNT_SIZE 64  simonm committed Jan 27, 1999 93   Simon Marlow committed Feb 14, 2013 94 95 spEntry *stable_ptr_table = NULL; static spEntry *stable_ptr_free = NULL;  simonmar committed Jan 28, 2003 96 static unsigned int SPT_size = 0;  Simon Marlow committed Feb 14, 2013 97 #define INIT_SPT_SIZE 64  simonm committed Jan 27, 1999 98   simonmar committed Nov 24, 2005 99 #ifdef THREADED_RTS  Simon Marlow committed Dec 06, 2011 100 Mutex stable_mutex;  simonmar committed Nov 24, 2005 101 #endif  simonmar committed Nov 24, 2005 102   Simon Marlow committed Feb 14, 2013 103 static void enlargeStableNameTable(void);  Simon Marlow committed Aug 02, 2009 104 105 static void enlargeStablePtrTable(void);  simonm committed Jan 27, 1999 106 107 108 109 /* This hash table maps Haskell objects to stable names, so that every * call to lookupStableName on a given object will return the same * stable name. *  simonmar committed Nov 21, 2001 110 111 112  * OLD COMMENTS about reference counting follow. The reference count * in a stable name entry is now just a counter. *  simonm committed Jan 27, 1999 113 114 115 116 117 118 119 120 121 122  * Reference counting * ------------------ * A plain stable name entry has a zero reference count, which means * the entry will dissappear when the object it points to is * unreachable. For stable pointers, we need an entry that sticks * around and keeps the object it points to alive, so each stable name * entry has an associated reference count. * * A stable pointer has a weighted reference count N attached to it * (actually in its upper 5 bits), which represents the weight  simonmar committed Sep 04, 2000 123  * 2^(N-1). The stable name entry keeps a 32-bit reference count, which  simonm committed Jan 27, 1999 124 125 126 127 128 129 130 131 132 133 134 135 136 137 138  * represents any weight between 1 and 2^32 (represented as zero). * When the weight is 2^32, the stable name table owns "all" of the * stable pointers to this object, and the entry can be garbage * collected if the object isn't reachable. * * A new stable pointer is given the weight log2(W/2), where W is the * weight stored in the table entry. The new weight in the table is W * - 2^log2(W/2). * * A stable pointer can be "split" into two stable pointers, by * dividing the weight by 2 and giving each pointer half. * When freeing a stable pointer, the weight of the pointer is added * to the weight stored in the table entry. * */  simonmar committed Jan 28, 2003 139 static HashTable *addrToStableHash = NULL;  simonm committed Jan 27, 1999 140   sof committed Nov 12, 2003 141 STATIC_INLINE void  Simon Marlow committed Feb 14, 2013 142 initSnEntryFreeList(snEntry *table, nat n, snEntry *free)  simonm committed Jan 27, 1999 143 144 145 { snEntry *p; for (p = table + n - 1; p >= table; p--) {  sof committed Mar 08, 1999 146  p->addr = (P_)free;  simonmar committed Jul 23, 2001 147  p->old = NULL;  sof committed Mar 08, 1999 148  p->sn_obj = NULL;  simonm committed Jan 27, 1999 149 150  free = p; }  Simon Marlow committed Feb 14, 2013 151 152 153 154 155 156 157 158 159 160 161  stable_name_free = table; } STATIC_INLINE void initSpEntryFreeList(spEntry *table, nat n, spEntry *free) { spEntry *p; for (p = table + n - 1; p >= table; p--) { p->addr = (P_)free; free = p; }  simonm committed Jan 27, 1999 162 163 164 165  stable_ptr_free = table; } void  Simon Marlow committed Feb 14, 2013 166 initStableTables(void)  simonm committed Jan 27, 1999 167 {  Simon Marlow committed Feb 14, 2013 168 169 170 171  if (SNT_size > 0) return; SNT_size = INIT_SNT_SIZE; stable_name_table = stgMallocBytes(SNT_size * sizeof *stable_name_table, "initStableNameTable");  172 173 174 175  /* we don't use index 0 in the stable name table, because that * would conflict with the hash table lookup operations which * return NULL if an entry isn't found in the hash table. */  Simon Marlow committed Feb 14, 2013 176  initSnEntryFreeList(stable_name_table + 1,INIT_SNT_SIZE-1,NULL);  177 178  addrToStableHash = allocHashTable();  Simon Marlow committed Feb 14, 2013 179 180 181 182 183 184  if (SPT_size > 0) return; SPT_size = INIT_SPT_SIZE; stable_ptr_table = stgMallocBytes(SPT_size * sizeof *stable_ptr_table, "initStablePtrTable"); initSpEntryFreeList(stable_ptr_table,INIT_SPT_SIZE,NULL);  simonmar committed Nov 24, 2005 185 #ifdef THREADED_RTS  simonmar committed Nov 24, 2005 186  initMutex(&stable_mutex);  simonmar committed Nov 24, 2005 187 #endif  simonm committed Jan 27, 1999 188 189 }  Simon Marlow committed Aug 08, 2006 190 void  Simon Marlow committed Feb 14, 2013 191 exitStableTables(void)  Simon Marlow committed Aug 08, 2006 192 {  Simon Marlow committed Feb 14, 2013 193 194 195 196 197 198 199 200 201 202 203 204 205 206  if (addrToStableHash) freeHashTable(addrToStableHash, NULL); addrToStableHash = NULL; if (stable_name_table) stgFree(stable_name_table); stable_name_table = NULL; SNT_size = 0; if (stable_ptr_table) stgFree(stable_ptr_table); stable_ptr_table = NULL; SPT_size = 0;  ei@vuokko.info committed Aug 23, 2006 207 #ifdef THREADED_RTS  Simon Marlow committed Feb 14, 2013 208  closeMutex(&stable_mutex);  ei@vuokko.info committed Aug 23, 2006 209 #endif  Simon Marlow committed Aug 08, 2006 210 211 }  sof committed Feb 29, 2000 212 213 /* * get at the real stuff...remove indirections.  Simon Marlow committed Jul 27, 2007 214 215 216  * It untags pointers before dereferencing and * retags the real stuff with its tag (if there * is any) when returning.  sof committed Feb 29, 2000 217 218 219 220 221 222 223  * * ToDo: move to a better home. */ static StgClosure* removeIndirections(StgClosure* p) {  Simon Marlow committed Jul 27, 2007 224 225  StgWord tag = GET_CLOSURE_TAG(p); StgClosure* q = UNTAG_CLOSURE(p);  sof committed Feb 29, 2000 226   panne committed Apr 24, 2000 227 228  while (get_itbl(q)->type == IND || get_itbl(q)->type == IND_STATIC ||  Simon Marlow committed Apr 01, 2010 229  get_itbl(q)->type == IND_PERM) {  Simon Marlow committed Jun 04, 2008 230  q = ((StgInd *)q)->indirectee;  Simon Marlow committed Jul 27, 2007 231  tag = GET_CLOSURE_TAG(q);  Simon Marlow committed Jun 04, 2008 232  q = UNTAG_CLOSURE(q);  sof committed Feb 29, 2000 233  }  Simon Marlow committed Jun 04, 2008 234   Simon Marlow committed Jul 27, 2007 235  return TAG_CLOSURE(tag,q);  sof committed Feb 29, 2000 236 237 }  simonmar committed Nov 24, 2005 238 239 static StgWord lookupStableName_(StgPtr p)  simonm committed Jan 27, 1999 240 241 { StgWord sn;  panne committed Aug 22, 2004 242  void* sn_tmp;  simonm committed Jan 27, 1999 243   Simon Marlow committed Feb 14, 2013 244 245  if (stable_name_free == NULL) { enlargeStableNameTable();  simonm committed Jan 27, 1999 246  }  sof committed Feb 29, 2000 247 248  /* removing indirections increases the likelihood  simonmar committed Jul 23, 2001 249  * of finding a match in the stable name hash table.  sof committed Feb 29, 2000 250 251 252  */ p = (StgPtr)removeIndirections((StgClosure*)p);  Simon Marlow committed Jun 09, 2008 253 254 255  // register the untagged pointer. This just makes things simpler. p = (StgPtr)UNTAG_CLOSURE((StgClosure*)p);  panne committed Aug 22, 2004 256 257  sn_tmp = lookupHashTable(addrToStableHash,(W_)p); sn = (StgWord)sn_tmp;  Simon Marlow committed Feb 14, 2013 258   simonm committed Jan 27, 1999 259  if (sn != 0) {  Simon Marlow committed Feb 14, 2013 260  ASSERT(stable_name_table[sn].addr == p);  Simon Marlow committed Jun 08, 2006 261  debugTrace(DEBUG_stable, "cached stable name %ld at %p",sn,p);  simonm committed Jan 27, 1999 262 263  return sn; }  Simon Marlow committed Feb 14, 2013 264 265 266 267 268 269 270 271 272 273 274  sn = stable_name_free - stable_name_table; stable_name_free = (snEntry*)(stable_name_free->addr); stable_name_table[sn].addr = p; stable_name_table[sn].sn_obj = NULL; /* debugTrace(DEBUG_stable, "new stable name %d at %p\n",sn,p); */ /* add the new stable name to the hash table */ insertHashTable(addrToStableHash, (W_)p, (void *)sn); return sn;  simonm committed Jan 27, 1999 275 276 }  simonmar committed Nov 24, 2005 277 278 279 280 StgWord lookupStableName(StgPtr p) { StgWord res;  281   Simon Marlow committed Feb 14, 2013 282  initStableTables();  simonmar committed Nov 24, 2005 283 284 285 286 287 288  ACQUIRE_LOCK(&stable_mutex); res = lookupStableName_(p); RELEASE_LOCK(&stable_mutex); return res; }  sof committed Nov 12, 2003 289 STATIC_INLINE void  Simon Marlow committed Feb 14, 2013 290 freeSnEntry(snEntry *sn)  simonm committed Jan 27, 1999 291 {  simonm committed Feb 26, 1999 292  ASSERT(sn->sn_obj == NULL);  Simon Marlow committed Feb 14, 2013 293 294 295 296  if(sn->addr != NULL) { /* StableName object may die before pointee, in which case we * need to remove from hash table, or after pointee, in which * case addr==NULL and we already removed it. */  simonmar committed Nov 21, 2001 297  removeHashTable(addrToStableHash, (W_)sn->addr, NULL);  simonmar committed Aug 04, 1999 298  }  Simon Marlow committed Feb 14, 2013 299 300 301 302 303 304 305 306 307  sn->addr = (P_)stable_name_free; stable_name_free = sn; } STATIC_INLINE void freeSpEntry(spEntry *sp) { sp->addr = (P_)stable_ptr_free; stable_ptr_free = sp;  simonm committed Jan 27, 1999 308 309 310 311 312 } StgStablePtr getStablePtr(StgPtr p) {  Simon Marlow committed Feb 14, 2013 313  StgWord sp;  simonmar committed Nov 21, 2001 314   Simon Marlow committed Feb 14, 2013 315  initStableTables();  simonmar committed Nov 24, 2005 316  ACQUIRE_LOCK(&stable_mutex);  Simon Marlow committed Feb 14, 2013 317 318 319 320  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;  simonmar committed Nov 24, 2005 321  RELEASE_LOCK(&stable_mutex);  Simon Marlow committed Feb 14, 2013 322  return (StgStablePtr)(sp);  simonm committed Jan 27, 1999 323 324 }  sewardj committed Dec 20, 2001 325 void  Simon Marlow committed Feb 14, 2013 326 freeStablePtrUnsafe(StgStablePtr sp)  sewardj committed Dec 20, 2001 327 {  Simon Marlow committed Feb 14, 2013 328 329 330  ASSERT((StgWord)sp < SPT_size); freeSpEntry(&stable_ptr_table[(StgWord)sp]); }  simonmar committed Nov 24, 2005 331   Simon Marlow committed Feb 14, 2013 332 333 334 335 void freeStablePtr(StgStablePtr sp) { initStableTables();  simonmar committed Nov 24, 2005 336  ACQUIRE_LOCK(&stable_mutex);  Simon Marlow committed Feb 14, 2013 337 338 339  freeStablePtrUnsafe(sp); RELEASE_LOCK(&stable_mutex); }  simonmar committed Nov 24, 2005 340   Simon Marlow committed Feb 14, 2013 341 342 343 344 static void enlargeStableNameTable(void) { nat old_SNT_size = SNT_size;  simonmar committed Apr 09, 2002 345   Simon Marlow committed Feb 14, 2013 346 347 348 349 350 351  // 2nd and subsequent times SNT_size *= 2; stable_name_table = stgReallocBytes(stable_name_table, SNT_size * sizeof *stable_name_table, "enlargeStableNameTable");  simonmar committed Nov 24, 2005 352   Simon Marlow committed Feb 14, 2013 353  initSnEntryFreeList(stable_name_table + old_SNT_size, old_SNT_size, NULL);  sewardj committed Dec 20, 2001 354 355 }  Simon Marlow committed Aug 02, 2009 356 static void  simonm committed Jan 27, 1999 357 358 enlargeStablePtrTable(void) {  Simon Marlow committed Feb 14, 2013 359  nat old_SPT_size = SPT_size;  360   simonmar committed Jul 23, 2001 361  // 2nd and subsequent times  Simon Marlow committed Feb 14, 2013 362 363 364 365 366  SPT_size *= 2; stable_ptr_table = stgReallocBytes(stable_ptr_table, SPT_size * sizeof *stable_ptr_table, "enlargeStablePtrTable");  sof committed Mar 31, 2003 367   Simon Marlow committed Feb 14, 2013 368  initSpEntryFreeList(stable_ptr_table + old_SPT_size, old_SPT_size, NULL);  simonm committed Jan 27, 1999 369 370 }  Simon Marlow committed Jun 04, 2009 371 372 373 374 375 376 /* ----------------------------------------------------------------------------- * We must lock the StablePtr table during GC, to prevent simultaneous * calls to freeStablePtr(). * -------------------------------------------------------------------------- */ void  Simon Marlow committed Feb 14, 2013 377 stableLock(void)  Simon Marlow committed Jun 04, 2009 378 {  Simon Marlow committed Feb 14, 2013 379  initStableTables();  Simon Marlow committed Jun 04, 2009 380 381 382 383  ACQUIRE_LOCK(&stable_mutex); } void  Simon Marlow committed Feb 14, 2013 384 stableUnlock(void)  Simon Marlow committed Jun 04, 2009 385 386 387 388 { RELEASE_LOCK(&stable_mutex); }  simonm committed Jan 27, 1999 389 390 391 392 /* ----------------------------------------------------------------------------- * Treat stable pointers as roots for the garbage collector. * -------------------------------------------------------------------------- */  Simon Marlow committed Feb 14, 2013 393 394 395 396 397 398 399 400 401 402 403 404 405 406 407 408 409 410 411 412 413 414 415 416 417 418 419 420 421 422 423 424 425 426 427 428 429 #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) #define FOR_EACH_STABLE_NAME(p, CODE) \ do { \ snEntry *p; \ snEntry *__end_ptr = &stable_name_table[SNT_size]; \ for (p = stable_name_table + 1; p < __end_ptr; p++) { \ /* Internal pointers are free slots. */ \ /* If p->addr == NULL, it's a */ \ /* stable name where the object has been GC'd, but the */ \ /* StableName object (sn_obj) is still alive. */ \ if ((p->addr < (P_)stable_name_table || \ p->addr >= (P_)__end_ptr)) \ { \ /* NOTE: There is an ambiguity here if p->addr == NULL */ \ /* it is either the last item in the free list or it */ \ /* is a stable name whose pointee died. sn_obj == NULL */ \ /* disambiguates as last free list item. */ \ do { CODE } while(0); \ } \ } \ } while(0) STATIC_INLINE void  simonmarhaskell@gmail.com committed Apr 16, 2008 430 markStablePtrTable(evac_fn evac, void *user)  simonm committed Jan 27, 1999 431 {  Simon Marlow committed Feb 14, 2013 432 433 434 435 436 437 438 439 440 441 442 443 444 445 446  FOR_EACH_STABLE_PTR(p, evac(user, (StgClosure **)&p->addr);); } STATIC_INLINE void rememberOldStableNameAddresses(void) { /* TODO: Only if !full GC */ FOR_EACH_STABLE_NAME(p, p->old = p->addr;); } void markStableTables(evac_fn evac, void *user) { markStablePtrTable(evac, user); rememberOldStableNameAddresses();  simonmar committed Jul 23, 2001 447 }  simonm committed Jan 27, 1999 448   simonmar committed Jul 23, 2001 449 450 /* ----------------------------------------------------------------------------- * Thread the stable pointer table for compacting GC.  Simon Marlow committed Feb 14, 2013 451  *  simonmar committed Jul 23, 2001 452  * Here we must call the supplied evac function for each pointer into  Simon Marlow committed Feb 14, 2013 453  * the heap from the stable tables, because the compacting  simonmar committed Jul 23, 2001 454 455  * collector may move the object it points to. * -------------------------------------------------------------------------- */  simonm committed Jan 27, 1999 456   Simon Marlow committed Feb 14, 2013 457 458 459 460 461 462 463 464 465 466 467 468 469 470 STATIC_INLINE void threadStableNameTable( evac_fn evac, void *user ) { FOR_EACH_STABLE_NAME(p, { if (p->sn_obj != NULL) { evac(user, (StgClosure **)&p->sn_obj); } if (p->addr != NULL) { evac(user, (StgClosure **)&p->addr); } }); } STATIC_INLINE void  simonmarhaskell@gmail.com committed Apr 16, 2008 471 threadStablePtrTable( evac_fn evac, void *user )  simonmar committed Jul 23, 2001 472 {  Simon Marlow committed Feb 14, 2013 473 474 475 476 477 478 479 480  FOR_EACH_STABLE_PTR(p, evac(user, (StgClosure **)&p->addr);); } void threadStableTables( evac_fn evac, void *user ) { threadStableNameTable(evac, user); threadStablePtrTable(evac, user);  simonm committed Jan 27, 1999 481 482 483 484 485 486 487 } /* ----------------------------------------------------------------------------- * Garbage collect any dead entries in the stable pointer table. * * A dead entry has: *  simonmar committed Nov 21, 2001 488  * - a zero reference count  simonm committed Feb 26, 1999 489  * - a dead sn_obj  simonm committed Jan 27, 1999 490  *  simonm committed Feb 26, 1999 491 492 493 494  * Both of these conditions must be true in order to re-use the stable * name table entry. We can re-use stable name table entries for live * heap objects, as long as the program has no StableName objects that * refer to the entry.  simonmar committed Jul 23, 2001 495 496 497  * -------------------------------------------------------------------------- */ void  Simon Marlow committed Feb 14, 2013 498 gcStableTables( void )  simonmar committed Jul 23, 2001 499 {  Simon Marlow committed Feb 14, 2013 500 501 502 503 504 505 506 507 508 509 510 511 512 513 514 515 516 517 518 519 520 521 522 523 524 525 526 527 528  FOR_EACH_STABLE_NAME( p, { // Update the pointer to the StableName object, if there is one if (p->sn_obj != NULL) { p->sn_obj = isAlive(p->sn_obj); if(p->sn_obj == NULL) { // StableName object died debugTrace(DEBUG_stable, "GC'd StableName %ld (addr=%p)", (long)(p - stable_name_table), p->addr); freeSnEntry(p); /* Can't "continue", so use goto */ goto next_stable_name; } } /* If sn_obj became NULL, the object died, and addr is now * invalid. But if sn_obj was null, then the StableName * object may not have been created yet, while the pointee * already exists and must be updated to new location. */ if (p->addr != NULL) { p->addr = (StgPtr)isAlive((StgClosure *)p->addr); if(p->addr == NULL) { // StableName pointee died debugTrace(DEBUG_stable, "GC'd pointee %ld", (long)(p - stable_name_table)); } } next_stable_name: if (0) {} });  simonmar committed Jul 23, 2001 529 530 531 } /* -----------------------------------------------------------------------------  Simon Marlow committed Feb 14, 2013 532  * Update the StableName hash table  simonm committed Jan 27, 1999 533 534 535 536 537 538 539 540  * * The boolean argument 'full' indicates that a major collection is * being done, so we might as well throw away the hash table and build * a new one. For a minor collection, we just re-hash the elements * that changed. * -------------------------------------------------------------------------- */ void  Simon Marlow committed Feb 14, 2013 541 updateStableTables(rtsBool full)  simonm committed Jan 27, 1999 542 {  Simon Marlow committed Feb 14, 2013 543 544 545  if (full && addrToStableHash != NULL && 0 != keyCountHashTable(addrToStableHash)) { freeHashTable(addrToStableHash,NULL); addrToStableHash = allocHashTable();  simonm committed Feb 26, 1999 546  }  Simon Marlow committed Feb 14, 2013 547 548 549 550 551 552 553 554 555 556 557 558 559 560 561 562 563 564 565 566  if(full) { FOR_EACH_STABLE_NAME( p, { if (p->addr != NULL) { // Target still alive, Re-hash this stable name insertHashTable(addrToStableHash, (W_)p->addr, (void *)(p - stable_name_table)); } }); } else { FOR_EACH_STABLE_NAME( p, { if (p->addr != p->old) { removeHashTable(addrToStableHash, (W_)p->old, NULL); /* Movement happened: */ if (p->addr != NULL) { insertHashTable(addrToStableHash, (W_)p->addr, (void *)(p - stable_name_table)); } } });  simonm committed Jan 27, 1999 567 568  } }