[project @ 2001-02-09 13:09:16 by simonmar]
[ghc-hetmet.git] / ghc / rts / Storage.h
1 /* -----------------------------------------------------------------------------
2  * $Id: Storage.h,v 1.28 2001/02/09 13:09:16 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    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 /* Temporary measure to ensure we retain all the dynamically-loaded CAFs */
85 #ifdef GHCI
86 extern void markCafs( void );
87 #endif
88
89 /* -----------------------------------------------------------------------------
90    Generational garbage collection support
91
92    recordMutable(StgPtr p)       Informs the garbage collector that a
93                                  previously immutable object has
94                                  become (permanently) mutable.  Used
95                                  by thawArray and similar.
96
97    updateWithIndirection(p1,p2)  Updates the object at p1 with an
98                                  indirection pointing to p2.  This is
99                                  normally called for objects in an old
100                                  generation (>0) when they are updated.
101
102    updateWithPermIndirection(p1,p2)  As above but uses a permanent indir.
103
104    -------------------------------------------------------------------------- */
105
106 /*
107  * Storage manager mutex
108  */
109 #ifdef SMP
110 extern pthread_mutex_t sm_mutex;
111 #endif
112
113 /* ToDo: shouldn't recordMutable and recordOldToNewPtrs acquire some
114  * kind of lock in the SMP case?
115  */
116 static inline void
117 recordMutable(StgMutClosure *p)
118 {
119   bdescr *bd;
120
121 #ifdef SMP
122   ASSERT(p->header.info == &stg_WHITEHOLE_info || closure_MUTABLE(p));
123 #else
124   ASSERT(closure_MUTABLE(p));
125 #endif
126
127   bd = Bdescr((P_)p);
128   if (bd->gen->no > 0) {
129     p->mut_link = bd->gen->mut_list;
130     bd->gen->mut_list = p;
131   }
132 }
133
134 static inline void
135 recordOldToNewPtrs(StgMutClosure *p)
136 {
137   bdescr *bd;
138   
139   bd = Bdescr((P_)p);
140   if (bd->gen->no > 0) {
141     p->mut_link = bd->gen->mut_once_list;
142     bd->gen->mut_once_list = p;
143   }
144 }
145
146 #ifndef DEBUG
147 #define updateWithIndirection(info, p1, p2)                             \
148   {                                                                     \
149     bdescr *bd;                                                         \
150                                                                         \
151     bd = Bdescr((P_)p1);                                                \
152     if (bd->gen->no == 0) {                                             \
153       ((StgInd *)p1)->indirectee = p2;                                  \
154       SET_INFO(p1,&stg_IND_info);                                       \
155       TICK_UPD_NEW_IND();                                               \
156     } else {                                                            \
157       ((StgIndOldGen *)p1)->indirectee = p2;                            \
158       if (info != &stg_BLACKHOLE_BQ_info) {                             \
159         ACQUIRE_LOCK(&sm_mutex);                                        \
160         ((StgIndOldGen *)p1)->mut_link = bd->gen->mut_once_list;        \
161         bd->gen->mut_once_list = (StgMutClosure *)p1;                   \
162         RELEASE_LOCK(&sm_mutex);                                        \
163       }                                                                 \
164       SET_INFO(p1,&stg_IND_OLDGEN_info);                                \
165       TICK_UPD_OLD_IND();                                               \
166     }                                                                   \
167   }
168 #else
169
170 /* In the DEBUG case, we also zero out the slop of the old closure,
171  * so that the sanity checker can tell where the next closure is.
172  */
173 #define updateWithIndirection(info, p1, p2)                             \
174   {                                                                     \
175     bdescr *bd;                                                         \
176                                                                         \
177     bd = Bdescr((P_)p1);                                                \
178     if (bd->gen->no == 0) {                                             \
179       ((StgInd *)p1)->indirectee = p2;                                  \
180       SET_INFO(p1,&stg_IND_info);                                       \
181       TICK_UPD_NEW_IND();                                               \
182     } else {                                                            \
183       if (info != &stg_BLACKHOLE_BQ_info) {                             \
184         {                                                               \
185           StgInfoTable *inf = get_itbl(p1);                             \
186           nat np = inf->layout.payload.ptrs,                            \
187               nw = inf->layout.payload.nptrs, i;                        \
188           if (inf->type != THUNK_SELECTOR) {                            \
189              for (i = np; i < np + nw; i++) {                           \
190                 ((StgClosure *)p1)->payload[i] = 0;                     \
191              }                                                          \
192           }                                                             \
193         }                                                               \
194         ACQUIRE_LOCK(&sm_mutex);                                        \
195         ((StgIndOldGen *)p1)->mut_link = bd->gen->mut_once_list;        \
196         bd->gen->mut_once_list = (StgMutClosure *)p1;                   \
197         RELEASE_LOCK(&sm_mutex);                                        \
198       }                                                                 \
199       ((StgIndOldGen *)p1)->indirectee = p2;                            \
200       SET_INFO(p1,&stg_IND_OLDGEN_info);                                \
201       TICK_UPD_OLD_IND();                                               \
202     }                                                                   \
203   }
204 #endif
205
206 /* Static objects all live in the oldest generation
207  */
208 #define updateWithStaticIndirection(info, p1, p2)                       \
209   {                                                                     \
210     ASSERT( ((StgMutClosure*)p1)->mut_link == NULL );                   \
211                                                                         \
212     ACQUIRE_LOCK(&sm_mutex);                                            \
213     ((StgMutClosure *)p1)->mut_link = oldest_gen->mut_once_list;        \
214     oldest_gen->mut_once_list = (StgMutClosure *)p1;                    \
215     RELEASE_LOCK(&sm_mutex);                                            \
216                                                                         \
217     ((StgInd *)p1)->indirectee = p2;                                    \
218     SET_INFO((StgInd *)p1, &stg_IND_STATIC_info);                       \
219     TICK_UPD_STATIC_IND();                                              \
220   }
221
222 #if defined(TICKY_TICKY) || defined(PROFILING)
223 static inline void
224 updateWithPermIndirection(const StgInfoTable *info, StgClosure *p1, StgClosure *p2) 
225 {
226   bdescr *bd;
227
228   bd = Bdescr((P_)p1);
229   if (bd->gen->no == 0) {
230     ((StgInd *)p1)->indirectee = p2;
231     SET_INFO(p1,&stg_IND_PERM_info);
232     TICK_UPD_NEW_PERM_IND(p1);
233   } else {
234     ((StgIndOldGen *)p1)->indirectee = p2;
235     if (info != &stg_BLACKHOLE_BQ_info) {
236       ACQUIRE_LOCK(&sm_mutex);
237       ((StgIndOldGen *)p1)->mut_link = bd->gen->mut_once_list;
238       bd->gen->mut_once_list = (StgMutClosure *)p1;
239       RELEASE_LOCK(&sm_mutex);
240     }
241     SET_INFO(p1,&stg_IND_OLDGEN_PERM_info);
242     TICK_UPD_OLD_PERM_IND();
243   }
244 }
245 #endif
246
247 /* -----------------------------------------------------------------------------
248    The CAF table - used to let us revert CAFs
249    -------------------------------------------------------------------------- */
250
251 #if defined(DEBUG)
252 void printMutOnceList(generation *gen);
253 void printMutableList(generation *gen);
254 #endif DEBUG
255
256 /* --------------------------------------------------------------------------
257                       Address space layout macros
258    --------------------------------------------------------------------------
259
260    Here are the assumptions GHC makes about address space layout.
261    Broadly, it thinks there are three sections:
262
263      CODE    Read-only.  Contains code and read-only data (such as
264                 info tables)
265              Also called "text"
266
267      DATA    Read-write data.  Contains static closures (and on some
268                 architectures, info tables too)
269
270      HEAP    Dynamically-allocated closures
271
272      USER    None of the above.  The only way USER things arise right 
273              now is when GHCi allocates a constructor info table, which
274              it does by mallocing them.
275
276    Three macros identify these three areas:
277      IS_CODE(p), IS_DATA(p), HEAP_ALLOCED(p)
278
279    HEAP_ALLOCED is called FOR EVERY SINGLE CLOSURE during GC.
280    It needs to be FAST.
281
282    Implementation of HEAP_ALLOCED
283    ~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~
284    Concerning HEAP, most of the time (certainly under [Static] and [GHCi],
285    we ensure that the heap is allocated above some fixed address HEAP_BASE
286    (defined in MBlock.h).  In this case we set TEXT_BEFORE_HEAP, and we
287    get a nice fast test.
288
289    Sometimes we can't be quite sure.  For example in Windows, we can't 
290    fix where our heap address space comes from.  In this case we un-set 
291    TEXT_BEFORE_HEAP. That makes it more expensive to test whether a pointer
292    comes from the HEAP section, because we need to look at the allocator's
293    address maps (see HEAP_ALLOCED macro)
294
295    Implementation of CODE and DATA
296    ~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~
297    Concerning CODE and DATA, there are three main regimes:
298
299      [Static] Totally      The segments are contiguous, and laid out 
300      statically linked     exactly as above
301
302      [GHCi] Static,        GHCi may load new modules, but it knows the
303      except for GHCi       address map, so for any given address it can
304                            still tell which section it belongs to
305
306      [DLL] OS-supported    Chunks of CODE and DATA may be mixed in 
307      dynamic loading       the address space, and we can't tell how
308
309
310    For the [Static] case, we assume memory is laid out like this
311    (in order of increasing addresses)
312
313        Start of memory
314            CODE section
315        TEXT_SECTION_END_MARKER   (usually _etext)
316            DATA section
317        DATA_SECTION_END_MARKER   (usually _end)
318            USER section
319        HEAP_BASE
320            HEAP section
321
322    For the [GHCi] case, we have to consult GHCi's dynamic linker's
323    address maps, which is done by macros
324          is_dynamically_loaded_code_or_rodata_ptr
325          is_dynamically_loaded_code_or_rwdata_ptr
326
327    For the [DLL] case, IS_CODE and IS_DATA are really not usable at all.
328  */
329
330
331 #undef TEXT_BEFORE_HEAP
332 #ifndef mingw32_TARGET_OS
333 #define TEXT_BEFORE_HEAP 1
334 #endif
335
336 extern void* TEXT_SECTION_END_MARKER_DECL;
337 extern void* DATA_SECTION_END_MARKER_DECL;
338
339 #if defined(GHCI)
340 /* Take into account code sections in dynamically loaded object files. */
341 #define IS_CODE_PTR(p) (  ((P_)(p) < (P_)&TEXT_SECTION_END_MARKER) \
342                        || is_dynamically_loaded_code_or_rodata_ptr((char *)p) )
343 #define IS_DATA_PTR(p) ( ((P_)(p) >= (P_)&TEXT_SECTION_END_MARKER && \
344                           (P_)(p) < (P_)&DATA_SECTION_END_MARKER) \
345                        || is_dynamically_loaded_rwdata_ptr((char *)p) )
346 #define IS_USER_PTR(p) ( ((P_)(p) >= (P_)&DATA_SECTION_END_MARKER) \
347                        && is_not_dynamically_loaded_ptr((char *)p) )
348 #else
349 #define IS_CODE_PTR(p) ((P_)(p) < (P_)&TEXT_SECTION_END_MARKER)
350 #define IS_DATA_PTR(p) ((P_)(p) >= (P_)&TEXT_SECTION_END_MARKER && (P_)(p) < (P_)&DATA_SECTION_END_MARKER)
351 #define IS_USER_PTR(p) ((P_)(p) >= (P_)&DATA_SECTION_END_MARKER)
352 #endif
353
354 /* The HEAP_ALLOCED test below is called FOR EVERY SINGLE CLOSURE
355  * during GC.  It needs to be FAST.
356  *
357  * BEWARE: when we're dynamically loading code (for GHCi), make sure
358  * that we don't load any code above HEAP_BASE, or this test won't work.
359  */
360 #ifdef TEXT_BEFORE_HEAP
361 # define HEAP_ALLOCED(x)  ((StgPtr)(x) >= (StgPtr)(HEAP_BASE))
362 #else
363 extern int is_heap_alloced(const void* x);
364 # define HEAP_ALLOCED(x)  (is_heap_alloced(x))
365 #endif
366
367
368 /* --------------------------------------------------------------------------
369    Macros for distinguishing data pointers from code pointers
370    --------------------------------------------------------------------------
371
372   Specification
373   ~~~~~~~~~~~~~
374   The garbage collector needs to make some critical distinctions between pointers.
375   In particular we need
376  
377      LOOKS_LIKE_GHC_INFO(p)          p points to an info table
378
379   For both of these macros, p is
380       *either* a pointer to a closure (static or heap allocated)
381       *or* a return address on the (Haskell) stack
382
383   (Return addresses are in fact info-pointers, so that the Haskell stack
384   looks very like a chunk of heap.)
385
386   The garbage collector uses LOOKS_LIKE_GHC_INFO when walking the stack, as it
387   walks over the "pending arguments" on its way to the next return address.
388   It is called moderately often, but not as often as HEAP_ALLOCED
389
390   ToDo: LOOKS_LIKE_GHC_INFO(p) does not return True when p points to a
391   constructor info table allocated by GHCi.  We should really rename 
392   LOOKS_LIKE_GHC_INFO to LOOKS_LIKE_GHC_RETURN_INFO.
393
394   Implementation
395   ~~~~~~~~~~~~~~
396   LOOKS_LIKE_GHC_INFO is more complicated because of the need to distinguish 
397   between static closures and info tables.  It's a known portability problem.
398   We have three approaches:
399
400   Plan A: Address-space partitioning.  
401     Keep info tables in the (single, contiguous) text segment:    IS_CODE_PTR(p)
402     and static closures in the (single, contiguous) data segment: IS_DATA_PTR(p)
403
404   Plan A can fail for two reasons:
405     * In many environments (eg. dynamic loading),
406       text and data aren't in a single contiguous range.  
407     * When we compile through vanilla C (no mangling) we sometimes
408       can't guaranteee to put info tables in the text section.  This
409       happens eg. on MacOS where the C compiler refuses to put const
410       data in the text section if it has any code pointers in it
411       (which info tables do *only* when we're compiling without
412       TABLES_NEXT_TO_CODE).
413     
414   Hence, Plan B: (compile-via-C-with-mangling, or native code generation)
415     Put a zero word before each static closure.
416     When compiling to native code, or via C-with-mangling, info tables
417     are laid out "backwards" from the address specified in the info pointer
418     (the entry code goes forward from the info pointer).  Hence, the word
419     before the one referenced the info pointer is part of the info table,
420     and is guaranteed non-zero.
421
422     For reasons nobody seems to fully understand, the statically-allocated tables
423     of INTLIKE and CHARLIKE closures can't have this zero word, so we
424     have to test separately for them.
425
426     Plan B fails altogether for the compile-through-vanilla-C route, because
427     info tables aren't laid out backwards.
428
429
430   Hence, Plan C: (unregisterised, compile-through-vanilla-C route only)
431     If we didn't manage to get info tables into the text section, then
432     we can distinguish between a static closure pointer and an info
433     pointer as follows:  the first word of an info table is a code pointer,
434     and therefore in text space, whereas the first word of a closure pointer
435     is an info pointer, and therefore not.  Shazam!
436 */
437
438
439 /* When working with Win32 DLLs, static closures are identified by
440    being prefixed with a zero word. This is needed so that we can
441    distinguish between pointers to static closures and (reversed!)
442    info tables.
443
444    This 'scheme' breaks down for closure tables such as CHARLIKE,
445    so we catch these separately.
446   
447    LOOKS_LIKE_STATIC_CLOSURE() 
448        - discriminates between static closures and info tbls
449          (needed by LOOKS_LIKE_GHC_INFO() below - [Win32 DLLs only.])
450    LOOKS_LIKE_STATIC() 
451        - distinguishes between static and heap allocated data.
452  */
453 #if defined(ENABLE_WIN32_DLL_SUPPORT)
454             /* definitely do not enable for mingw DietHEP */
455 #define LOOKS_LIKE_STATIC(r) (!(HEAP_ALLOCED(r)))
456
457 /* Tiresome predicates needed to check for pointers into the closure tables */
458 #define IS_CHARLIKE_CLOSURE(p) \
459     ( (P_)(p) >= (P_)stg_CHARLIKE_closure && \
460       (char*)(p) <= ((char*)stg_CHARLIKE_closure + \
461                      (MAX_CHARLIKE-MIN_CHARLIKE) * sizeof(StgIntCharlikeClosure)) )
462 #define IS_INTLIKE_CLOSURE(p) \
463     ( (P_)(p) >= (P_)stg_INTLIKE_closure && \
464       (char*)(p) <= ((char*)stg_INTLIKE_closure + \
465                      (MAX_INTLIKE-MIN_INTLIKE) * sizeof(StgIntCharlikeClosure)) )
466
467 #define LOOKS_LIKE_STATIC_CLOSURE(r) (((*(((unsigned long *)(r))-1)) == 0) || IS_CHARLIKE_CLOSURE(r) || IS_INTLIKE_CLOSURE(r))
468 #else
469 #define LOOKS_LIKE_STATIC(r) IS_DATA_PTR(r)
470 #define LOOKS_LIKE_STATIC_CLOSURE(r) IS_DATA_PTR(r)
471 #endif
472
473
474 /* -----------------------------------------------------------------------------
475    Macros for distinguishing infotables from closures.
476    
477    You'd think it'd be easy to tell an info pointer from a closure pointer:
478    closures live on the heap and infotables are in read only memory.  Right?
479    Wrong!  Static closures live in read only memory and Hugs allocates
480    infotables for constructors on the (writable) C heap.
481    -------------------------------------------------------------------------- */
482
483 #ifdef GHCI
484    /* not accurate by any means, but stops the assertions failing... */
485 #  define IS_HUGS_CONSTR_INFO(info)  IS_USER_PTR(info)
486 #else
487 #  define IS_HUGS_CONSTR_INFO(info) 0 /* ToDo: more than mildly bogus */
488 #endif
489
490 /* LOOKS_LIKE_GHC_INFO is called moderately often during GC, but
491  * Certainly not as often as HEAP_ALLOCED.
492  */
493 #ifdef TEXT_BEFORE_HEAP /* needed for mingw DietHEP */
494 # define LOOKS_LIKE_GHC_INFO(info) IS_CODE_PTR(info)
495 #else
496 # define LOOKS_LIKE_GHC_INFO(info) (!HEAP_ALLOCED(info) \
497                                     && !LOOKS_LIKE_STATIC_CLOSURE(info))
498 #endif
499
500
501 /* -----------------------------------------------------------------------------
502    Macros for calculating how big a closure will be (used during allocation)
503    -------------------------------------------------------------------------- */
504
505 /* ToDo: replace unsigned int by nat.  The only fly in the ointment is that
506  * nat comes from Rts.h which many folk dont include.  Sigh!
507  */
508 static __inline__ StgOffset AP_sizeW    ( unsigned int n_args )              
509 { return sizeofW(StgAP_UPD) + n_args; }
510
511 static __inline__ StgOffset PAP_sizeW   ( unsigned int n_args )              
512 { return sizeofW(StgPAP)    + n_args; }
513
514 static __inline__ StgOffset CONSTR_sizeW( unsigned int p, unsigned int np )  
515 { return sizeofW(StgHeader) + p + np; }
516
517 static __inline__ StgOffset THUNK_SELECTOR_sizeW ( void )                    
518 { return sizeofW(StgHeader) + MIN_UPD_SIZE; }
519
520 static __inline__ StgOffset BLACKHOLE_sizeW ( void )                    
521 { return sizeofW(StgHeader) + MIN_UPD_SIZE; }
522
523 /* --------------------------------------------------------------------------
524  * Sizes of closures
525  * ------------------------------------------------------------------------*/
526
527 static __inline__ StgOffset sizeW_fromITBL( const StgInfoTable* itbl ) 
528 { return sizeofW(StgClosure) 
529        + sizeofW(StgPtr)  * itbl->layout.payload.ptrs 
530        + sizeofW(StgWord) * itbl->layout.payload.nptrs; }
531
532 static __inline__ StgOffset pap_sizeW( StgPAP* x )
533 { return PAP_sizeW(x->n_args); }
534
535 static __inline__ StgOffset arr_words_sizeW( StgArrWords* x )
536 { return sizeofW(StgArrWords) + x->words; }
537
538 static __inline__ StgOffset mut_arr_ptrs_sizeW( StgMutArrPtrs* x )
539 { return sizeofW(StgMutArrPtrs) + x->ptrs; }
540
541 static __inline__ StgWord tso_sizeW ( StgTSO *tso )
542 { return TSO_STRUCT_SIZEW + tso->stack_size; }
543
544 #endif STORAGE_H
545