Merge branch 'master' of ssh://darcs.haskell.org/srv/darcs/ghc
[ghc-hetmet.git] / includes / Cmm.h
1 /* -----------------------------------------------------------------------------
2  *
3  * (c) The University of Glasgow 2004
4  *
5  * This file is included at the top of all .cmm source files (and
6  * *only* .cmm files).  It defines a collection of useful macros for
7  * making .cmm code a bit less error-prone to write, and a bit easier
8  * on the eye for the reader.
9  *
10  * For the syntax of .cmm files, see the parser in ghc/compiler/cmm/CmmParse.y.
11  *
12  * If you're used to the old HC file syntax, here's a quick cheat sheet
13  * for converting HC code:
14  *
15  *       - Remove FB_/FE_
16  *       - Remove all type casts
17  *       - Remove '&'
18  *       - STGFUN(foo) { ... }  ==>  foo { ... }
19  *       - FN_(foo) { ... }  ==>  foo { ... }
20  *       - JMP_(e)  ==> jump e;
21  *       - Remove EXTFUN(foo)
22  *       - Sp[n]  ==>  Sp(n)
23  *       - Hp[n]  ==>  Hp(n)
24  *       - Sp += n  ==> Sp_adj(n)
25  *       - Hp += n  ==> Hp_adj(n)
26  *       - R1.i   ==>  R1   (similarly for R1.w, R1.cl etc.)
27  *       - You need to explicitly dereference variables; eg. 
28  *             alloc_blocks   ==>  CInt[alloc_blocks]
29  *       - convert all word offsets into byte offsets:
30  *              - e ==> WDS(e)
31  *       - sizeofW(StgFoo)  ==>  SIZEOF_StgFoo
32  *       - ENTRY_CODE(e)  ==>  %ENTRY_CODE(e)
33  *       - get_itbl(c)  ==>  %GET_STD_INFO(c)
34  *       - Change liveness masks in STK_CHK_GEN, HP_CHK_GEN:
35  *              R1_PTR | R2_PTR  ==>  R1_PTR & R2_PTR
36  *              (NOTE: | becomes &)
37  *       - Declarations like 'StgPtr p;' become just 'W_ p;'
38  *       - e->payload[n] ==> PAYLOAD(e,n)
39  *       - Be very careful with comparisons: the infix versions (>, >=, etc.)
40  *         are unsigned, so use %lt(a,b) to get signed less-than for example.
41  *
42  * Accessing fields of structures defined in the RTS header files is
43  * done via automatically-generated macros in DerivedConstants.h.  For
44  * example, where previously we used
45  *
46  *          CurrentTSO->what_next = x
47  *
48  * in C-- we now use
49  *
50  *          StgTSO_what_next(CurrentTSO) = x
51  *
52  * where the StgTSO_what_next() macro is automatically generated by
53  * mkDerivedConstnants.c.  If you need to access a field that doesn't
54  * already have a macro, edit that file (it's pretty self-explanatory).
55  *
56  * -------------------------------------------------------------------------- */
57
58 #ifndef CMM_H
59 #define CMM_H
60
61 /*
62  * In files that are included into both C and C-- (and perhaps
63  * Haskell) sources, we sometimes need to conditionally compile bits
64  * depending on the language.  CMINUSMINUS==1 in .cmm sources:
65  */
66 #define CMINUSMINUS 1
67
68 #include "ghcconfig.h"
69
70 /* -----------------------------------------------------------------------------
71    Types 
72
73    The following synonyms for C-- types are declared here:
74
75      I8, I16, I32, I64    MachRep-style names for convenience
76
77      W_                   is shorthand for the word type (== StgWord)
78      F_                   shorthand for float  (F_ == StgFloat == C's float)
79      D_                   shorthand for double (D_ == StgDouble == C's double)
80
81      CInt                 has the same size as an int in C on this platform
82      CLong                has the same size as a long in C on this platform
83    
84   --------------------------------------------------------------------------- */
85
86 #define I8  bits8
87 #define I16 bits16
88 #define I32 bits32
89 #define I64 bits64
90 #define P_  gcptr
91
92 #if SIZEOF_VOID_P == 4
93 #define W_ bits32
94 /* Maybe it's better to include MachDeps.h */
95 #define TAG_BITS                2
96 #elif SIZEOF_VOID_P == 8
97 #define W_ bits64
98 /* Maybe it's better to include MachDeps.h */
99 #define TAG_BITS                3
100 #else
101 #error Unknown word size
102 #endif
103
104 /*
105  * The RTS must sometimes UNTAG a pointer before dereferencing it.
106  * See the wiki page Commentary/Rts/HaskellExecution/PointerTagging 
107  */
108 #define TAG_MASK ((1 << TAG_BITS) - 1)
109 #define UNTAG(p) (p & ~TAG_MASK)
110 #define GETTAG(p) (p & TAG_MASK)
111
112 #if SIZEOF_INT == 4
113 #define CInt bits32
114 #elif SIZEOF_INT == 8
115 #define CInt bits64
116 #else
117 #error Unknown int size
118 #endif
119
120 #if SIZEOF_LONG == 4
121 #define CLong bits32
122 #elif SIZEOF_LONG == 8
123 #define CLong bits64
124 #else
125 #error Unknown long size
126 #endif
127
128 #define F_ float32
129 #define D_ float64
130 #define L_ bits64
131
132 #define SIZEOF_StgDouble 8
133 #define SIZEOF_StgWord64 8
134
135 /* -----------------------------------------------------------------------------
136    Misc useful stuff
137    -------------------------------------------------------------------------- */
138
139 #define NULL (0::W_)
140
141 #define STRING(name,str)                        \
142   section "rodata" {                            \
143         name : bits8[] str;                     \
144   }                                             \
145
146 #ifdef TABLES_NEXT_TO_CODE
147 #define RET_LBL(f) f##_info
148 #else
149 #define RET_LBL(f) f##_ret
150 #endif
151
152 #ifdef TABLES_NEXT_TO_CODE
153 #define ENTRY_LBL(f) f##_info
154 #else
155 #define ENTRY_LBL(f) f##_entry
156 #endif
157
158 /* -----------------------------------------------------------------------------
159    Byte/word macros
160
161    Everything in C-- is in byte offsets (well, most things).  We use
162    some macros to allow us to express offsets in words and to try to
163    avoid byte/word confusion.
164    -------------------------------------------------------------------------- */
165
166 #define SIZEOF_W  SIZEOF_VOID_P
167 #define W_MASK    (SIZEOF_W-1)
168
169 #if SIZEOF_W == 4
170 #define W_SHIFT 2
171 #elif SIZEOF_W == 8
172 #define W_SHIFT 3
173 #endif
174
175 /* Converting quantities of words to bytes */
176 #define WDS(n) ((n)*SIZEOF_W)
177
178 /*
179  * Converting quantities of bytes to words
180  * NB. these work on *unsigned* values only
181  */
182 #define BYTES_TO_WDS(n) ((n) / SIZEOF_W)
183 #define ROUNDUP_BYTES_TO_WDS(n) (((n) + SIZEOF_W - 1) / SIZEOF_W)
184
185 /* TO_W_(n) converts n to W_ type from a smaller type */
186 #if SIZEOF_W == 4
187 #define TO_W_(x) %sx32(x)
188 #define HALF_W_(x) %lobits16(x)
189 #elif SIZEOF_W == 8
190 #define TO_W_(x) %sx64(x)
191 #define HALF_W_(x) %lobits32(x)
192 #endif
193
194 #if SIZEOF_INT == 4 && SIZEOF_W == 8
195 #define W_TO_INT(x) %lobits32(x)
196 #elif SIZEOF_INT == SIZEOF_W
197 #define W_TO_INT(x) (x)
198 #endif
199
200 /* -----------------------------------------------------------------------------
201    Heap/stack access, and adjusting the heap/stack pointers.
202    -------------------------------------------------------------------------- */
203
204 #define Sp(n)  W_[Sp + WDS(n)]
205 #define Hp(n)  W_[Hp + WDS(n)]
206
207 #define Sp_adj(n) Sp = Sp + WDS(n)
208 #define Hp_adj(n) Hp = Hp + WDS(n)
209
210 /* -----------------------------------------------------------------------------
211    Assertions and Debuggery
212    -------------------------------------------------------------------------- */
213
214 #ifdef DEBUG
215 #define ASSERT(predicate)                       \
216         if (predicate) {                        \
217             /*null*/;                           \
218         } else {                                \
219             foreign "C" _assertFail(NULL, __LINE__); \
220         }
221 #else
222 #define ASSERT(p) /* nothing */
223 #endif
224
225 #ifdef DEBUG
226 #define DEBUG_ONLY(s) s
227 #else
228 #define DEBUG_ONLY(s) /* nothing */
229 #endif
230
231 /*
232  * The IF_DEBUG macro is useful for debug messages that depend on one
233  * of the RTS debug options.  For example:
234  * 
235  *   IF_DEBUG(RtsFlags_DebugFlags_apply,
236  *      foreign "C" fprintf(stderr, stg_ap_0_ret_str));
237  *
238  * Note the syntax is slightly different to the C version of this macro.
239  */
240 #ifdef DEBUG
241 #define IF_DEBUG(c,s)  if (RtsFlags_DebugFlags_##c(RtsFlags) != 0::I32) { s; }
242 #else
243 #define IF_DEBUG(c,s)  /* nothing */
244 #endif
245
246 /* -----------------------------------------------------------------------------
247    Entering 
248
249    It isn't safe to "enter" every closure.  Functions in particular
250    have no entry code as such; their entry point contains the code to
251    apply the function.
252
253    ToDo: range should end in N_CLOSURE_TYPES-1, not N_CLOSURE_TYPES,
254    but switch doesn't allow us to use exprs there yet.
255
256    If R1 points to a tagged object it points either to
257    * A constructor.
258    * A function with arity <= TAG_MASK.
259    In both cases the right thing to do is to return.
260    Note: it is rather lucky that we can use the tag bits to do this
261          for both objects. Maybe it points to a brittle design?
262
263    Indirections can contain tagged pointers, so their tag is checked.
264    -------------------------------------------------------------------------- */
265
266 #ifdef PROFILING
267
268 // When profiling, we cannot shortcut ENTER() by checking the tag,
269 // because LDV profiling relies on entering closures to mark them as
270 // "used".
271
272 #define LOAD_INFO \
273     info = %INFO_PTR(UNTAG(P1));
274
275 #define UNTAG_R1 \
276     P1 = UNTAG(P1);
277
278 #else
279
280 #define LOAD_INFO                               \
281   if (GETTAG(P1) != 0) {                        \
282       jump %ENTRY_CODE(Sp(0));                  \
283   }                                             \
284   info = %INFO_PTR(P1);
285
286 #define UNTAG_R1 /* nothing */
287
288 #endif
289
290 #define ENTER()                                         \
291  again:                                                 \
292   W_ info;                                              \
293   LOAD_INFO                                             \
294   switch [INVALID_OBJECT .. N_CLOSURE_TYPES]            \
295          (TO_W_( %INFO_TYPE(%STD_INFO(info)) )) {       \
296   case                                                  \
297     IND,                                                \
298     IND_PERM,                                           \
299     IND_STATIC:                                         \
300    {                                                    \
301       P1 = StgInd_indirectee(P1);                       \
302       goto again;                                       \
303    }                                                    \
304   case                                                  \
305     FUN,                                                \
306     FUN_1_0,                                            \
307     FUN_0_1,                                            \
308     FUN_2_0,                                            \
309     FUN_1_1,                                            \
310     FUN_0_2,                                            \
311     FUN_STATIC,                                         \
312     BCO,                                                \
313     PAP:                                                \
314    {                                                    \
315       jump %ENTRY_CODE(Sp(0));                          \
316    }                                                    \
317   default:                                              \
318    {                                                    \
319       UNTAG_R1                                          \
320       jump %ENTRY_CODE(info);                           \
321    }                                                    \
322   }
323
324 // The FUN cases almost never happen: a pointer to a non-static FUN
325 // should always be tagged.  This unfortunately isn't true for the
326 // interpreter right now, which leaves untagged FUNs on the stack.
327
328 /* -----------------------------------------------------------------------------
329    Constants.
330    -------------------------------------------------------------------------- */
331
332 #include "rts/Constants.h"
333 #include "DerivedConstants.h"
334 #include "rts/storage/ClosureTypes.h"
335 #include "rts/storage/FunTypes.h"
336 #include "rts/storage/SMPClosureOps.h"
337 #include "rts/OSThreads.h"
338
339 /*
340  * Need MachRegs, because some of the RTS code is conditionally
341  * compiled based on REG_R1, REG_R2, etc.
342  */
343 #define STOLEN_X86_REGS 4
344 #include "stg/MachRegs.h"
345
346 #include "rts/storage/Liveness.h"
347 #include "rts/prof/LDV.h"
348
349 #undef BLOCK_SIZE
350 #undef MBLOCK_SIZE
351 #include "rts/storage/Block.h"  /* For Bdescr() */
352
353
354 #define MyCapability()  (BaseReg - OFFSET_Capability_r)
355
356 /* -------------------------------------------------------------------------
357    Allocation and garbage collection
358    ------------------------------------------------------------------------- */
359
360 /*
361  * ALLOC_PRIM is for allocating memory on the heap for a primitive
362  * object.  It is used all over PrimOps.cmm.
363  *
364  * We make the simplifying assumption that the "admin" part of a
365  * primitive closure is just the header when calculating sizes for
366  * ticky-ticky.  It's not clear whether eg. the size field of an array
367  * should be counted as "admin", or the various fields of a BCO.
368  */
369 #define ALLOC_PRIM(bytes,liveness,reentry)                      \
370    HP_CHK_GEN_TICKY(bytes,liveness,reentry);                    \
371    TICK_ALLOC_PRIM(SIZEOF_StgHeader,bytes-SIZEOF_StgHeader,0);  \
372    CCCS_ALLOC(bytes);
373
374 /* CCS_ALLOC wants the size in words, because ccs->mem_alloc is in words */
375 #define CCCS_ALLOC(__alloc) CCS_ALLOC(BYTES_TO_WDS(__alloc), W_[CCCS])
376
377 #define HP_CHK_GEN_TICKY(alloc,liveness,reentry)        \
378    HP_CHK_GEN(alloc,liveness,reentry);                  \
379    TICK_ALLOC_HEAP_NOCTR(alloc);
380
381 // allocate() allocates from the nursery, so we check to see
382 // whether the nursery is nearly empty in any function that uses
383 // allocate() - this includes many of the primops.
384 #define MAYBE_GC(liveness,reentry)                      \
385     if (bdescr_link(CurrentNursery) == NULL || \
386         generation_n_new_large_words(W_[g0]) >= CLong[large_alloc_lim]) {   \
387         R9  = liveness;                                 \
388         R10 = reentry;                                  \
389         HpAlloc = 0;                                    \
390         jump stg_gc_gen_hp;                             \
391    }
392
393 /* -----------------------------------------------------------------------------
394    Closure headers
395    -------------------------------------------------------------------------- */
396
397 /*
398  * This is really ugly, since we don't do the rest of StgHeader this
399  * way.  The problem is that values from DerivedConstants.h cannot be 
400  * dependent on the way (SMP, PROF etc.).  For SIZEOF_StgHeader we get
401  * the value from GHC, but it seems like too much trouble to do that
402  * for StgThunkHeader.
403  */
404 #define SIZEOF_StgThunkHeader SIZEOF_StgHeader+SIZEOF_StgSMPThunkHeader
405
406 #define StgThunk_payload(__ptr__,__ix__) \
407     W_[__ptr__+SIZEOF_StgThunkHeader+ WDS(__ix__)]
408
409 /* -----------------------------------------------------------------------------
410    Closures
411    -------------------------------------------------------------------------- */
412
413 /* The offset of the payload of an array */
414 #define BYTE_ARR_CTS(arr)  ((arr) + SIZEOF_StgArrWords)
415
416 /* The number of words allocated in an array payload */
417 #define BYTE_ARR_WDS(arr) ROUNDUP_BYTES_TO_WDS(StgArrWords_bytes(arr))
418
419 /* Getting/setting the info pointer of a closure */
420 #define SET_INFO(p,info) StgHeader_info(p) = info
421 #define GET_INFO(p) StgHeader_info(p)
422
423 /* Determine the size of an ordinary closure from its info table */
424 #define sizeW_fromITBL(itbl) \
425   SIZEOF_StgHeader + WDS(%INFO_PTRS(itbl)) + WDS(%INFO_NPTRS(itbl))
426
427 /* NB. duplicated from InfoTables.h! */
428 #define BITMAP_SIZE(bitmap) ((bitmap) & BITMAP_SIZE_MASK)
429 #define BITMAP_BITS(bitmap) ((bitmap) >> BITMAP_BITS_SHIFT)
430
431 /* Debugging macros */
432 #define LOOKS_LIKE_INFO_PTR(p)                                  \
433    ((p) != NULL &&                                              \
434     LOOKS_LIKE_INFO_PTR_NOT_NULL(p))
435
436 #define LOOKS_LIKE_INFO_PTR_NOT_NULL(p)                         \
437    ( (TO_W_(%INFO_TYPE(%STD_INFO(p))) != INVALID_OBJECT) &&     \
438      (TO_W_(%INFO_TYPE(%STD_INFO(p))) <  N_CLOSURE_TYPES))
439
440 #define LOOKS_LIKE_CLOSURE_PTR(p) (LOOKS_LIKE_INFO_PTR(GET_INFO(UNTAG(p))))
441
442 /*
443  * The layout of the StgFunInfoExtra part of an info table changes
444  * depending on TABLES_NEXT_TO_CODE.  So we define field access
445  * macros which use the appropriate version here:
446  */
447 #ifdef TABLES_NEXT_TO_CODE
448 /*
449  * when TABLES_NEXT_TO_CODE, slow_apply is stored as an offset
450  * instead of the normal pointer.
451  */
452         
453 #define StgFunInfoExtra_slow_apply(fun_info)    \
454         (TO_W_(StgFunInfoExtraRev_slow_apply_offset(fun_info))    \
455                + (fun_info) + SIZEOF_StgFunInfoExtraRev + SIZEOF_StgInfoTable)
456
457 #define StgFunInfoExtra_fun_type(i)   StgFunInfoExtraRev_fun_type(i)
458 #define StgFunInfoExtra_arity(i)      StgFunInfoExtraRev_arity(i)
459 #define StgFunInfoExtra_bitmap(i)     StgFunInfoExtraRev_bitmap(i)
460 #else
461 #define StgFunInfoExtra_slow_apply(i) StgFunInfoExtraFwd_slow_apply(i)
462 #define StgFunInfoExtra_fun_type(i)   StgFunInfoExtraFwd_fun_type(i)
463 #define StgFunInfoExtra_arity(i)      StgFunInfoExtraFwd_arity(i)
464 #define StgFunInfoExtra_bitmap(i)     StgFunInfoExtraFwd_bitmap(i)
465 #endif
466
467 #define mutArrPtrsCardWords(n) \
468     ROUNDUP_BYTES_TO_WDS(((n) + (1 << MUT_ARR_PTRS_CARD_BITS) - 1) >> MUT_ARR_PTRS_CARD_BITS)
469
470 #if defined(PROFILING) || (!defined(THREADED_RTS) && defined(DEBUG))
471 #define OVERWRITING_CLOSURE(c) foreign "C" overwritingClosure(c "ptr")
472 #else
473 #define OVERWRITING_CLOSURE(c) /* nothing */
474 #endif
475
476 /* -----------------------------------------------------------------------------
477    Voluntary Yields/Blocks
478
479    We only have a generic version of this at the moment - if it turns
480    out to be slowing us down we can make specialised ones.
481    -------------------------------------------------------------------------- */
482
483 #define YIELD(liveness,reentry)                 \
484    R9  = liveness;                              \
485    R10 = reentry;                               \
486    jump stg_gen_yield;
487
488 #define BLOCK(liveness,reentry)                 \
489    R9  = liveness;                              \
490    R10 = reentry;                               \
491    jump stg_gen_block;
492
493 /* -----------------------------------------------------------------------------
494    Ticky macros 
495    -------------------------------------------------------------------------- */
496
497 #ifdef TICKY_TICKY
498 #define TICK_BUMP_BY(ctr,n) CLong[ctr] = CLong[ctr] + n
499 #else
500 #define TICK_BUMP_BY(ctr,n) /* nothing */
501 #endif
502
503 #define TICK_BUMP(ctr)      TICK_BUMP_BY(ctr,1)
504
505 #define TICK_ENT_DYN_IND()              TICK_BUMP(ENT_DYN_IND_ctr)
506 #define TICK_ENT_DYN_THK()              TICK_BUMP(ENT_DYN_THK_ctr)
507 #define TICK_ENT_VIA_NODE()             TICK_BUMP(ENT_VIA_NODE_ctr)
508 #define TICK_ENT_STATIC_IND()           TICK_BUMP(ENT_STATIC_IND_ctr)
509 #define TICK_ENT_PERM_IND()             TICK_BUMP(ENT_PERM_IND_ctr)
510 #define TICK_ENT_PAP()                  TICK_BUMP(ENT_PAP_ctr)
511 #define TICK_ENT_AP()                   TICK_BUMP(ENT_AP_ctr)
512 #define TICK_ENT_AP_STACK()             TICK_BUMP(ENT_AP_STACK_ctr)
513 #define TICK_ENT_BH()                   TICK_BUMP(ENT_BH_ctr)
514 #define TICK_UNKNOWN_CALL()             TICK_BUMP(UNKNOWN_CALL_ctr)
515 #define TICK_UPDF_PUSHED()              TICK_BUMP(UPDF_PUSHED_ctr)
516 #define TICK_CATCHF_PUSHED()            TICK_BUMP(CATCHF_PUSHED_ctr)
517 #define TICK_UPDF_OMITTED()             TICK_BUMP(UPDF_OMITTED_ctr)
518 #define TICK_UPD_NEW_IND()              TICK_BUMP(UPD_NEW_IND_ctr)
519 #define TICK_UPD_NEW_PERM_IND()         TICK_BUMP(UPD_NEW_PERM_IND_ctr)
520 #define TICK_UPD_OLD_IND()              TICK_BUMP(UPD_OLD_IND_ctr)
521 #define TICK_UPD_OLD_PERM_IND()         TICK_BUMP(UPD_OLD_PERM_IND_ctr)
522   
523 #define TICK_SLOW_CALL_FUN_TOO_FEW()    TICK_BUMP(SLOW_CALL_FUN_TOO_FEW_ctr)
524 #define TICK_SLOW_CALL_FUN_CORRECT()    TICK_BUMP(SLOW_CALL_FUN_CORRECT_ctr)
525 #define TICK_SLOW_CALL_FUN_TOO_MANY()   TICK_BUMP(SLOW_CALL_FUN_TOO_MANY_ctr)
526 #define TICK_SLOW_CALL_PAP_TOO_FEW()    TICK_BUMP(SLOW_CALL_PAP_TOO_FEW_ctr)
527 #define TICK_SLOW_CALL_PAP_CORRECT()    TICK_BUMP(SLOW_CALL_PAP_CORRECT_ctr)
528 #define TICK_SLOW_CALL_PAP_TOO_MANY()   TICK_BUMP(SLOW_CALL_PAP_TOO_MANY_ctr)
529
530 #define TICK_SLOW_CALL_v()              TICK_BUMP(SLOW_CALL_v_ctr)
531 #define TICK_SLOW_CALL_p()              TICK_BUMP(SLOW_CALL_p_ctr)
532 #define TICK_SLOW_CALL_pv()             TICK_BUMP(SLOW_CALL_pv_ctr)
533 #define TICK_SLOW_CALL_pp()             TICK_BUMP(SLOW_CALL_pp_ctr)
534 #define TICK_SLOW_CALL_ppp()            TICK_BUMP(SLOW_CALL_ppp_ctr)
535 #define TICK_SLOW_CALL_pppp()           TICK_BUMP(SLOW_CALL_pppp_ctr)
536 #define TICK_SLOW_CALL_ppppp()          TICK_BUMP(SLOW_CALL_ppppp_ctr)
537 #define TICK_SLOW_CALL_pppppp()         TICK_BUMP(SLOW_CALL_pppppp_ctr)
538
539 /* NOTE: TICK_HISTO_BY and TICK_HISTO 
540    currently have no effect.
541    The old code for it didn't typecheck and I 
542    just commented it out to get ticky to work.
543    - krc 1/2007 */
544
545 #define TICK_HISTO_BY(histo,n,i) /* nothing */
546
547 #define TICK_HISTO(histo,n) TICK_HISTO_BY(histo,n,1)
548
549 /* An unboxed tuple with n components. */
550 #define TICK_RET_UNBOXED_TUP(n)                 \
551   TICK_BUMP(RET_UNBOXED_TUP_ctr++);             \
552   TICK_HISTO(RET_UNBOXED_TUP,n)
553
554 /*
555  * A slow call with n arguments.  In the unevald case, this call has
556  * already been counted once, so don't count it again.
557  */
558 #define TICK_SLOW_CALL(n)                       \
559   TICK_BUMP(SLOW_CALL_ctr);                     \
560   TICK_HISTO(SLOW_CALL,n)
561
562 /*
563  * This slow call was found to be to an unevaluated function; undo the
564  * ticks we did in TICK_SLOW_CALL.
565  */
566 #define TICK_SLOW_CALL_UNEVALD(n)               \
567   TICK_BUMP(SLOW_CALL_UNEVALD_ctr);             \
568   TICK_BUMP_BY(SLOW_CALL_ctr,-1);               \
569   TICK_HISTO_BY(SLOW_CALL,n,-1);
570
571 /* Updating a closure with a new CON */
572 #define TICK_UPD_CON_IN_NEW(n)                  \
573   TICK_BUMP(UPD_CON_IN_NEW_ctr);                \
574   TICK_HISTO(UPD_CON_IN_NEW,n)
575
576 #define TICK_ALLOC_HEAP_NOCTR(n)                \
577     TICK_BUMP(ALLOC_HEAP_ctr);                  \
578     TICK_BUMP_BY(ALLOC_HEAP_tot,n)
579
580 /* -----------------------------------------------------------------------------
581    Misc junk
582    -------------------------------------------------------------------------- */
583
584 #define NO_TREC                   stg_NO_TREC_closure
585 #define END_TSO_QUEUE             stg_END_TSO_QUEUE_closure
586 #define END_INVARIANT_CHECK_QUEUE stg_END_INVARIANT_CHECK_QUEUE_closure
587
588 #define recordMutableCap(p, gen, regs)                                  \
589   W_ __bd;                                                              \
590   W_ mut_list;                                                          \
591   mut_list = Capability_mut_lists(MyCapability()) + WDS(gen);           \
592  __bd = W_[mut_list];                                                   \
593   if (bdescr_free(__bd) >= bdescr_start(__bd) + BLOCK_SIZE) {           \
594       W_ __new_bd;                                                      \
595       ("ptr" __new_bd) = foreign "C" allocBlock_lock() [regs];          \
596       bdescr_link(__new_bd) = __bd;                                     \
597       __bd = __new_bd;                                                  \
598       W_[mut_list] = __bd;                                              \
599   }                                                                     \
600   W_ free;                                                              \
601   free = bdescr_free(__bd);                                             \
602   W_[free] = p;                                                         \
603   bdescr_free(__bd) = free + WDS(1);
604
605 #define recordMutable(p, regs)                                  \
606       P_ __p;                                                   \
607       W_ __bd;                                                  \
608       W_ __gen;                                                 \
609       __p = p;                                                  \
610       __bd = Bdescr(__p);                                       \
611       __gen = TO_W_(bdescr_gen_no(__bd));                       \
612       if (__gen > 0) { recordMutableCap(__p, __gen, regs); }
613
614 #endif /* CMM_H */