Stable.c 13.7 KB
 simonm committed Jan 27, 1999 1 2 /* ----------------------------------------------------------------------------- *  simonmar committed Dec 19, 2002 3  * (c) The GHC Team, 1998-2002  simonm committed Jan 27, 1999 4 5 6 7 8  * * Stable names and stable pointers. * * ---------------------------------------------------------------------------*/  simonmar committed Dec 19, 2002 9 10 11 // Make static versions of inline functions in Stable.h: #define RTS_STABLE_C  sewardj committed Aug 14, 2001 12 #include "PosixSource.h"  simonm committed Jan 27, 1999 13 14 15 #include "Rts.h" #include "Hash.h" #include "RtsUtils.h"  simonmar committed Apr 05, 2005 16 #include "OSThreads.h"  simonm committed Jan 27, 1999 17 18 19 #include "Storage.h" #include "RtsAPI.h" #include "RtsFlags.h"  simonmar committed Nov 24, 2005 20 #include "OSThreads.h"  Simon Marlow committed Jun 08, 2006 21 #include "Trace.h"  simonm committed Jan 27, 1999 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 58 59 60 61 62 63 64 65 66 67 68 69 70 71 72 73 74 75 76 77 78  /* 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. 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 deRefStablePtr# :: StablePtr# a -> State# RealWorld -> (# State# RealWorld, a #) \end{verbatim} There may be additional functions on the C side to allow evaluation, application, etc of a stable pointer. */  simonmar committed Jan 28, 2003 79 80 snEntry *stable_ptr_table = NULL; static snEntry *stable_ptr_free = NULL;  simonm committed Jan 27, 1999 81   simonmar committed Jan 28, 2003 82 static unsigned int SPT_size = 0;  simonm committed Jan 27, 1999 83   simonmar committed Nov 24, 2005 84 #ifdef THREADED_RTS  simonmar committed Nov 24, 2005 85 static Mutex stable_mutex;  simonmar committed Nov 24, 2005 86 #endif  simonmar committed Nov 24, 2005 87   simonm committed Jan 27, 1999 88 89 90 91 /* 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 92 93 94  * OLD COMMENTS about reference counting follow. The reference count * in a stable name entry is now just a counter. *  simonm committed Jan 27, 1999 95 96 97 98 99 100 101 102 103 104  * 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 105  * 2^(N-1). The stable name entry keeps a 32-bit reference count, which  simonm committed Jan 27, 1999 106 107 108 109 110 111 112 113 114 115 116 117 118 119 120  * 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 121 static HashTable *addrToStableHash = NULL;  simonm committed Jan 27, 1999 122 123 124  #define INIT_SPT_SIZE 64  sof committed Nov 12, 2003 125 STATIC_INLINE void  simonm committed Jan 27, 1999 126 127 128 129 130 initFreeList(snEntry *table, nat n, snEntry *free) { snEntry *p; for (p = table + n - 1; p >= table; p--) {  sof committed Mar 08, 1999 131  p->addr = (P_)free;  simonmar committed Jul 23, 2001 132  p->old = NULL;  simonmar committed Nov 21, 2001 133  p->ref = 0;  sof committed Mar 08, 1999 134  p->sn_obj = NULL;  simonm committed Jan 27, 1999 135 136 137 138 139 140 141 142  free = p; } stable_ptr_free = table; } void initStablePtrTable(void) {  143 144 145 146 147 148 149 150 151 152 153 154 155 156  if (SPT_size > 0) return; SPT_size = INIT_SPT_SIZE; stable_ptr_table = stgMallocBytes(SPT_size * sizeof(snEntry), "initStablePtrTable"); /* 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. */ initFreeList(stable_ptr_table+1,INIT_SPT_SIZE-1,NULL); addrToStableHash = allocHashTable();  simonmar committed Nov 24, 2005 157 #ifdef THREADED_RTS  simonmar committed Nov 24, 2005 158  initMutex(&stable_mutex);  simonmar committed Nov 24, 2005 159 #endif  simonm committed Jan 27, 1999 160 161 }  Simon Marlow committed Aug 08, 2006 162 163 164 165 166 167 168 169 170 171 172 173 void exitStablePtrTable(void) { if (addrToStableHash) freeHashTable(addrToStableHash, NULL); addrToStableHash = NULL; if (stable_ptr_table) stgFree(stable_ptr_table); stable_ptr_table = NULL; SPT_size = 0; }  sof committed Feb 29, 2000 174 175 176 177 178 179 180 181 182 183 184 /* * get at the real stuff...remove indirections. * * ToDo: move to a better home. */ static StgClosure* removeIndirections(StgClosure* p) { StgClosure* q = p;  panne committed Apr 24, 2000 185 186 187 188 189  while (get_itbl(q)->type == IND || get_itbl(q)->type == IND_STATIC || get_itbl(q)->type == IND_OLDGEN || get_itbl(q)->type == IND_PERM || get_itbl(q)->type == IND_OLDGEN_PERM ) {  sof committed Feb 29, 2000 190 191 192 193 194  q = ((StgInd *)q)->indirectee; } return q; }  simonmar committed Nov 24, 2005 195 196 static StgWord lookupStableName_(StgPtr p)  simonm committed Jan 27, 1999 197 198 { StgWord sn;  panne committed Aug 22, 2004 199  void* sn_tmp;  simonm committed Jan 27, 1999 200 201 202 203  if (stable_ptr_free == NULL) { enlargeStablePtrTable(); }  sof committed Feb 29, 2000 204 205  /* removing indirections increases the likelihood  simonmar committed Jul 23, 2001 206  * of finding a match in the stable name hash table.  sof committed Feb 29, 2000 207 208 209  */ p = (StgPtr)removeIndirections((StgClosure*)p);  panne committed Aug 22, 2004 210 211  sn_tmp = lookupHashTable(addrToStableHash,(W_)p); sn = (StgWord)sn_tmp;  simonm committed Jan 27, 1999 212 213 214  if (sn != 0) { ASSERT(stable_ptr_table[sn].addr == p);  Simon Marlow committed Jun 08, 2006 215  debugTrace(DEBUG_stable, "cached stable name %ld at %p",sn,p);  simonm committed Jan 27, 1999 216 217 218  return sn; } else { sn = stable_ptr_free - stable_ptr_table;  panne committed Aug 22, 2004 219  stable_ptr_free = (snEntry*)(stable_ptr_free->addr);  simonmar committed Nov 21, 2001 220  stable_ptr_table[sn].ref = 0;  simonm committed Jan 27, 1999 221  stable_ptr_table[sn].addr = p;  simonm committed Feb 26, 1999 222  stable_ptr_table[sn].sn_obj = NULL;  Simon Marlow committed Jun 08, 2006 223  /* debugTrace(DEBUG_stable, "new stable name %d at %p\n",sn,p); */  simonm committed Jan 27, 1999 224 225 226 227 228 229 230 231  /* add the new stable name to the hash table */ insertHashTable(addrToStableHash, (W_)p, (void *)sn); return sn; } }  simonmar committed Nov 24, 2005 232 233 234 235 StgWord lookupStableName(StgPtr p) { StgWord res;  236 237  initStablePtrTable();  simonmar committed Nov 24, 2005 238 239 240 241 242 243  ACQUIRE_LOCK(&stable_mutex); res = lookupStableName_(p); RELEASE_LOCK(&stable_mutex); return res; }  sof committed Nov 12, 2003 244 STATIC_INLINE void  simonm committed Jan 27, 1999 245 246 freeStableName(snEntry *sn) {  simonm committed Feb 26, 1999 247  ASSERT(sn->sn_obj == NULL);  simonmar committed Aug 04, 1999 248  if (sn->addr != NULL) {  simonmar committed Nov 21, 2001 249  removeHashTable(addrToStableHash, (W_)sn->addr, NULL);  simonmar committed Aug 04, 1999 250  }  simonm committed Jan 27, 1999 251 252 253 254 255 256 257  sn->addr = (P_)stable_ptr_free; stable_ptr_free = sn; } StgStablePtr getStablePtr(StgPtr p) {  simonmar committed Nov 21, 2001 258 259  StgWord sn;  260  initStablePtrTable();  simonmar committed Nov 24, 2005 261 262  ACQUIRE_LOCK(&stable_mutex); sn = lookupStableName_(p);  simonmar committed Nov 21, 2001 263  stable_ptr_table[sn].ref++;  simonmar committed Nov 24, 2005 264  RELEASE_LOCK(&stable_mutex);  simonmar committed Nov 21, 2001 265  return (StgStablePtr)(sn);  simonm committed Jan 27, 1999 266 267 }  sewardj committed Dec 20, 2001 268 269 270 void freeStablePtr(StgStablePtr sp) {  simonmar committed Nov 24, 2005 271 272  snEntry *sn;  273  initStablePtrTable();  simonmar committed Nov 24, 2005 274 275 276  ACQUIRE_LOCK(&stable_mutex); sn = &stable_ptr_table[(StgWord)sp];  sewardj committed Dec 20, 2001 277   simonmar committed Apr 09, 2002 278 279 280 281 282 283 284  ASSERT((StgWord)sp < SPT_size && sn->addr != NULL && sn->ref > 0); sn->ref--; // If this entry has no StableName attached, then just free it // immediately. This is important; it might be a while before the // next major GC which actually collects the entry.  simonmar committed Apr 24, 2002 285  if (sn->sn_obj == NULL && sn->ref == 0) {  simonmar committed Apr 09, 2002 286 287  freeStableName(sn); }  simonmar committed Nov 24, 2005 288 289  RELEASE_LOCK(&stable_mutex);  sewardj committed Dec 20, 2001 290 291 }  simonm committed Jan 27, 1999 292 293 294 295 void enlargeStablePtrTable(void) { nat old_SPT_size = SPT_size;  296   simonmar committed Jul 23, 2001 297  // 2nd and subsequent times  298 299 300  SPT_size *= 2; stable_ptr_table = stgReallocBytes(stable_ptr_table,  sof committed Mar 31, 2003 301  SPT_size * sizeof(snEntry),  simonm committed Jan 27, 1999 302  "enlargeStablePtrTable");  sof committed Mar 31, 2003 303   304  initFreeList(stable_ptr_table + old_SPT_size, old_SPT_size, NULL);  simonm committed Jan 27, 1999 305 306 307 308 309 } /* ----------------------------------------------------------------------------- * Treat stable pointers as roots for the garbage collector. *  simonmar committed Nov 21, 2001 310  * A stable pointer is any stable name entry with a ref > 0. We'll  simonm committed Jan 27, 1999 311 312 313 314  * take the opportunity to zero the "keep" flags at the same time. * -------------------------------------------------------------------------- */ void  simonmar committed Jul 23, 2001 315 markStablePtrTable(evac_fn evac)  simonm committed Jan 27, 1999 316 {  simonmar committed Jul 23, 2001 317 318 319 320 321 322 323 324 325 326  snEntry *p, *end_stable_ptr_table; StgPtr q; end_stable_ptr_table = &stable_ptr_table[SPT_size]; // Mark all the stable *pointers* (not stable names). // _starting_ at index 1; index 0 is unused. for (p = stable_ptr_table+1; p < end_stable_ptr_table; p++) { q = p->addr;  simonmar committed Aug 08, 2001 327 328 329  // Internal pointers are free slots. If q == NULL, it's a // stable name where the object has been GC'd, but the // StableName object (sn_obj) is still alive.  simonmar committed Jul 23, 2001 330 331 332 333 334 335 336  if (q && (q < (P_)stable_ptr_table || q >= (P_)end_stable_ptr_table)) { // save the current addr away: we need to be able to tell // whether the objects moved in order to be able to update // the hash table later. p->old = p->addr;  simonmar committed Nov 21, 2001 337 338  // if the ref is non-zero, treat addr as a root if (p->ref != 0) {  simonmar committed Jul 23, 2001 339 340 341 342 343  evac((StgClosure **)&p->addr); } } } }  simonm committed Jan 27, 1999 344   simonmar committed Jul 23, 2001 345 346 347 348 349 350 351 /* ----------------------------------------------------------------------------- * Thread the stable pointer table for compacting GC. * * Here we must call the supplied evac function for each pointer into * the heap from the stable pointer table, because the compacting * collector may move the object it points to. * -------------------------------------------------------------------------- */  simonm committed Jan 27, 1999 352   simonmar committed Jul 23, 2001 353 354 355 356 357 358 359 360 361 362 void threadStablePtrTable( evac_fn evac ) { snEntry *p, *end_stable_ptr_table; StgPtr q; end_stable_ptr_table = &stable_ptr_table[SPT_size]; for (p = stable_ptr_table+1; p < end_stable_ptr_table; p++) {  simonmar committed Aug 08, 2001 363 364 365 366 367  if (p->sn_obj != NULL) { evac((StgClosure **)&p->sn_obj); } q = p->addr;  simonmar committed Jul 23, 2001 368  if (q && (q < (P_)stable_ptr_table || q >= (P_)end_stable_ptr_table)) {  simonmar committed Aug 08, 2001 369  evac((StgClosure **)&p->addr);  simonm committed Jan 27, 1999 370 371 372 373 374 375 376 377 378  } } } /* ----------------------------------------------------------------------------- * Garbage collect any dead entries in the stable pointer table. * * A dead entry has: *  simonmar committed Nov 21, 2001 379  * - a zero reference count  simonm committed Feb 26, 1999 380  * - a dead sn_obj  simonm committed Jan 27, 1999 381  *  simonm committed Feb 26, 1999 382 383 384 385  * 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 386 387 388 389 390 391 392 393 394 395 396 397 398 399 400 401 402 403  * -------------------------------------------------------------------------- */ void gcStablePtrTable( void ) { snEntry *p, *end_stable_ptr_table; StgPtr q; end_stable_ptr_table = &stable_ptr_table[SPT_size]; // NOTE: _starting_ at index 1; index 0 is unused. for (p = stable_ptr_table + 1; p < end_stable_ptr_table; p++) { // Update the pointer to the StableName object, if there is one if (p->sn_obj != NULL) { p->sn_obj = isAlive(p->sn_obj); }  simonmar committed Aug 08, 2001 404 405 406  // Internal pointers are free slots. If q == NULL, it's a // stable name where the object has been GC'd, but the // StableName object (sn_obj) is still alive.  simonmar committed Jul 23, 2001 407 408 409 410  q = p->addr; if (q && (q < (P_)stable_ptr_table || q >= (P_)end_stable_ptr_table)) { // StableNames only:  simonmar committed Nov 21, 2001 411  if (p->ref == 0) {  simonmar committed Jul 23, 2001 412 413 414  if (p->sn_obj == NULL) { // StableName object is dead freeStableName(p);  sven.panne@aedion.de committed Aug 10, 2006 415 416  debugTrace(DEBUG_stable, "GC'd Stable name %ld", (long)(p - stable_ptr_table));  simonmar committed Jul 23, 2001 417 418 419  continue; } else {  panne committed Aug 22, 2004 420  p->addr = (StgPtr)isAlive((StgClosure *)p->addr);  Simon Marlow committed Jun 08, 2006 421 422  debugTrace(DEBUG_stable, "stable name %ld still alive at %p, ref %ld\n",  sven.panne@aedion.de committed Aug 10, 2006 423  (long)(p - stable_ptr_table), p->addr, p->ref);  simonmar committed Jul 23, 2001 424 425 426 427 428 429 430 431  } } } } } /* ----------------------------------------------------------------------------- * Update the StablePtr/StableName hash table  simonm committed Jan 27, 1999 432 433 434 435 436 437 438 439  * * 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  simonmar committed Jul 23, 2001 440 updateStablePtrTable(rtsBool full)  simonm committed Jan 27, 1999 441 {  simonmar committed Jul 23, 2001 442 443 444 445 446  snEntry *p, *end_stable_ptr_table; if (full && addrToStableHash != NULL) { freeHashTable(addrToStableHash,NULL); addrToStableHash = allocHashTable();  simonm committed Feb 26, 1999 447  }  simonmar committed Jul 23, 2001 448 449 450 451 452  end_stable_ptr_table = &stable_ptr_table[SPT_size]; // NOTE: _starting_ at index 1; index 0 is unused. for (p = stable_ptr_table + 1; p < end_stable_ptr_table; p++) {  simonm committed Jan 27, 1999 453   simonmar committed Jul 23, 2001 454 455 456 457 458 459 460 461 462 463 464  if (p->addr == NULL) { if (p->old != NULL) { // The target has been garbage collected. Remove its // entry from the hash table. removeHashTable(addrToStableHash, (W_)p->old, NULL); p->old = NULL; } } else if (p->addr < (P_)stable_ptr_table || p->addr >= (P_)end_stable_ptr_table) { // Target still alive, Re-hash this stable name  simonm committed Feb 26, 1999 465  if (full) {  simonmar committed Jul 23, 2001 466 467 468 469 470 471  insertHashTable(addrToStableHash, (W_)p->addr, (void *)(p - stable_ptr_table)); } else if (p->addr != p->old) { removeHashTable(addrToStableHash, (W_)p->old, NULL); insertHashTable(addrToStableHash, (W_)p->addr, (void *)(p - stable_ptr_table));  simonm committed Feb 26, 1999 472  }  simonm committed Jan 27, 1999 473 474 475  } } }