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