ghc/rts/Storage.h

   1 /* -----------------------------------------------------------------------------
   2  * $Id: Storage.h,v 1.53 2003/11/12 17:49:11 sof Exp $
   3  *
   4  * (c) The GHC Team, 1998-2002
   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 reporting 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 INLINE_HEADER 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   (CloseNursery(hp),                            \
  82    CurrentNursery->link == NULL ? rtsFalse :    \
  83    (CurrentNursery = CurrentNursery->link,      \
  84     OpenNursery(hp,hplim),                      \
  85     rtsTrue))
  86
  87 /* -----------------------------------------------------------------------------
  88    Performing Garbage Collection
  89
  90    GarbageCollect(get_roots)    Performs a garbage collection.
  91                                 'get_roots' is called to find all the
  92                                 roots that the system knows about.
  93
  94    StgClosure                   Called by get_roots on each root.
  95    MarkRoot(StgClosure *p)      Returns the new location of the root.
  96    -------------------------------------------------------------------------- */
  97
  98 extern void GarbageCollect(void (*get_roots)(evac_fn),rtsBool force_major_gc);
  99
 100 /* -----------------------------------------------------------------------------
 101    Generational garbage collection support
 102
 103    recordMutable(StgPtr p)       Informs the garbage collector that a
 104                                  previously immutable object has
 105                                  become (permanently) mutable.  Used
 106                                  by thawArray and similar.
 107
 108    updateWithIndirection(p1,p2)  Updates the object at p1 with an
 109                                  indirection pointing to p2.  This is
 110                                  normally called for objects in an old
 111                                  generation (>0) when they are updated.
 112
 113    updateWithPermIndirection(p1,p2)  As above but uses a permanent indir.
 114
 115    -------------------------------------------------------------------------- */
 116
 117 /*
 118  * Storage manager mutex
 119  */
 120 #if defined(SMP)
 121 extern Mutex sm_mutex;
 122 #define ACQUIRE_SM_LOCK   ACQUIRE_LOCK(&sm_mutex)
 123 #define RELEASE_SM_LOCK   RELEASE_LOCK(&sm_mutex)
 124 #else
 125 #define ACQUIRE_SM_LOCK
 126 #define RELEASE_SM_LOCK
 127 #endif
 128
 129 /* ToDo: shouldn't recordMutable and recordOldToNewPtrs acquire some
 130  * kind of lock in the SMP case?
 131  */
 132 INLINE_HEADER void
 133 recordMutable(StgMutClosure *p)
 134 {
 135   bdescr *bd;
 136
 137 #ifdef SMP
 138   ASSERT(p->header.info == &stg_WHITEHOLE_info || closure_MUTABLE(p));
 139 #else
 140   ASSERT(closure_MUTABLE(p));
 141 #endif
 142
 143   bd = Bdescr((P_)p);
 144   if (bd->gen_no > 0) {
 145     p->mut_link = generations[bd->gen_no].mut_list;
 146     generations[bd->gen_no].mut_list = p;
 147   }
 148 }
 149
 150 INLINE_HEADER void
 151 recordOldToNewPtrs(StgMutClosure *p)
 152 {
 153   bdescr *bd;
 154
 155   bd = Bdescr((P_)p);
 156   if (bd->gen_no > 0) {
 157     p->mut_link = generations[bd->gen_no].mut_once_list;
 158     generations[bd->gen_no].mut_once_list = p;
 159   }
 160 }
 161
 162 // @LDV profiling
 163 // We zero out the slop when PROFILING is on.
 164 // #ifndef DEBUG
 165 #if !defined(DEBUG) && !defined(PROFILING)
 166 #define updateWithIndirection(info, ind_info, p1, p2, and_then)         \
 167   {                                                                     \
 168     bdescr *bd;                                                         \
 169                                                                         \
 170     bd = Bdescr((P_)p1);                                                \
 171     if (bd->gen_no == 0) {                                              \
 172       ((StgInd *)p1)->indirectee = p2;                                  \
 173       SET_INFO(p1,ind_info);                                            \
 174       TICK_UPD_NEW_IND();                                               \
 175       and_then;                                                         \
 176     } else {                                                            \
 177       ((StgIndOldGen *)p1)->indirectee = p2;                            \
 178       if (info != &stg_BLACKHOLE_BQ_info) {                             \
 179         ACQUIRE_SM_LOCK;                                                \
 180         ((StgIndOldGen *)p1)->mut_link = generations[bd->gen_no].mut_once_list; \
 181         generations[bd->gen_no].mut_once_list = (StgMutClosure *)p1;                    \
 182         RELEASE_SM_LOCK;                                                \
 183       }                                                                 \
 184       SET_INFO(p1,&stg_IND_OLDGEN_info);                                \
 185       TICK_UPD_OLD_IND();                                               \
 186       and_then;                                                         \
 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, ind_info, p1, p2, and_then)         \
 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,ind_info);                                            \
 209       LDV_recordCreate((p1));                                           \
 210       TICK_UPD_NEW_IND();                                               \
 211       and_then;                                                         \
 212     } else {                                                            \
 213       ((StgIndOldGen *)p1)->indirectee = p2;                            \
 214       if (info != &stg_BLACKHOLE_BQ_info) {                             \
 215         ACQUIRE_SM_LOCK;                                                \
 216         ((StgIndOldGen *)p1)->mut_link = generations[bd->gen_no].mut_once_list; \
 217         generations[bd->gen_no].mut_once_list = (StgMutClosure *)p1;    \
 218         RELEASE_SM_LOCK;                                                \
 219       }                                                                 \
 220       SET_INFO(p1,&stg_IND_OLDGEN_info);                                \
 221       LDV_recordCreate((p1));                                           \
 222       and_then;                                                         \
 223     }                                                                   \
 224   }
 225
 226 #else
 227
 228 /* In the DEBUG case, we also zero out the slop of the old closure,
 229  * so that the sanity checker can tell where the next closure is.
 230  *
 231  * Two important invariants: we should never try to update a closure
 232  * to point to itself, and the closure being updated should not
 233  * already have been updated (the mutable list will get messed up
 234  * otherwise).
 235  */
 236 #define updateWithIndirection(info, ind_info, p1, p2, and_then)         \
 237   {                                                                     \
 238     bdescr *bd;                                                         \
 239                                                                         \
 240     ASSERT( p1 != p2 && !closure_IND(p1) );                             \
 241     bd = Bdescr((P_)p1);                                                \
 242     if (bd->gen_no == 0) {                                              \
 243       ((StgInd *)p1)->indirectee = p2;                                  \
 244       SET_INFO(p1,ind_info);                                            \
 245       TICK_UPD_NEW_IND();                                               \
 246       and_then;                                                         \
 247     } else {                                                            \
 248       if (info != &stg_BLACKHOLE_BQ_info) {                             \
 249         {                                                               \
 250           StgInfoTable *inf = get_itbl(p1);                             \
 251           nat np = inf->layout.payload.ptrs,                            \
 252               nw = inf->layout.payload.nptrs, i;                        \
 253           if (inf->type != THUNK_SELECTOR) {                            \
 254              for (i = 0; i < np + nw; i++) {                            \
 255                 ((StgClosure *)p1)->payload[i] = 0;                     \
 256              }                                                          \
 257           }                                                             \
 258         }                                                               \
 259         ACQUIRE_SM_LOCK;                                                \
 260         ((StgIndOldGen *)p1)->mut_link = generations[bd->gen_no].mut_once_list; \
 261         generations[bd->gen_no].mut_once_list = (StgMutClosure *)p1;                    \
 262         RELEASE_SM_LOCK;                                                \
 263       }                                                                 \
 264       ((StgIndOldGen *)p1)->indirectee = p2;                            \
 265       SET_INFO(p1,&stg_IND_OLDGEN_info);                                \
 266       TICK_UPD_OLD_IND();                                               \
 267       and_then;                                                         \
 268     }                                                                   \
 269   }
 270 #endif
 271
 272 /* Static objects all live in the oldest generation
 273  */
 274 #define updateWithStaticIndirection(info, p1, p2)                       \
 275   {                                                                     \
 276     ASSERT( p1 != p2 && !closure_IND(p1) );                             \
 277     ASSERT( ((StgMutClosure*)p1)->mut_link == NULL );                   \
 278                                                                         \
 279     ACQUIRE_SM_LOCK;                                                    \
 280     ((StgMutClosure *)p1)->mut_link = oldest_gen->mut_once_list;        \
 281     oldest_gen->mut_once_list = (StgMutClosure *)p1;                    \
 282     RELEASE_SM_LOCK;                                                    \
 283                                                                         \
 284     ((StgInd *)p1)->indirectee = p2;                                    \
 285     SET_INFO((StgInd *)p1, &stg_IND_STATIC_info);                       \
 286     TICK_UPD_STATIC_IND();                                              \
 287   }
 288
 289 #if defined(TICKY_TICKY) || defined(PROFILING)
 290 INLINE_HEADER void
 291 updateWithPermIndirection(const StgInfoTable *info, StgClosure *p1, StgClosure *p2)
 292 {
 293   bdescr *bd;
 294
 295   ASSERT( p1 != p2 && !closure_IND(p1) );
 296
 297 #ifdef PROFILING
 298   // @LDV profiling
 299   // Destroy the old closure.
 300   // Nb: LDV_* stuff cannot mix with ticky-ticky
 301   LDV_recordDead_FILL_SLOP_DYNAMIC(p1);
 302 #endif
 303   bd = Bdescr((P_)p1);
 304   if (bd->gen_no == 0) {
 305     ((StgInd *)p1)->indirectee = p2;
 306     SET_INFO(p1,&stg_IND_PERM_info);
 307 #ifdef PROFILING
 308     // @LDV profiling
 309     // We have just created a new closure.
 310     LDV_recordCreate(p1);
 311 #endif
 312     TICK_UPD_NEW_PERM_IND(p1);
 313   } else {
 314     ((StgIndOldGen *)p1)->indirectee = p2;
 315     if (info != &stg_BLACKHOLE_BQ_info) {
 316       ACQUIRE_SM_LOCK;
 317       ((StgIndOldGen *)p1)->mut_link = generations[bd->gen_no].mut_once_list;
 318       generations[bd->gen_no].mut_once_list = (StgMutClosure *)p1;
 319       RELEASE_SM_LOCK;
 320     }
 321     SET_INFO(p1,&stg_IND_OLDGEN_PERM_info);
 322 #ifdef PROFILING
 323     // @LDV profiling
 324     // We have just created a new closure.
 325     LDV_recordCreate(p1);
 326 #endif
 327     TICK_UPD_OLD_PERM_IND();
 328   }
 329 }
 330 #endif
 331
 332 /* -----------------------------------------------------------------------------
 333    The CAF table - used to let us revert CAFs in GHCi
 334    -------------------------------------------------------------------------- */
 335
 336 void revertCAFs( void );
 337
 338 /* -----------------------------------------------------------------------------
 339    DEBUGGING predicates for pointers
 340
 341    LOOKS_LIKE_INFO_PTR(p)    returns False if p is definitely not an info ptr
 342    LOOKS_LIKE_CLOSURE_PTR(p) returns False if p is definitely not a closure ptr
 343
 344    These macros are complete but not sound.  That is, they might
 345    return false positives.  Do not rely on them to distinguish info
 346    pointers from closure pointers, for example.
 347
 348    We don't use address-space predicates these days, for portability
 349    reasons, and the fact that code/data can be scattered about the
 350    address space in a dynamically-linked environment.  Our best option
 351    is to look at the alleged info table and see whether it seems to
 352    make sense...
 353    -------------------------------------------------------------------------- */
 354
 355 #define LOOKS_LIKE_INFO_PTR(p) \
 356    (p && ((StgInfoTable *)(INFO_PTR_TO_STRUCT(p)))->type != INVALID_OBJECT && \
 357     ((StgInfoTable *)(INFO_PTR_TO_STRUCT(p)))->type < N_CLOSURE_TYPES)
 358
 359 #define LOOKS_LIKE_CLOSURE_PTR(p) \
 360    (LOOKS_LIKE_INFO_PTR(((StgClosure *)(p))->header.info))
 361
 362 /* -----------------------------------------------------------------------------
 363    Macros for calculating how big a closure will be (used during allocation)
 364    -------------------------------------------------------------------------- */
 365
 366 INLINE_HEADER StgOffset PAP_sizeW   ( nat n_args )
 367 { return sizeofW(StgPAP) + n_args; }
 368
 369 INLINE_HEADER StgOffset AP_STACK_sizeW ( nat size )
 370 { return sizeofW(StgAP_STACK) + size; }
 371
 372 INLINE_HEADER StgOffset CONSTR_sizeW( nat p, nat np )
 373 { return sizeofW(StgHeader) + p + np; }
 374
 375 INLINE_HEADER StgOffset THUNK_SELECTOR_sizeW ( void )
 376 { return sizeofW(StgHeader) + MIN_UPD_SIZE; }
 377
 378 INLINE_HEADER StgOffset BLACKHOLE_sizeW ( void )
 379 { return sizeofW(StgHeader) + MIN_UPD_SIZE; }
 380
 381 /* --------------------------------------------------------------------------
 382    Sizes of closures
 383    ------------------------------------------------------------------------*/
 384
 385 INLINE_HEADER StgOffset sizeW_fromITBL( const StgInfoTable* itbl )
 386 { return sizeofW(StgClosure)
 387        + sizeofW(StgPtr)  * itbl->layout.payload.ptrs
 388        + sizeofW(StgWord) * itbl->layout.payload.nptrs; }
 389
 390 INLINE_HEADER StgOffset ap_stack_sizeW( StgAP_STACK* x )
 391 { return AP_STACK_sizeW(x->size); }
 392
 393 INLINE_HEADER StgOffset pap_sizeW( StgPAP* x )
 394 { return PAP_sizeW(x->n_args); }
 395
 396 INLINE_HEADER StgOffset arr_words_sizeW( StgArrWords* x )
 397 { return sizeofW(StgArrWords) + x->words; }
 398
 399 INLINE_HEADER StgOffset mut_arr_ptrs_sizeW( StgMutArrPtrs* x )
 400 { return sizeofW(StgMutArrPtrs) + x->ptrs; }
 401
 402 INLINE_HEADER StgWord tso_sizeW ( StgTSO *tso )
 403 { return TSO_STRUCT_SIZEW + tso->stack_size; }
 404
 405 INLINE_HEADER StgWord bco_sizeW ( StgBCO *bco )
 406 { return bco->size; }
 407
 408 /* -----------------------------------------------------------------------------
 409    Sizes of stack frames
 410    -------------------------------------------------------------------------- */
 411
 412 INLINE_HEADER StgWord stack_frame_sizeW( StgClosure *frame )
 413 {
 414     StgRetInfoTable *info;
 415
 416     info = get_ret_itbl(frame);
 417     switch (info->i.type) {
 418
 419     case RET_DYN:
 420     {
 421         StgRetDyn *dyn = (StgRetDyn *)frame;
 422         return  sizeofW(StgRetDyn) + RET_DYN_BITMAP_SIZE +
 423             RET_DYN_NONPTR_REGS_SIZE +
 424             GET_PTRS(dyn->liveness) + GET_NONPTRS(dyn->liveness);
 425     }
 426
 427     case RET_FUN:
 428         return sizeofW(StgRetFun) + ((StgRetFun *)frame)->size;
 429
 430     case RET_BIG:
 431     case RET_VEC_BIG:
 432         return 1 + info->i.layout.large_bitmap->size;
 433
 434     case RET_BCO:
 435         return 2 + BCO_BITMAP_SIZE((StgBCO *)((P_)frame)[1]);
 436
 437     default:
 438         return 1 + BITMAP_SIZE(info->i.layout.bitmap);
 439     }
 440 }
 441
 442 /* -----------------------------------------------------------------------------
 443    Debugging bits
 444    -------------------------------------------------------------------------- */
 445
 446 #if defined(DEBUG)
 447 void printMutOnceList(generation *gen);
 448 void printMutableList(generation *gen);
 449 #endif
 450
 451 #endif // STORAGE_H