[project @ 2000-04-14 15:18:05 by sewardj]
[ghc-hetmet.git] / ghc / rts / Storage.h
1 /* -----------------------------------------------------------------------------
2  * $Id: Storage.h,v 1.16 2000/04/14 15:18:07 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 == &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 #define updateWithIndirection(info, p1, p2)                             \
132   {                                                                     \
133     bdescr *bd;                                                         \
134                                                                         \
135     bd = Bdescr((P_)p1);                                                \
136     if (bd->gen->no == 0) {                                             \
137       ((StgInd *)p1)->indirectee = p2;                                  \
138       SET_INFO(p1,&IND_info);                                           \
139       TICK_UPD_NEW_IND();                                               \
140     } else {                                                            \
141       ((StgIndOldGen *)p1)->indirectee = p2;                            \
142       if (info != &BLACKHOLE_BQ_info) {                                 \
143         ((StgIndOldGen *)p1)->mut_link = bd->gen->mut_once_list;        \
144         bd->gen->mut_once_list = (StgMutClosure *)p1;                   \
145       }                                                                 \
146       SET_INFO(p1,&IND_OLDGEN_info);                                    \
147       TICK_UPD_OLD_IND();                                               \
148     }                                                                   \
149   }
150
151 #if defined(TICKY_TICKY) || defined(PROFILING)
152 static inline void
153 updateWithPermIndirection(const StgInfoTable *info, StgClosure *p1, StgClosure *p2) 
154 {
155   bdescr *bd;
156
157   bd = Bdescr((P_)p1);
158   if (bd->gen->no == 0) {
159     ((StgInd *)p1)->indirectee = p2;
160     SET_INFO(p1,&IND_PERM_info);
161     TICK_UPD_NEW_PERM_IND(p1);
162   } else {
163     ((StgIndOldGen *)p1)->indirectee = p2;
164     if (info != &BLACKHOLE_BQ_info) {
165       ((StgIndOldGen *)p1)->mut_link = bd->gen->mut_once_list;
166       bd->gen->mut_once_list = (StgMutClosure *)p1;
167     }
168     SET_INFO(p1,&IND_OLDGEN_PERM_info);
169     TICK_UPD_OLD_PERM_IND();
170   }
171 }
172 #endif
173
174 /* -----------------------------------------------------------------------------
175    The CAF table - used to let us revert CAFs
176
177    -------------------------------------------------------------------------- */
178
179 #if defined(INTERPRETER)
180 typedef struct StgCAFTabEntry_ {
181     StgClosure*   closure;
182     StgInfoTable* origItbl;
183 } StgCAFTabEntry;
184
185 extern void addToECafTable ( StgClosure* closure, StgInfoTable* origItbl );
186 extern void clearECafTable ( void );
187
188 extern StgCAF*         ecafList;
189 extern StgCAFTabEntry* ecafTable;
190 extern StgInt          usedECafTable;
191 extern StgInt          sizeECafTable;
192 #endif
193
194 #if defined(DEBUG)
195 void printMutOnceList(generation *gen);
196 void printMutableList(generation *gen);
197 #endif DEBUG
198
199 #endif STORAGE_H
200