ghc/rts/Storage.h

   1 /* -----------------------------------------------------------------------------
   2  * $Id: Storage.h,v 1.44 2002/03/26 23:56:44 sof Exp $
   3  *
   4  * (c) The GHC Team, 1998-1999
   5  *
   6  * External Storage Manger Interface
   7  *
   8  * ---------------------------------------------------------------------------*/
   9
  10 #ifndef STORAGE_H
  11 #define STORAGE_H
  12
  13 #include "Block.h"
  14 #include "MBlock.h"
  15 #include "BlockAlloc.h"
  16 #include "StoragePriv.h"
  17 #ifdef PROFILING
  18 #include "LdvProfile.h"
  19 #endif
  20
  21 /* -----------------------------------------------------------------------------
  22    Initialisation / De-initialisation
  23    -------------------------------------------------------------------------- */
  24
  25 extern void initStorage(void);
  26 extern void exitStorage(void);
  27
  28 /* -----------------------------------------------------------------------------
  29    Generic allocation
  30
  31    StgPtr allocate(nat n)       Allocates a chunk of contiguous store
  32                                 n words long, returning a pointer to
  33                                 the first word.  Always succeeds.
  34
  35    StgPtr allocatePinned(nat n) Allocates a chunk of contiguous store
  36                                 n words long, which is at a fixed
  37                                 address (won't be moved by GC).
  38                                 Returns a pointer to the first word.
  39                                 Always succeeds.
  40
  41                                 NOTE: the GC can't in general handle
  42                                 pinned objects, so allocatePinned()
  43                                 can only be used for ByteArrays at the
  44                                 moment.
  45
  46                                 Don't forget to TICK_ALLOC_XXX(...)
  47                                 after calling allocate or
  48                                 allocatePinned, for the
  49                                 benefit of the ticky-ticky profiler.
  50
  51    rtsBool doYouWantToGC(void)  Returns True if the storage manager is
  52                                 ready to perform a GC, False otherwise.
  53
  54    lnat  allocated_bytes(void)  Returns the number of bytes allocated
  55                                 via allocate() since the last GC.
  56                                 Used in the reoprting of statistics.
  57
  58    SMP: allocate and doYouWantToGC can be used from STG code, they are
  59    surrounded by a mutex.
  60    -------------------------------------------------------------------------- */
  61
  62 extern StgPtr  allocate        ( nat n );
  63 extern StgPtr  allocatePinned  ( nat n );
  64 extern lnat    allocated_bytes ( void );
  65
  66 static inline rtsBool
  67 doYouWantToGC( void )
  68 {
  69   return (alloc_blocks >= alloc_blocks_lim);
  70 }
  71
  72 /* -----------------------------------------------------------------------------
  73    ExtendNursery(hp,hplim)      When hplim is reached, try to grab
  74                                 some more allocation space.  Returns
  75                                 False if the allocation space is
  76                                 exhausted, and the application should
  77                                 call GarbageCollect().
  78   -------------------------------------------------------------------------- */
  79
  80 #define ExtendNursery(hp,hplim)                 \
  81   (CurrentNursery->free = (P_)(hp)+1,           \
  82    CurrentNursery->link == NULL ? rtsFalse :    \
  83    (CurrentNursery = CurrentNursery->link,      \
  84     OpenNursery(hp,hplim),                      \
  85     rtsTrue))
  86
  87 extern void PleaseStopAllocating(void);
  88
  89 /* -----------------------------------------------------------------------------
  90    Performing Garbage Collection
  91
  92    GarbageCollect(get_roots)    Performs a garbage collection.
  93                                 'get_roots' is called to find all the
  94                                 roots that the system knows about.
  95
  96    StgClosure                   Called by get_roots on each root.
  97    MarkRoot(StgClosure *p)      Returns the new location of the root.
  98    -------------------------------------------------------------------------- */
  99
 100 extern void GarbageCollect(void (*get_roots)(evac_fn),rtsBool force_major_gc);
 101
 102 /* -----------------------------------------------------------------------------
 103    Generational garbage collection support
 104
 105    recordMutable(StgPtr p)       Informs the garbage collector that a
 106                                  previously immutable object has
 107                                  become (permanently) mutable.  Used
 108                                  by thawArray and similar.
 109
 110    updateWithIndirection(p1,p2)  Updates the object at p1 with an
 111                                  indirection pointing to p2.  This is
 112                                  normally called for objects in an old
 113                                  generation (>0) when they are updated.
 114
 115    updateWithPermIndirection(p1,p2)  As above but uses a permanent indir.
 116
 117    -------------------------------------------------------------------------- */
 118
 119 /*
 120  * Storage manager mutex
 121  */
 122 #if defined(SMP)
 123 extern Mutex sm_mutex;
 124 #define ACQUIRE_SM_LOCK   ACQUIRE_LOCK(&sm_mutex)
 125 #define RELEASE_SM_LOCK   RELEASE_LOCK(&sm_mutex)
 126 #else
 127 #define ACQUIRE_SM_LOCK
 128 #define RELEASE_SM_LOCK
 129 #endif
 130
 131 /* ToDo: shouldn't recordMutable and recordOldToNewPtrs acquire some
 132  * kind of lock in the SMP case?
 133  */
 134 static inline void
 135 recordMutable(StgMutClosure *p)
 136 {
 137   bdescr *bd;
 138
 139 #ifdef SMP
 140   ASSERT(p->header.info == &stg_WHITEHOLE_info || closure_MUTABLE(p));
 141 #else
 142   ASSERT(closure_MUTABLE(p));
 143 #endif
 144
 145   bd = Bdescr((P_)p);
 146   if (bd->gen_no > 0) {
 147     p->mut_link = generations[bd->gen_no].mut_list;
 148     generations[bd->gen_no].mut_list = p;
 149   }
 150 }
 151
 152 static inline void
 153 recordOldToNewPtrs(StgMutClosure *p)
 154 {
 155   bdescr *bd;
 156
 157   bd = Bdescr((P_)p);
 158   if (bd->gen_no > 0) {
 159     p->mut_link = generations[bd->gen_no].mut_once_list;
 160     generations[bd->gen_no].mut_once_list = p;
 161   }
 162 }
 163
 164 // @LDV profiling
 165 // We zero out the slop when PROFILING is on.
 166 // #ifndef DEBUG
 167 #if !defined(DEBUG) && !defined(PROFILING)
 168 #define updateWithIndirection(info, p1, p2)                             \
 169   {                                                                     \
 170     bdescr *bd;                                                         \
 171                                                                         \
 172     bd = Bdescr((P_)p1);                                                \
 173     if (bd->gen_no == 0) {                                              \
 174       ((StgInd *)p1)->indirectee = p2;                                  \
 175       SET_INFO(p1,&stg_IND_info);                                       \
 176       TICK_UPD_NEW_IND();                                               \
 177     } else {                                                            \
 178       ((StgIndOldGen *)p1)->indirectee = p2;                            \
 179       if (info != &stg_BLACKHOLE_BQ_info) {                             \
 180         ACQUIRE_SM_LOCK;                                                \
 181         ((StgIndOldGen *)p1)->mut_link = generations[bd->gen_no].mut_once_list; \
 182         generations[bd->gen_no].mut_once_list = (StgMutClosure *)p1;                    \
 183         RELEASE_SM_LOCK;                                                \
 184       }                                                                 \
 185       SET_INFO(p1,&stg_IND_OLDGEN_info);                                \
 186       TICK_UPD_OLD_IND();                                               \
 187     }                                                                   \
 188   }
 189 #elif defined(PROFILING)
 190 // @LDV profiling
 191 // We call LDV_recordDead_FILL_SLOP_DYNAMIC(p1) regardless of the generation in
 192 // which p1 resides.
 193 //
 194 // Note:
 195 //   After all, we do *NOT* need to call LDV_recordCreate() for both IND and
 196 //   IND_OLDGEN closures because they are inherently used. But, it corrupts
 197 //   the invariants that every closure keeps its creation time in the profiling
 198 //   field. So, we call LDV_recordCreate().
 199
 200 #define updateWithIndirection(info, p1, p2)                             \
 201   {                                                                     \
 202     bdescr *bd;                                                         \
 203                                                                         \
 204     LDV_recordDead_FILL_SLOP_DYNAMIC((p1));                             \
 205     bd = Bdescr((P_)p1);                                                \
 206     if (bd->gen_no == 0) {                                              \
 207       ((StgInd *)p1)->indirectee = p2;                                  \
 208       SET_INFO(p1,&stg_IND_info);                                       \
 209       LDV_recordCreate((p1));                                           \
 210       TICK_UPD_NEW_IND();                                               \
 211     } else {                                                            \
 212       ((StgIndOldGen *)p1)->indirectee = p2;                            \
 213       if (info != &stg_BLACKHOLE_BQ_info) {                             \
 214         ACQUIRE_SM_LOCK;                                                \
 215         ((StgIndOldGen *)p1)->mut_link = generations[bd->gen_no].mut_once_list; \
 216         generations[bd->gen_no].mut_once_list = (StgMutClosure *)p1;    \
 217         RELEASE_SM_LOCK;                                                \
 218       }                                                                 \
 219       SET_INFO(p1,&stg_IND_OLDGEN_info);                                \
 220       LDV_recordCreate((p1));                                           \
 221     }                                                                   \
 222   }
 223
 224 #else
 225
 226 /* In the DEBUG case, we also zero out the slop of the old closure,
 227  * so that the sanity checker can tell where the next closure is.
 228  *
 229  * Two important invariants: we should never try to update a closure
 230  * to point to itself, and the closure being updated should not
 231  * already have been updated (the mutable list will get messed up
 232  * otherwise).
 233  */
 234 #define updateWithIndirection(info, p1, p2)                             \
 235   {                                                                     \
 236     bdescr *bd;                                                         \
 237                                                                         \
 238     ASSERT( p1 != p2 && !closure_IND(p1) );                             \
 239     bd = Bdescr((P_)p1);                                                \
 240     if (bd->gen_no == 0) {                                              \
 241       ((StgInd *)p1)->indirectee = p2;                                  \
 242       SET_INFO(p1,&stg_IND_info);                                       \
 243       TICK_UPD_NEW_IND();                                               \
 244     } else {                                                            \
 245       if (info != &stg_BLACKHOLE_BQ_info) {                             \
 246         {                                                               \
 247           StgInfoTable *inf = get_itbl(p1);                             \
 248           nat np = inf->layout.payload.ptrs,                            \
 249               nw = inf->layout.payload.nptrs, i;                        \
 250           if (inf->type != THUNK_SELECTOR) {                            \
 251              for (i = np; i < np + nw; i++) {                           \
 252                 ((StgClosure *)p1)->payload[i] = 0;                     \
 253              }                                                          \
 254           }                                                             \
 255         }                                                               \
 256         ACQUIRE_SM_LOCK;                                                \
 257         ((StgIndOldGen *)p1)->mut_link = generations[bd->gen_no].mut_once_list; \
 258         generations[bd->gen_no].mut_once_list = (StgMutClosure *)p1;                    \
 259         RELEASE_SM_LOCK;                                                \
 260       }                                                                 \
 261       ((StgIndOldGen *)p1)->indirectee = p2;                            \
 262       SET_INFO(p1,&stg_IND_OLDGEN_info);                                \
 263       TICK_UPD_OLD_IND();                                               \
 264     }                                                                   \
 265   }
 266 #endif
 267
 268 /* Static objects all live in the oldest generation
 269  */
 270 #define updateWithStaticIndirection(info, p1, p2)                       \
 271   {                                                                     \
 272     ASSERT( p1 != p2 && !closure_IND(p1) );                             \
 273     ASSERT( ((StgMutClosure*)p1)->mut_link == NULL );                   \
 274                                                                         \
 275     ACQUIRE_SM_LOCK;                                                    \
 276     ((StgMutClosure *)p1)->mut_link = oldest_gen->mut_once_list;        \
 277     oldest_gen->mut_once_list = (StgMutClosure *)p1;                    \
 278     RELEASE_SM_LOCK;                                                    \
 279                                                                         \
 280     ((StgInd *)p1)->indirectee = p2;                                    \
 281     SET_INFO((StgInd *)p1, &stg_IND_STATIC_info);                       \
 282     TICK_UPD_STATIC_IND();                                              \
 283   }
 284
 285 #if defined(TICKY_TICKY) || defined(PROFILING)
 286 static inline void
 287 updateWithPermIndirection(const StgInfoTable *info, StgClosure *p1, StgClosure *p2)
 288 {
 289   bdescr *bd;
 290
 291   ASSERT( p1 != p2 && !closure_IND(p1) );
 292
 293 #ifdef PROFILING
 294   // @LDV profiling
 295   // Destroy the old closure.
 296   // Nb: LDV_* stuff cannot mix with ticky-ticky
 297   LDV_recordDead_FILL_SLOP_DYNAMIC(p1);
 298 #endif
 299   bd = Bdescr((P_)p1);
 300   if (bd->gen_no == 0) {
 301     ((StgInd *)p1)->indirectee = p2;
 302     SET_INFO(p1,&stg_IND_PERM_info);
 303 #ifdef PROFILING
 304     // @LDV profiling
 305     // We have just created a new closure.
 306     LDV_recordCreate(p1);
 307 #endif
 308     TICK_UPD_NEW_PERM_IND(p1);
 309   } else {
 310     ((StgIndOldGen *)p1)->indirectee = p2;
 311     if (info != &stg_BLACKHOLE_BQ_info) {
 312       ACQUIRE_SM_LOCK;
 313       ((StgIndOldGen *)p1)->mut_link = generations[bd->gen_no].mut_once_list;
 314       generations[bd->gen_no].mut_once_list = (StgMutClosure *)p1;
 315       RELEASE_SM_LOCK;
 316     }
 317     SET_INFO(p1,&stg_IND_OLDGEN_PERM_info);
 318 #ifdef PROFILING
 319     // @LDV profiling
 320     // We have just created a new closure.
 321     LDV_recordCreate(p1);
 322 #endif
 323     TICK_UPD_OLD_PERM_IND();
 324   }
 325 }
 326 #endif
 327
 328 /* -----------------------------------------------------------------------------
 329    The CAF table - used to let us revert CAFs
 330    -------------------------------------------------------------------------- */
 331
 332 void revertCAFs( void );
 333
 334 #if defined(DEBUG)
 335 void printMutOnceList(generation *gen);
 336 void printMutableList(generation *gen);
 337 #endif /* DEBUG */
 338
 339 /* --------------------------------------------------------------------------
 340                       Address space layout macros
 341    --------------------------------------------------------------------------
 342
 343    Here are the assumptions GHC makes about address space layout.
 344    Broadly, it thinks there are three sections:
 345
 346      CODE    Read-only.  Contains code and read-only data (such as
 347                 info tables)
 348              Also called "text"
 349
 350      DATA    Read-write data.  Contains static closures (and on some
 351                 architectures, info tables too)
 352
 353      HEAP    Dynamically-allocated closures
 354
 355      USER    None of the above.  The only way USER things arise right
 356              now is when GHCi allocates a constructor info table, which
 357              it does by mallocing them.
 358
 359    Three macros identify these three areas:
 360      IS_DATA(p), HEAP_ALLOCED(p)
 361
 362    HEAP_ALLOCED is called FOR EVERY SINGLE CLOSURE during GC.
 363    It needs to be FAST.
 364
 365    Implementation of HEAP_ALLOCED
 366    ~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~
 367    Concerning HEAP, most of the time (certainly under [Static] and [GHCi],
 368    we ensure that the heap is allocated above some fixed address HEAP_BASE
 369    (defined in MBlock.h).  In this case we set TEXT_BEFORE_HEAP, and we
 370    get a nice fast test.
 371
 372    Sometimes we can't be quite sure.  For example in Windows, we can't
 373    fix where our heap address space comes from.  In this case we un-set
 374    TEXT_BEFORE_HEAP. That makes it more expensive to test whether a pointer
 375    comes from the HEAP section, because we need to look at the allocator's
 376    address maps (see HEAP_ALLOCED macro)
 377
 378    Implementation of CODE and DATA
 379    ~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~
 380    Concerning CODE and DATA, there are three main regimes:
 381
 382      [Static] Totally      The segments are contiguous, and laid out
 383      statically linked     exactly as above
 384
 385      [GHCi] Static,        GHCi may load new modules, but it knows the
 386      except for GHCi       address map, so for any given address it can
 387                            still tell which section it belongs to
 388
 389      [DLL] OS-supported    Chunks of CODE and DATA may be mixed in
 390      dynamic loading       the address space, and we can't tell how
 391
 392
 393    For the [Static] case, we assume memory is laid out like this
 394    (in order of increasing addresses)
 395
 396        Start of memory
 397            CODE section
 398        TEXT_SECTION_END_MARKER   (usually _etext)
 399            DATA section
 400        DATA_SECTION_END_MARKER   (usually _end)
 401            USER section
 402        HEAP_BASE
 403            HEAP section
 404
 405    For the [GHCi] case, we have to consult GHCi's dynamic linker's
 406    address maps, which is done by macros
 407          is_dynamically_loaded_code_or_rodata_ptr
 408          is_dynamically_loaded_code_or_rwdata_ptr
 409
 410    For the [DLL] case, IS_DATA is really not usable at all.
 411  */
 412
 413
 414 #undef TEXT_BEFORE_HEAP
 415 #if !defined(mingw32_TARGET_OS) && !defined(cygwin32_TARGET_OS)
 416 #define TEXT_BEFORE_HEAP 1
 417 #endif
 418
 419 extern void* TEXT_SECTION_END_MARKER_DECL;
 420 extern void* DATA_SECTION_END_MARKER_DECL;
 421
 422 #ifdef darwin_TARGET_OS
 423 extern unsigned long macho_etext;
 424 extern unsigned long macho_edata;
 425 #define IS_CODE_PTR(p) (  ((P_)(p) < (P_)macho_etext) \
 426                        || is_dynamically_loaded_code_or_rodata_ptr((char *)p) )
 427 #define IS_DATA_PTR(p) ( ((P_)(p) >= (P_)macho_etext && \
 428                           (P_)(p) < (P_)macho_edata) \
 429                        || is_dynamically_loaded_rwdata_ptr((char *)p) )
 430 #define IS_USER_PTR(p) ( ((P_)(p) >= (P_)macho_edata) \
 431                        && is_not_dynamically_loaded_ptr((char *)p) )
 432 #else
 433 /* Take into account code sections in dynamically loaded object files. */
 434 #define IS_DATA_PTR(p) ( ((P_)(p) >= (P_)&TEXT_SECTION_END_MARKER && \
 435                           (P_)(p) < (P_)&DATA_SECTION_END_MARKER) \
 436                        || is_dynamically_loaded_rwdata_ptr((char *)p) )
 437 #define IS_USER_PTR(p) ( ((P_)(p) >= (P_)&DATA_SECTION_END_MARKER) \
 438                        && is_not_dynamically_loaded_ptr((char *)p) )
 439 #endif
 440
 441 /* The HEAP_ALLOCED test below is called FOR EVERY SINGLE CLOSURE
 442  * during GC.  It needs to be FAST.
 443  *
 444  * BEWARE: when we're dynamically loading code (for GHCi), make sure
 445  * that we don't load any code above HEAP_BASE, or this test won't work.
 446  */
 447 #ifdef TEXT_BEFORE_HEAP
 448 # define HEAP_ALLOCED(x)  ((StgPtr)(x) >= (StgPtr)(HEAP_BASE))
 449 #else
 450 /* mingw, really */
 451 # define HEAP_ALLOCED(x)  (is_heap_alloced(x))
 452 #endif
 453
 454
 455 /* --------------------------------------------------------------------------
 456    Macros for distinguishing data pointers from code pointers
 457    --------------------------------------------------------------------------
 458
 459   Specification
 460   ~~~~~~~~~~~~~
 461   The garbage collector needs to make some critical distinctions between pointers.
 462   In particular we need
 463
 464      LOOKS_LIKE_GHC_INFO(p)          p points to an info table
 465
 466   For both of these macros, p is
 467       *either* a pointer to a closure (static or heap allocated)
 468       *or* a return address on the (Haskell) stack
 469
 470   (Return addresses are in fact info-pointers, so that the Haskell stack
 471   looks very like a chunk of heap.)
 472
 473   The garbage collector uses LOOKS_LIKE_GHC_INFO when walking the stack, as it
 474   walks over the "pending arguments" on its way to the next return address.
 475   It is called moderately often, but not as often as HEAP_ALLOCED
 476
 477   ToDo: LOOKS_LIKE_GHC_INFO(p) does not return True when p points to a
 478   constructor info table allocated by GHCi.  We should really rename
 479   LOOKS_LIKE_GHC_INFO to LOOKS_LIKE_GHC_RETURN_INFO.
 480
 481   Implementation
 482   ~~~~~~~~~~~~~~
 483   LOOKS_LIKE_GHC_INFO is more complicated because of the need to distinguish
 484   between static closures and info tables.  It's a known portability problem.
 485   We have three approaches:
 486
 487   Plan A: Address-space partitioning.
 488     keep static closures in the (single, contiguous) data segment: IS_DATA_PTR(p)
 489
 490   Plan A can fail for two reasons:
 491     * In many environments (eg. dynamic loading),
 492       text and data aren't in a single contiguous range.
 493     * When we compile through vanilla C (no mangling) we sometimes
 494       can't guaranteee to put info tables in the text section.  This
 495       happens eg. on MacOS where the C compiler refuses to put const
 496       data in the text section if it has any code pointers in it
 497       (which info tables do *only* when we're compiling without
 498       TABLES_NEXT_TO_CODE).
 499
 500   Hence, Plan B: (compile-via-C-with-mangling, or native code generation)
 501     Put a zero word before each static closure.
 502     When compiling to native code, or via C-with-mangling, info tables
 503     are laid out "backwards" from the address specified in the info pointer
 504     (the entry code goes forward from the info pointer).  Hence, the word
 505     before the one referenced the info pointer is part of the info table,
 506     and is guaranteed non-zero.
 507
 508     For reasons nobody seems to fully understand, the statically-allocated tables
 509     of INTLIKE and CHARLIKE closures can't have this zero word, so we
 510     have to test separately for them.
 511
 512     Plan B fails altogether for the compile-through-vanilla-C route, because
 513     info tables aren't laid out backwards.
 514
 515
 516   Hence, Plan C: (unregisterised, compile-through-vanilla-C route only)
 517     If we didn't manage to get info tables into the text section, then
 518     we can distinguish between a static closure pointer and an info
 519     pointer as follows:  the first word of an info table is a code pointer,
 520     and therefore in text space, whereas the first word of a closure pointer
 521     is an info pointer, and therefore not.  Shazam!
 522 */
 523
 524
 525 /* When working with Win32 DLLs, static closures are identified by
 526    being prefixed with a zero word. This is needed so that we can
 527    distinguish between pointers to static closures and (reversed!)
 528    info tables.
 529
 530    This 'scheme' breaks down for closure tables such as CHARLIKE,
 531    so we catch these separately.
 532
 533    LOOKS_LIKE_STATIC_CLOSURE()
 534        - discriminates between static closures and info tbls
 535          (needed by LOOKS_LIKE_GHC_INFO() below - [Win32 DLLs only.])
 536    LOOKS_LIKE_STATIC()
 537        - distinguishes between static and heap allocated data.
 538  */
 539 #if defined(ENABLE_WIN32_DLL_SUPPORT)
 540             /* definitely do not enable for mingw DietHEP */
 541 #define LOOKS_LIKE_STATIC(r) (!(HEAP_ALLOCED(r)))
 542
 543 /* Tiresome predicates needed to check for pointers into the closure tables */
 544 #define IS_CHARLIKE_CLOSURE(p) \
 545     ( (P_)(p) >= (P_)stg_CHARLIKE_closure && \
 546       (char*)(p) <= ((char*)stg_CHARLIKE_closure + \
 547                      (MAX_CHARLIKE-MIN_CHARLIKE) * sizeof(StgIntCharlikeClosure)) )
 548 #define IS_INTLIKE_CLOSURE(p) \
 549     ( (P_)(p) >= (P_)stg_INTLIKE_closure && \
 550       (char*)(p) <= ((char*)stg_INTLIKE_closure + \
 551                      (MAX_INTLIKE-MIN_INTLIKE) * sizeof(StgIntCharlikeClosure)) )
 552
 553 #define LOOKS_LIKE_STATIC_CLOSURE(r) (((*(((unsigned long *)(r))-1)) == 0) || IS_CHARLIKE_CLOSURE(r) || IS_INTLIKE_CLOSURE(r))
 554
 555 #elif defined(darwin_TARGET_OS) && !defined(TABLES_NEXT_TO_CODE)
 556
 557 #define LOOKS_LIKE_STATIC(r) (!(HEAP_ALLOCED(r)))
 558 #define LOOKS_LIKE_STATIC_CLOSURE(r) (IS_DATA_PTR(r) && !LOOKS_LIKE_GHC_INFO(r))
 559
 560 #else
 561
 562 #define LOOKS_LIKE_STATIC(r) IS_DATA_PTR(r)
 563 #define LOOKS_LIKE_STATIC_CLOSURE(r) IS_DATA_PTR(r)
 564
 565 #endif
 566
 567
 568 /* -----------------------------------------------------------------------------
 569    Macros for distinguishing infotables from closures.
 570
 571    You'd think it'd be easy to tell an info pointer from a closure pointer:
 572    closures live on the heap and infotables are in read only memory.  Right?
 573    Wrong!  Static closures live in read only memory and Hugs allocates
 574    infotables for constructors on the (writable) C heap.
 575    -------------------------------------------------------------------------- */
 576
 577 /* not accurate by any means, but stops the assertions failing... */
 578 /* TODO TODO TODO TODO TODO TODO TODO TODO TODO TODO TODO TODO */
 579 #define IS_HUGS_CONSTR_INFO(info)  IS_USER_PTR(info)
 580
 581 /* LOOKS_LIKE_GHC_INFO is called moderately often during GC, but
 582  * Certainly not as often as HEAP_ALLOCED.
 583  */
 584 #if defined(darwin_TARGET_OS) && !defined(TABLES_NEXT_TO_CODE)
 585         /* Plan C, see above */
 586 #define LOOKS_LIKE_GHC_INFO(info) IS_CODE_PTR(((StgInfoTable *)info).entry)
 587 #else
 588 #define LOOKS_LIKE_GHC_INFO(info) (!HEAP_ALLOCED(info) \
 589                                    && !LOOKS_LIKE_STATIC_CLOSURE(info))
 590 #endif
 591
 592 /* -----------------------------------------------------------------------------
 593    Macros for calculating how big a closure will be (used during allocation)
 594    -------------------------------------------------------------------------- */
 595
 596 static __inline__ StgOffset AP_sizeW    ( nat n_args )
 597 { return sizeofW(StgAP_UPD) + n_args; }
 598
 599 static __inline__ StgOffset PAP_sizeW   ( nat n_args )
 600 { return sizeofW(StgPAP)    + n_args; }
 601
 602 static __inline__ StgOffset CONSTR_sizeW( nat p, nat np )
 603 { return sizeofW(StgHeader) + p + np; }
 604
 605 static __inline__ StgOffset THUNK_SELECTOR_sizeW ( void )
 606 { return sizeofW(StgHeader) + MIN_UPD_SIZE; }
 607
 608 static __inline__ StgOffset BLACKHOLE_sizeW ( void )
 609 { return sizeofW(StgHeader) + MIN_UPD_SIZE; }
 610
 611 /* --------------------------------------------------------------------------
 612  * Sizes of closures
 613  * ------------------------------------------------------------------------*/
 614
 615 static __inline__ StgOffset sizeW_fromITBL( const StgInfoTable* itbl )
 616 { return sizeofW(StgClosure)
 617        + sizeofW(StgPtr)  * itbl->layout.payload.ptrs
 618        + sizeofW(StgWord) * itbl->layout.payload.nptrs; }
 619
 620 static __inline__ StgOffset pap_sizeW( StgPAP* x )
 621 { return PAP_sizeW(x->n_args); }
 622
 623 static __inline__ StgOffset arr_words_sizeW( StgArrWords* x )
 624 { return sizeofW(StgArrWords) + x->words; }
 625
 626 static __inline__ StgOffset mut_arr_ptrs_sizeW( StgMutArrPtrs* x )
 627 { return sizeofW(StgMutArrPtrs) + x->ptrs; }
 628
 629 static __inline__ StgWord tso_sizeW ( StgTSO *tso )
 630 { return TSO_STRUCT_SIZEW + tso->stack_size; }
 631
 632 #endif /* STORAGE_H */
 633