Merge branch 'master' of http://darcs.haskell.org/ghc
[ghc.git] / includes / Cmm.h
1 /* -----------------------------------------------------------------------------
2 *
3 * (c) The University of Glasgow 2004-2012
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 * mkDerivedConstants.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 #if SIZEOF_LONG == 4 && SIZEOF_W == 8
201 #define W_TO_LONG(x) %lobits32(x)
202 #elif SIZEOF_LONG == SIZEOF_W
203 #define W_TO_LONG(x) (x)
204 #endif
205
206 /* -----------------------------------------------------------------------------
207 Heap/stack access, and adjusting the heap/stack pointers.
208 -------------------------------------------------------------------------- */
209
210 #define Sp(n) W_[Sp + WDS(n)]
211 #define Hp(n) W_[Hp + WDS(n)]
212
213 #define Sp_adj(n) Sp = Sp + WDS(n)
214 #define Hp_adj(n) Hp = Hp + WDS(n)
215
216 /* -----------------------------------------------------------------------------
217 Assertions and Debuggery
218 -------------------------------------------------------------------------- */
219
220 #ifdef DEBUG
221 #define ASSERT(predicate) \
222 if (predicate) { \
223 /*null*/; \
224 } else { \
225 foreign "C" _assertFail(NULL, __LINE__); \
226 }
227 #else
228 #define ASSERT(p) /* nothing */
229 #endif
230
231 #ifdef DEBUG
232 #define DEBUG_ONLY(s) s
233 #else
234 #define DEBUG_ONLY(s) /* nothing */
235 #endif
236
237 /*
238 * The IF_DEBUG macro is useful for debug messages that depend on one
239 * of the RTS debug options. For example:
240 *
241 * IF_DEBUG(RtsFlags_DebugFlags_apply,
242 * foreign "C" fprintf(stderr, stg_ap_0_ret_str));
243 *
244 * Note the syntax is slightly different to the C version of this macro.
245 */
246 #ifdef DEBUG
247 #define IF_DEBUG(c,s) if (RtsFlags_DebugFlags_##c(RtsFlags) != 0::I32) { s; }
248 #else
249 #define IF_DEBUG(c,s) /* nothing */
250 #endif
251
252 /* -----------------------------------------------------------------------------
253 Entering
254
255 It isn't safe to "enter" every closure. Functions in particular
256 have no entry code as such; their entry point contains the code to
257 apply the function.
258
259 ToDo: range should end in N_CLOSURE_TYPES-1, not N_CLOSURE_TYPES,
260 but switch doesn't allow us to use exprs there yet.
261
262 If R1 points to a tagged object it points either to
263 * A constructor.
264 * A function with arity <= TAG_MASK.
265 In both cases the right thing to do is to return.
266 Note: it is rather lucky that we can use the tag bits to do this
267 for both objects. Maybe it points to a brittle design?
268
269 Indirections can contain tagged pointers, so their tag is checked.
270 -------------------------------------------------------------------------- */
271
272 #ifdef PROFILING
273
274 // When profiling, we cannot shortcut ENTER() by checking the tag,
275 // because LDV profiling relies on entering closures to mark them as
276 // "used".
277
278 #define LOAD_INFO \
279 info = %INFO_PTR(UNTAG(P1));
280
281 #define UNTAG_R1 \
282 P1 = UNTAG(P1);
283
284 #else
285
286 #define LOAD_INFO \
287 if (GETTAG(P1) != 0) { \
288 jump %ENTRY_CODE(Sp(0)); \
289 } \
290 info = %INFO_PTR(P1);
291
292 #define UNTAG_R1 /* nothing */
293
294 #endif
295
296 #define ENTER() \
297 again: \
298 W_ info; \
299 LOAD_INFO \
300 switch [INVALID_OBJECT .. N_CLOSURE_TYPES] \
301 (TO_W_( %INFO_TYPE(%STD_INFO(info)) )) { \
302 case \
303 IND, \
304 IND_PERM, \
305 IND_STATIC: \
306 { \
307 P1 = StgInd_indirectee(P1); \
308 goto again; \
309 } \
310 case \
311 FUN, \
312 FUN_1_0, \
313 FUN_0_1, \
314 FUN_2_0, \
315 FUN_1_1, \
316 FUN_0_2, \
317 FUN_STATIC, \
318 BCO, \
319 PAP: \
320 { \
321 jump %ENTRY_CODE(Sp(0)); \
322 } \
323 default: \
324 { \
325 UNTAG_R1 \
326 jump %ENTRY_CODE(info); \
327 } \
328 }
329
330 // The FUN cases almost never happen: a pointer to a non-static FUN
331 // should always be tagged. This unfortunately isn't true for the
332 // interpreter right now, which leaves untagged FUNs on the stack.
333
334 /* -----------------------------------------------------------------------------
335 Constants.
336 -------------------------------------------------------------------------- */
337
338 #include "rts/Constants.h"
339 #include "DerivedConstants.h"
340 #include "rts/storage/ClosureTypes.h"
341 #include "rts/storage/FunTypes.h"
342 #include "rts/storage/SMPClosureOps.h"
343 #include "rts/OSThreads.h"
344
345 /*
346 * Need MachRegs, because some of the RTS code is conditionally
347 * compiled based on REG_R1, REG_R2, etc.
348 */
349 #define STOLEN_X86_REGS 4
350 #include "stg/MachRegs.h"
351
352 #include "rts/storage/Liveness.h"
353 #include "rts/prof/LDV.h"
354
355 #undef BLOCK_SIZE
356 #undef MBLOCK_SIZE
357 #include "rts/storage/Block.h" /* For Bdescr() */
358
359
360 #define MyCapability() (BaseReg - OFFSET_Capability_r)
361
362 /* -------------------------------------------------------------------------
363 Allocation and garbage collection
364 ------------------------------------------------------------------------- */
365
366 /*
367 * ALLOC_PRIM is for allocating memory on the heap for a primitive
368 * object. It is used all over PrimOps.cmm.
369 *
370 * We make the simplifying assumption that the "admin" part of a
371 * primitive closure is just the header when calculating sizes for
372 * ticky-ticky. It's not clear whether eg. the size field of an array
373 * should be counted as "admin", or the various fields of a BCO.
374 */
375 #define ALLOC_PRIM(bytes,liveness,reentry) \
376 HP_CHK_GEN_TICKY(bytes,liveness,reentry); \
377 TICK_ALLOC_PRIM(SIZEOF_StgHeader,bytes-SIZEOF_StgHeader,0); \
378 CCCS_ALLOC(bytes);
379
380 /* CCS_ALLOC wants the size in words, because ccs->mem_alloc is in words */
381 #define CCCS_ALLOC(__alloc) CCS_ALLOC(BYTES_TO_WDS(__alloc), CCCS)
382
383 #define HP_CHK_GEN_TICKY(alloc,liveness,reentry) \
384 HP_CHK_GEN(alloc,liveness,reentry); \
385 TICK_ALLOC_HEAP_NOCTR(alloc);
386
387 // allocate() allocates from the nursery, so we check to see
388 // whether the nursery is nearly empty in any function that uses
389 // allocate() - this includes many of the primops.
390 #define MAYBE_GC(liveness,reentry) \
391 if (bdescr_link(CurrentNursery) == NULL || \
392 generation_n_new_large_words(W_[g0]) >= TO_W_(CLong[large_alloc_lim])) { \
393 R9 = liveness; \
394 R10 = reentry; \
395 HpAlloc = 0; \
396 jump stg_gc_gen_hp; \
397 }
398
399 /* -----------------------------------------------------------------------------
400 Closure headers
401 -------------------------------------------------------------------------- */
402
403 /*
404 * This is really ugly, since we don't do the rest of StgHeader this
405 * way. The problem is that values from DerivedConstants.h cannot be
406 * dependent on the way (SMP, PROF etc.). For SIZEOF_StgHeader we get
407 * the value from GHC, but it seems like too much trouble to do that
408 * for StgThunkHeader.
409 */
410 #define SIZEOF_StgThunkHeader SIZEOF_StgHeader+SIZEOF_StgSMPThunkHeader
411
412 #define StgThunk_payload(__ptr__,__ix__) \
413 W_[__ptr__+SIZEOF_StgThunkHeader+ WDS(__ix__)]
414
415 /* -----------------------------------------------------------------------------
416 Closures
417 -------------------------------------------------------------------------- */
418
419 /* The offset of the payload of an array */
420 #define BYTE_ARR_CTS(arr) ((arr) + SIZEOF_StgArrWords)
421
422 /* The number of words allocated in an array payload */
423 #define BYTE_ARR_WDS(arr) ROUNDUP_BYTES_TO_WDS(StgArrWords_bytes(arr))
424
425 /* Getting/setting the info pointer of a closure */
426 #define SET_INFO(p,info) StgHeader_info(p) = info
427 #define GET_INFO(p) StgHeader_info(p)
428
429 /* Determine the size of an ordinary closure from its info table */
430 #define sizeW_fromITBL(itbl) \
431 SIZEOF_StgHeader + WDS(%INFO_PTRS(itbl)) + WDS(%INFO_NPTRS(itbl))
432
433 /* NB. duplicated from InfoTables.h! */
434 #define BITMAP_SIZE(bitmap) ((bitmap) & BITMAP_SIZE_MASK)
435 #define BITMAP_BITS(bitmap) ((bitmap) >> BITMAP_BITS_SHIFT)
436
437 /* Debugging macros */
438 #define LOOKS_LIKE_INFO_PTR(p) \
439 ((p) != NULL && \
440 LOOKS_LIKE_INFO_PTR_NOT_NULL(p))
441
442 #define LOOKS_LIKE_INFO_PTR_NOT_NULL(p) \
443 ( (TO_W_(%INFO_TYPE(%STD_INFO(p))) != INVALID_OBJECT) && \
444 (TO_W_(%INFO_TYPE(%STD_INFO(p))) < N_CLOSURE_TYPES))
445
446 #define LOOKS_LIKE_CLOSURE_PTR(p) (LOOKS_LIKE_INFO_PTR(GET_INFO(UNTAG(p))))
447
448 /*
449 * The layout of the StgFunInfoExtra part of an info table changes
450 * depending on TABLES_NEXT_TO_CODE. So we define field access
451 * macros which use the appropriate version here:
452 */
453 #ifdef TABLES_NEXT_TO_CODE
454 /*
455 * when TABLES_NEXT_TO_CODE, slow_apply is stored as an offset
456 * instead of the normal pointer.
457 */
458
459 #define StgFunInfoExtra_slow_apply(fun_info) \
460 (TO_W_(StgFunInfoExtraRev_slow_apply_offset(fun_info)) \
461 + (fun_info) + SIZEOF_StgFunInfoExtraRev + SIZEOF_StgInfoTable)
462
463 #define StgFunInfoExtra_fun_type(i) StgFunInfoExtraRev_fun_type(i)
464 #define StgFunInfoExtra_arity(i) StgFunInfoExtraRev_arity(i)
465 #define StgFunInfoExtra_bitmap(i) StgFunInfoExtraRev_bitmap(i)
466 #else
467 #define StgFunInfoExtra_slow_apply(i) StgFunInfoExtraFwd_slow_apply(i)
468 #define StgFunInfoExtra_fun_type(i) StgFunInfoExtraFwd_fun_type(i)
469 #define StgFunInfoExtra_arity(i) StgFunInfoExtraFwd_arity(i)
470 #define StgFunInfoExtra_bitmap(i) StgFunInfoExtraFwd_bitmap(i)
471 #endif
472
473 #define mutArrCardMask ((1 << MUT_ARR_PTRS_CARD_BITS) - 1)
474 #define mutArrPtrCardDown(i) ((i) >> MUT_ARR_PTRS_CARD_BITS)
475 #define mutArrPtrCardUp(i) (((i) + mutArrCardMask) >> MUT_ARR_PTRS_CARD_BITS)
476 #define mutArrPtrsCardWords(n) ROUNDUP_BYTES_TO_WDS(mutArrPtrCardUp(n))
477
478 #if defined(PROFILING) || (!defined(THREADED_RTS) && defined(DEBUG))
479 #define OVERWRITING_CLOSURE(c) foreign "C" overwritingClosure(c "ptr")
480 #else
481 #define OVERWRITING_CLOSURE(c) /* nothing */
482 #endif
483
484 /* -----------------------------------------------------------------------------
485 Voluntary Yields/Blocks
486
487 We only have a generic version of this at the moment - if it turns
488 out to be slowing us down we can make specialised ones.
489 -------------------------------------------------------------------------- */
490
491 #define YIELD(liveness,reentry) \
492 R9 = liveness; \
493 R10 = reentry; \
494 jump stg_gen_yield;
495
496 #define BLOCK(liveness,reentry) \
497 R9 = liveness; \
498 R10 = reentry; \
499 jump stg_gen_block;
500
501 /* -----------------------------------------------------------------------------
502 Ticky macros
503 -------------------------------------------------------------------------- */
504
505 #ifdef TICKY_TICKY
506 #define TICK_BUMP_BY(ctr,n) CLong[ctr] = CLong[ctr] + n
507 #else
508 #define TICK_BUMP_BY(ctr,n) /* nothing */
509 #endif
510
511 #define TICK_BUMP(ctr) TICK_BUMP_BY(ctr,1)
512
513 #define TICK_ENT_DYN_IND() TICK_BUMP(ENT_DYN_IND_ctr)
514 #define TICK_ENT_DYN_THK() TICK_BUMP(ENT_DYN_THK_ctr)
515 #define TICK_ENT_VIA_NODE() TICK_BUMP(ENT_VIA_NODE_ctr)
516 #define TICK_ENT_STATIC_IND() TICK_BUMP(ENT_STATIC_IND_ctr)
517 #define TICK_ENT_PERM_IND() TICK_BUMP(ENT_PERM_IND_ctr)
518 #define TICK_ENT_PAP() TICK_BUMP(ENT_PAP_ctr)
519 #define TICK_ENT_AP() TICK_BUMP(ENT_AP_ctr)
520 #define TICK_ENT_AP_STACK() TICK_BUMP(ENT_AP_STACK_ctr)
521 #define TICK_ENT_BH() TICK_BUMP(ENT_BH_ctr)
522 #define TICK_UNKNOWN_CALL() TICK_BUMP(UNKNOWN_CALL_ctr)
523 #define TICK_UPDF_PUSHED() TICK_BUMP(UPDF_PUSHED_ctr)
524 #define TICK_CATCHF_PUSHED() TICK_BUMP(CATCHF_PUSHED_ctr)
525 #define TICK_UPDF_OMITTED() TICK_BUMP(UPDF_OMITTED_ctr)
526 #define TICK_UPD_NEW_IND() TICK_BUMP(UPD_NEW_IND_ctr)
527 #define TICK_UPD_NEW_PERM_IND() TICK_BUMP(UPD_NEW_PERM_IND_ctr)
528 #define TICK_UPD_OLD_IND() TICK_BUMP(UPD_OLD_IND_ctr)
529 #define TICK_UPD_OLD_PERM_IND() TICK_BUMP(UPD_OLD_PERM_IND_ctr)
530
531 #define TICK_SLOW_CALL_FUN_TOO_FEW() TICK_BUMP(SLOW_CALL_FUN_TOO_FEW_ctr)
532 #define TICK_SLOW_CALL_FUN_CORRECT() TICK_BUMP(SLOW_CALL_FUN_CORRECT_ctr)
533 #define TICK_SLOW_CALL_FUN_TOO_MANY() TICK_BUMP(SLOW_CALL_FUN_TOO_MANY_ctr)
534 #define TICK_SLOW_CALL_PAP_TOO_FEW() TICK_BUMP(SLOW_CALL_PAP_TOO_FEW_ctr)
535 #define TICK_SLOW_CALL_PAP_CORRECT() TICK_BUMP(SLOW_CALL_PAP_CORRECT_ctr)
536 #define TICK_SLOW_CALL_PAP_TOO_MANY() TICK_BUMP(SLOW_CALL_PAP_TOO_MANY_ctr)
537
538 #define TICK_SLOW_CALL_v() TICK_BUMP(SLOW_CALL_v_ctr)
539 #define TICK_SLOW_CALL_p() TICK_BUMP(SLOW_CALL_p_ctr)
540 #define TICK_SLOW_CALL_pv() TICK_BUMP(SLOW_CALL_pv_ctr)
541 #define TICK_SLOW_CALL_pp() TICK_BUMP(SLOW_CALL_pp_ctr)
542 #define TICK_SLOW_CALL_ppp() TICK_BUMP(SLOW_CALL_ppp_ctr)
543 #define TICK_SLOW_CALL_pppp() TICK_BUMP(SLOW_CALL_pppp_ctr)
544 #define TICK_SLOW_CALL_ppppp() TICK_BUMP(SLOW_CALL_ppppp_ctr)
545 #define TICK_SLOW_CALL_pppppp() TICK_BUMP(SLOW_CALL_pppppp_ctr)
546
547 /* NOTE: TICK_HISTO_BY and TICK_HISTO
548 currently have no effect.
549 The old code for it didn't typecheck and I
550 just commented it out to get ticky to work.
551 - krc 1/2007 */
552
553 #define TICK_HISTO_BY(histo,n,i) /* nothing */
554
555 #define TICK_HISTO(histo,n) TICK_HISTO_BY(histo,n,1)
556
557 /* An unboxed tuple with n components. */
558 #define TICK_RET_UNBOXED_TUP(n) \
559 TICK_BUMP(RET_UNBOXED_TUP_ctr++); \
560 TICK_HISTO(RET_UNBOXED_TUP,n)
561
562 /*
563 * A slow call with n arguments. In the unevald case, this call has
564 * already been counted once, so don't count it again.
565 */
566 #define TICK_SLOW_CALL(n) \
567 TICK_BUMP(SLOW_CALL_ctr); \
568 TICK_HISTO(SLOW_CALL,n)
569
570 /*
571 * This slow call was found to be to an unevaluated function; undo the
572 * ticks we did in TICK_SLOW_CALL.
573 */
574 #define TICK_SLOW_CALL_UNEVALD(n) \
575 TICK_BUMP(SLOW_CALL_UNEVALD_ctr); \
576 TICK_BUMP_BY(SLOW_CALL_ctr,-1); \
577 TICK_HISTO_BY(SLOW_CALL,n,-1);
578
579 /* Updating a closure with a new CON */
580 #define TICK_UPD_CON_IN_NEW(n) \
581 TICK_BUMP(UPD_CON_IN_NEW_ctr); \
582 TICK_HISTO(UPD_CON_IN_NEW,n)
583
584 #define TICK_ALLOC_HEAP_NOCTR(n) \
585 TICK_BUMP(ALLOC_HEAP_ctr); \
586 TICK_BUMP_BY(ALLOC_HEAP_tot,n)
587
588 /* -----------------------------------------------------------------------------
589 Misc junk
590 -------------------------------------------------------------------------- */
591
592 #define NO_TREC stg_NO_TREC_closure
593 #define END_TSO_QUEUE stg_END_TSO_QUEUE_closure
594 #define END_INVARIANT_CHECK_QUEUE stg_END_INVARIANT_CHECK_QUEUE_closure
595
596 #define recordMutableCap(p, gen, regs) \
597 W_ __bd; \
598 W_ mut_list; \
599 mut_list = Capability_mut_lists(MyCapability()) + WDS(gen); \
600 __bd = W_[mut_list]; \
601 if (bdescr_free(__bd) >= bdescr_start(__bd) + BLOCK_SIZE) { \
602 W_ __new_bd; \
603 ("ptr" __new_bd) = foreign "C" allocBlock_lock() [regs]; \
604 bdescr_link(__new_bd) = __bd; \
605 __bd = __new_bd; \
606 W_[mut_list] = __bd; \
607 } \
608 W_ free; \
609 free = bdescr_free(__bd); \
610 W_[free] = p; \
611 bdescr_free(__bd) = free + WDS(1);
612
613 #define recordMutable(p, regs) \
614 P_ __p; \
615 W_ __bd; \
616 W_ __gen; \
617 __p = p; \
618 __bd = Bdescr(__p); \
619 __gen = TO_W_(bdescr_gen_no(__bd)); \
620 if (__gen > 0) { recordMutableCap(__p, __gen, regs); }
621
622 #endif /* CMM_H */