ghc/rts/Storage.h

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