ghc/rts/Storage.h

   1 /* -----------------------------------------------------------------------------
   2  * $Id: Storage.h,v 1.21 2001/01/09 17:36:21 sewardj 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 "BlockAlloc.h"
  15 #include "StoragePriv.h"
  16
  17 /* -----------------------------------------------------------------------------
  18    Initialisation / De-initialisation
  19    -------------------------------------------------------------------------- */
  20
  21 extern void initStorage(void);
  22 extern void exitStorage(void);
  23
  24 /* -----------------------------------------------------------------------------
  25    Generic allocation
  26
  27    StgPtr allocate(int n)       Allocates a chunk of contiguous store
  28                                 n words long, returning a pointer to
  29                                 the first word.  Always succeeds.
  30
  31                                 Don't forget to TICK_ALLOC_XXX(...)
  32                                 after calling allocate, for the
  33                                 benefit of the ticky-ticky profiler.
  34
  35    rtsBool doYouWantToGC(void)  Returns True if the storage manager is
  36                                 ready to perform a GC, False otherwise.
  37
  38    lnat  allocated_bytes(void)  Returns the number of bytes allocated
  39                                 via allocate() since the last GC.
  40                                 Used in the reoprting of statistics.
  41
  42    SMP: allocate and doYouWantToGC can be used from STG code, they are
  43    surrounded by a mutex.
  44    -------------------------------------------------------------------------- */
  45
  46 extern StgPtr  allocate(nat n);
  47 static inline rtsBool doYouWantToGC(void)
  48 {
  49   return (alloc_blocks >= alloc_blocks_lim);
  50 }
  51 extern lnat allocated_bytes(void);
  52
  53 /* -----------------------------------------------------------------------------
  54    ExtendNursery(hp,hplim)      When hplim is reached, try to grab
  55                                 some more allocation space.  Returns
  56                                 False if the allocation space is
  57                                 exhausted, and the application should
  58                                 call GarbageCollect().
  59   -------------------------------------------------------------------------- */
  60
  61 #define ExtendNursery(hp,hplim)                 \
  62   (CurrentNursery->free = (P_)(hp)+1,           \
  63    CurrentNursery->link == NULL ? rtsFalse :    \
  64    (CurrentNursery = CurrentNursery->link,      \
  65     OpenNursery(hp,hplim),                      \
  66     rtsTrue))
  67
  68 extern void PleaseStopAllocating(void);
  69
  70 /* -----------------------------------------------------------------------------
  71    Performing Garbage Collection
  72
  73    GarbageCollect(get_roots)    Performs a garbage collection.
  74                                 'get_roots' is called to find all the
  75                                 roots that the system knows about.
  76
  77    StgClosure                   Called by get_roots on each root.
  78    MarkRoot(StgClosure *p)      Returns the new location of the root.
  79    -------------------------------------------------------------------------- */
  80
  81 extern void   GarbageCollect(void (*get_roots)(void),rtsBool force_major_gc);
  82 extern StgClosure *MarkRoot(StgClosure *p);
  83
  84 /* -----------------------------------------------------------------------------
  85    Generational garbage collection support
  86
  87    recordMutable(StgPtr p)       Informs the garbage collector that a
  88                                  previously immutable object has
  89                                  become (permanently) mutable.  Used
  90                                  by thawArray and similar.
  91
  92    updateWithIndirection(p1,p2)  Updates the object at p1 with an
  93                                  indirection pointing to p2.  This is
  94                                  normally called for objects in an old
  95                                  generation (>0) when they are updated.
  96
  97    updateWithPermIndirection(p1,p2)  As above but uses a permanent indir.
  98
  99    -------------------------------------------------------------------------- */
 100
 101 static inline void
 102 recordMutable(StgMutClosure *p)
 103 {
 104   bdescr *bd;
 105
 106 #ifdef SMP
 107   ASSERT(p->header.info == &stg_WHITEHOLE_info || closure_MUTABLE(p));
 108 #else
 109   ASSERT(closure_MUTABLE(p));
 110 #endif
 111
 112   bd = Bdescr((P_)p);
 113   if (bd->gen->no > 0) {
 114     p->mut_link = bd->gen->mut_list;
 115     bd->gen->mut_list = p;
 116   }
 117 }
 118
 119 static inline void
 120 recordOldToNewPtrs(StgMutClosure *p)
 121 {
 122   bdescr *bd;
 123
 124   bd = Bdescr((P_)p);
 125   if (bd->gen->no > 0) {
 126     p->mut_link = bd->gen->mut_once_list;
 127     bd->gen->mut_once_list = p;
 128   }
 129 }
 130
 131 #ifndef DEBUG
 132 #define updateWithIndirection(info, p1, p2)                             \
 133   {                                                                     \
 134     bdescr *bd;                                                         \
 135                                                                         \
 136     bd = Bdescr((P_)p1);                                                \
 137     if (bd->gen->no == 0) {                                             \
 138       ((StgInd *)p1)->indirectee = p2;                                  \
 139       SET_INFO(p1,&stg_IND_info);                                       \
 140       TICK_UPD_NEW_IND();                                               \
 141     } else {                                                            \
 142       ((StgIndOldGen *)p1)->indirectee = p2;                            \
 143       if (info != &stg_BLACKHOLE_BQ_info) {                             \
 144         ((StgIndOldGen *)p1)->mut_link = bd->gen->mut_once_list;        \
 145         bd->gen->mut_once_list = (StgMutClosure *)p1;                   \
 146       }                                                                 \
 147       SET_INFO(p1,&stg_IND_OLDGEN_info);                                \
 148       TICK_UPD_OLD_IND();                                               \
 149     }                                                                   \
 150   }
 151 #else
 152
 153 /* In the DEBUG case, we also zero out the slop of the old closure,
 154  * so that the sanity checker can tell where the next closure is.
 155  */
 156 #define updateWithIndirection(info, p1, p2)                             \
 157   {                                                                     \
 158     bdescr *bd;                                                         \
 159                                                                         \
 160     bd = Bdescr((P_)p1);                                                \
 161     if (bd->gen->no == 0) {                                             \
 162       ((StgInd *)p1)->indirectee = p2;                                  \
 163       SET_INFO(p1,&stg_IND_info);                                       \
 164       TICK_UPD_NEW_IND();                                               \
 165     } else {                                                            \
 166       if (info != &stg_BLACKHOLE_BQ_info) {                             \
 167         {                                                               \
 168           StgInfoTable *inf = get_itbl(p1);                             \
 169           nat np = inf->layout.payload.ptrs,                            \
 170               nw = inf->layout.payload.nptrs, i;                        \
 171           for (i = np; i < np + nw; i++) {                              \
 172              ((StgClosure *)p1)->payload[i] = 0;                        \
 173           }                                                             \
 174         }                                                               \
 175         ((StgIndOldGen *)p1)->mut_link = bd->gen->mut_once_list;        \
 176         bd->gen->mut_once_list = (StgMutClosure *)p1;                   \
 177       }                                                                 \
 178       ((StgIndOldGen *)p1)->indirectee = p2;                            \
 179       SET_INFO(p1,&stg_IND_OLDGEN_info);                                \
 180       TICK_UPD_OLD_IND();                                               \
 181     }                                                                   \
 182   }
 183 #endif
 184
 185 #if defined(TICKY_TICKY) || defined(PROFILING)
 186 static inline void
 187 updateWithPermIndirection(const StgInfoTable *info, StgClosure *p1, StgClosure *p2)
 188 {
 189   bdescr *bd;
 190
 191   bd = Bdescr((P_)p1);
 192   if (bd->gen->no == 0) {
 193     ((StgInd *)p1)->indirectee = p2;
 194     SET_INFO(p1,&stg_IND_PERM_info);
 195     TICK_UPD_NEW_PERM_IND(p1);
 196   } else {
 197     ((StgIndOldGen *)p1)->indirectee = p2;
 198     if (info != &stg_BLACKHOLE_BQ_info) {
 199       ((StgIndOldGen *)p1)->mut_link = bd->gen->mut_once_list;
 200       bd->gen->mut_once_list = (StgMutClosure *)p1;
 201     }
 202     SET_INFO(p1,&stg_IND_OLDGEN_PERM_info);
 203     TICK_UPD_OLD_PERM_IND();
 204   }
 205 }
 206 #endif
 207
 208 /* -----------------------------------------------------------------------------
 209    The CAF table - used to let us revert CAFs
 210    -------------------------------------------------------------------------- */
 211
 212 #if defined(INTERPRETER)
 213 typedef struct StgCAFTabEntry_ {
 214     StgClosure*   closure;
 215     StgInfoTable* origItbl;
 216 } StgCAFTabEntry;
 217
 218 extern void addToECafTable ( StgClosure* closure, StgInfoTable* origItbl );
 219 extern void clearECafTable ( void );
 220
 221 extern StgCAF*         ecafList;
 222 extern StgCAFTabEntry* ecafTable;
 223 extern StgInt          usedECafTable;
 224 extern StgInt          sizeECafTable;
 225 #endif
 226
 227 #if defined(DEBUG)
 228 void printMutOnceList(generation *gen);
 229 void printMutableList(generation *gen);
 230 #endif DEBUG
 231
 232 /* -----------------------------------------------------------------------------
 233    Macros for distinguishing data pointers from code pointers
 234    -------------------------------------------------------------------------- */
 235 /*
 236  * We use some symbols inserted automatically by the linker to decide
 237  * whether a pointer points to text, data, or user space.  These tests
 238  * assume that text is lower in the address space than data, which in
 239  * turn is lower than user allocated memory.
 240  *
 241  * If this assumption is false (say on some strange architecture) then
 242  * the tests IS_CODE_PTR and IS_DATA_PTR below will need to be
 243  * modified (and that should be all that's necessary).
 244  *
 245  * _start      } start of read-only text space
 246  * _etext      } end   of read-only text space
 247  * _end } end of read-write data space
 248  */
 249 extern StgFun start;
 250
 251 extern void* TEXT_SECTION_END_MARKER_DECL;
 252 extern void* DATA_SECTION_END_MARKER_DECL;
 253
 254 #if defined(INTERPRETER) || defined(GHCI)
 255 /* Take into account code sections in dynamically loaded object files. */
 256 #define IS_CODE_PTR(p) (  ((P_)(p) < (P_)&TEXT_SECTION_END_MARKER) \
 257                        || is_dynamically_loaded_code_or_rodata_ptr((char *)p) )
 258 #define IS_DATA_PTR(p) ( ((P_)(p) >= (P_)&TEXT_SECTION_END_MARKER && \
 259                           (P_)(p) < (P_)&DATA_SECTION_END_MARKER) \
 260                        || is_dynamically_loaded_rwdata_ptr((char *)p) )
 261 #define IS_USER_PTR(p) ( ((P_)(p) >= (P_)&DATA_SECTION_END_MARKER) \
 262                        && is_not_dynamically_loaded_ptr((char *)p) )
 263 #else
 264 #define IS_CODE_PTR(p) ((P_)(p) < (P_)&TEXT_SECTION_END_MARKER)
 265 #define IS_DATA_PTR(p) ((P_)(p) >= (P_)&TEXT_SECTION_END_MARKER && (P_)(p) < (P_)&DATA_SECTION_END_MARKER)
 266 #define IS_USER_PTR(p) ((P_)(p) >= (P_)&DATA_SECTION_END_MARKER)
 267 #endif
 268
 269 /* The HEAP_ALLOCED test below is called FOR EVERY SINGLE CLOSURE
 270  * during GC.  It needs to be FAST.
 271  */
 272 #ifdef TEXT_BEFORE_HEAP
 273 # define HEAP_ALLOCED(x)  ((StgPtr)(x) >= (StgPtr)(HEAP_BASE))
 274 #else
 275 extern int is_heap_alloced(const void* x);
 276 # define HEAP_ALLOCED(x)  (is_heap_alloced(x))
 277 #endif
 278
 279 /* When working with Win32 DLLs, static closures are identified by
 280    being prefixed with a zero word. This is needed so that we can
 281    distinguish between pointers to static closures and (reversed!)
 282    info tables.
 283
 284    This 'scheme' breaks down for closure tables such as CHARLIKE,
 285    so we catch these separately.
 286
 287    LOOKS_LIKE_STATIC_CLOSURE()
 288        - discriminates between static closures and info tbls
 289          (needed by LOOKS_LIKE_GHC_INFO() below - [Win32 DLLs only.])
 290    LOOKS_LIKE_STATIC()
 291        - distinguishes between static and heap allocated data.
 292  */
 293 #if defined(ENABLE_WIN32_DLL_SUPPORT) && !defined(INTERPRETER)
 294             /* definitely do not enable for mingw DietHEP */
 295 #define LOOKS_LIKE_STATIC(r) (!(HEAP_ALLOCED(r)))
 296
 297 /* Tiresome predicates needed to check for pointers into the closure tables */
 298 #define IS_CHARLIKE_CLOSURE(p) \
 299     ( (P_)(p) >= (P_)stg_CHARLIKE_closure && \
 300       (char*)(p) <= ((char*)stg_CHARLIKE_closure + \
 301                      (MAX_CHARLIKE-MIN_CHARLIKE) * sizeof(StgIntCharlikeClosure)) )
 302 #define IS_INTLIKE_CLOSURE(p) \
 303     ( (P_)(p) >= (P_)stg_INTLIKE_closure && \
 304       (char*)(p) <= ((char*)stg_INTLIKE_closure + \
 305                      (MAX_INTLIKE-MIN_INTLIKE) * sizeof(StgIntCharlikeClosure)) )
 306
 307 #define LOOKS_LIKE_STATIC_CLOSURE(r) (((*(((unsigned long *)(r))-1)) == 0) || IS_CHARLIKE_CLOSURE(r) || IS_INTLIKE_CLOSURE(r))
 308 #else
 309 #define LOOKS_LIKE_STATIC(r) IS_DATA_PTR(r)
 310 #define LOOKS_LIKE_STATIC_CLOSURE(r) IS_DATA_PTR(r)
 311 #endif
 312
 313
 314 /* -----------------------------------------------------------------------------
 315    Macros for distinguishing infotables from closures.
 316
 317    You'd think it'd be easy to tell an info pointer from a closure pointer:
 318    closures live on the heap and infotables are in read only memory.  Right?
 319    Wrong!  Static closures live in read only memory and Hugs allocates
 320    infotables for constructors on the (writable) C heap.
 321    -------------------------------------------------------------------------- */
 322
 323 #ifdef INTERPRETER
 324 #  ifdef USE_MINIINTERPRETER
 325      /* yoiks: one of the dreaded pointer equality tests */
 326 #    define IS_HUGS_CONSTR_INFO(info) \
 327             (((StgInfoTable *)(info))->entry == (StgFunPtr)&Hugs_CONSTR_entry)
 328 #  else
 329 #    define IS_HUGS_CONSTR_INFO(info) 0 /* ToDo: more than mildly bogus */
 330 #  endif
 331 #elif GHCI
 332    /* not accurate by any means, but stops the assertions failing... */
 333 #  define IS_HUGS_CONSTR_INFO(info)  IS_USER_PTR(info)
 334 #else
 335 #  define IS_HUGS_CONSTR_INFO(info) 0 /* ToDo: more than mildly bogus */
 336 #endif
 337
 338 /* LOOKS_LIKE_GHC_INFO is called moderately often during GC, but
 339  * Certainly not as often as HEAP_ALLOCED.
 340  */
 341 #ifdef TEXT_BEFORE_HEAP /* needed for mingw DietHEP */
 342 # define LOOKS_LIKE_GHC_INFO(info) IS_CODE_PTR(info)
 343 #else
 344 # define LOOKS_LIKE_GHC_INFO(info) (!HEAP_ALLOCED(info) \
 345                                     && !LOOKS_LIKE_STATIC_CLOSURE(info))
 346 #endif
 347
 348 /* -----------------------------------------------------------------------------
 349    Macros for calculating how big a closure will be (used during allocation)
 350    -------------------------------------------------------------------------- */
 351
 352 /* ToDo: replace unsigned int by nat.  The only fly in the ointment is that
 353  * nat comes from Rts.h which many folk dont include.  Sigh!
 354  */
 355 static __inline__ StgOffset AP_sizeW    ( unsigned int n_args )
 356 { return sizeofW(StgAP_UPD) + n_args; }
 357
 358 static __inline__ StgOffset PAP_sizeW   ( unsigned int n_args )
 359 { return sizeofW(StgPAP)    + n_args; }
 360
 361 static __inline__ StgOffset CONSTR_sizeW( unsigned int p, unsigned int np )
 362 { return sizeofW(StgHeader) + p + np; }
 363
 364 static __inline__ StgOffset THUNK_SELECTOR_sizeW ( void )
 365 { return sizeofW(StgHeader) + MIN_UPD_SIZE; }
 366
 367 static __inline__ StgOffset BLACKHOLE_sizeW ( void )
 368 { return sizeofW(StgHeader) + MIN_UPD_SIZE; }
 369
 370 static __inline__ StgOffset CAF_sizeW ( void )
 371 { return sizeofW(StgCAF); }
 372
 373 /* --------------------------------------------------------------------------
 374  * Sizes of closures
 375  * ------------------------------------------------------------------------*/
 376
 377 static __inline__ StgOffset sizeW_fromITBL( const StgInfoTable* itbl )
 378 { return sizeofW(StgClosure)
 379        + sizeofW(StgPtr)  * itbl->layout.payload.ptrs
 380        + sizeofW(StgWord) * itbl->layout.payload.nptrs; }
 381
 382 static __inline__ StgOffset pap_sizeW( StgPAP* x )
 383 { return PAP_sizeW(x->n_args); }
 384
 385 static __inline__ StgOffset arr_words_sizeW( StgArrWords* x )
 386 { return sizeofW(StgArrWords) + x->words; }
 387
 388 static __inline__ StgOffset mut_arr_ptrs_sizeW( StgMutArrPtrs* x )
 389 { return sizeofW(StgMutArrPtrs) + x->ptrs; }
 390
 391 static __inline__ StgWord tso_sizeW ( StgTSO *tso )
 392 { return TSO_STRUCT_SIZEW + tso->stack_size; }
 393
 394 #endif STORAGE_H
 395