Merge branch 'master' of http://darcs.haskell.org/ghc
[ghc.git] / includes / Cmm.h
1 /* -----------------------------------------------------------------------------
2 *
3 * (c) The University of Glasgow 2004-2013
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 * Accessing fields of structures defined in the RTS header files is
13 * done via automatically-generated macros in DerivedConstants.h. For
14 * example, where previously we used
15 *
16 * CurrentTSO->what_next = x
17 *
18 * in C-- we now use
19 *
20 * StgTSO_what_next(CurrentTSO) = x
21 *
22 * where the StgTSO_what_next() macro is automatically generated by
23 * mkDerivedConstants.c. If you need to access a field that doesn't
24 * already have a macro, edit that file (it's pretty self-explanatory).
25 *
26 * -------------------------------------------------------------------------- */
27
28 #ifndef CMM_H
29 #define CMM_H
30
31 /*
32 * In files that are included into both C and C-- (and perhaps
33 * Haskell) sources, we sometimes need to conditionally compile bits
34 * depending on the language. CMINUSMINUS==1 in .cmm sources:
35 */
36 #define CMINUSMINUS 1
37
38 #include "ghcconfig.h"
39
40 /* -----------------------------------------------------------------------------
41 Types
42
43 The following synonyms for C-- types are declared here:
44
45 I8, I16, I32, I64 MachRep-style names for convenience
46
47 W_ is shorthand for the word type (== StgWord)
48 F_ shorthand for float (F_ == StgFloat == C's float)
49 D_ shorthand for double (D_ == StgDouble == C's double)
50
51 CInt has the same size as an int in C on this platform
52 CLong has the same size as a long in C on this platform
53
54 --------------------------------------------------------------------------- */
55
56 #define I8 bits8
57 #define I16 bits16
58 #define I32 bits32
59 #define I64 bits64
60 #define P_ gcptr
61
62 #if SIZEOF_VOID_P == 4
63 #define W_ bits32
64 /* Maybe it's better to include MachDeps.h */
65 #define TAG_BITS 2
66 #elif SIZEOF_VOID_P == 8
67 #define W_ bits64
68 /* Maybe it's better to include MachDeps.h */
69 #define TAG_BITS 3
70 #else
71 #error Unknown word size
72 #endif
73
74 /*
75 * The RTS must sometimes UNTAG a pointer before dereferencing it.
76 * See the wiki page Commentary/Rts/HaskellExecution/PointerTagging
77 */
78 #define TAG_MASK ((1 << TAG_BITS) - 1)
79 #define UNTAG(p) (p & ~TAG_MASK)
80 #define GETTAG(p) (p & TAG_MASK)
81
82 #if SIZEOF_INT == 4
83 #define CInt bits32
84 #elif SIZEOF_INT == 8
85 #define CInt bits64
86 #else
87 #error Unknown int size
88 #endif
89
90 #if SIZEOF_LONG == 4
91 #define CLong bits32
92 #elif SIZEOF_LONG == 8
93 #define CLong bits64
94 #else
95 #error Unknown long size
96 #endif
97
98 #define F_ float32
99 #define D_ float64
100 #define L_ bits64
101 #define V16_ bits128
102
103 #define SIZEOF_StgDouble 8
104 #define SIZEOF_StgWord64 8
105
106 /* -----------------------------------------------------------------------------
107 Misc useful stuff
108 -------------------------------------------------------------------------- */
109
110 #define ccall foreign "C"
111
112 #define NULL (0::W_)
113
114 #define STRING(name,str) \
115 section "rodata" { \
116 name : bits8[] str; \
117 } \
118
119 #ifdef TABLES_NEXT_TO_CODE
120 #define RET_LBL(f) f##_info
121 #else
122 #define RET_LBL(f) f##_ret
123 #endif
124
125 #ifdef TABLES_NEXT_TO_CODE
126 #define ENTRY_LBL(f) f##_info
127 #else
128 #define ENTRY_LBL(f) f##_entry
129 #endif
130
131 /* -----------------------------------------------------------------------------
132 Byte/word macros
133
134 Everything in C-- is in byte offsets (well, most things). We use
135 some macros to allow us to express offsets in words and to try to
136 avoid byte/word confusion.
137 -------------------------------------------------------------------------- */
138
139 #define SIZEOF_W SIZEOF_VOID_P
140 #define W_MASK (SIZEOF_W-1)
141
142 #if SIZEOF_W == 4
143 #define W_SHIFT 2
144 #elif SIZEOF_W == 8
145 #define W_SHIFT 3
146 #endif
147
148 /* Converting quantities of words to bytes */
149 #define WDS(n) ((n)*SIZEOF_W)
150
151 /*
152 * Converting quantities of bytes to words
153 * NB. these work on *unsigned* values only
154 */
155 #define BYTES_TO_WDS(n) ((n) / SIZEOF_W)
156 #define ROUNDUP_BYTES_TO_WDS(n) (((n) + SIZEOF_W - 1) / SIZEOF_W)
157
158 /* TO_W_(n) converts n to W_ type from a smaller type */
159 #if SIZEOF_W == 4
160 #define TO_W_(x) %sx32(x)
161 #define HALF_W_(x) %lobits16(x)
162 #elif SIZEOF_W == 8
163 #define TO_W_(x) %sx64(x)
164 #define HALF_W_(x) %lobits32(x)
165 #endif
166
167 #if SIZEOF_INT == 4 && SIZEOF_W == 8
168 #define W_TO_INT(x) %lobits32(x)
169 #elif SIZEOF_INT == SIZEOF_W
170 #define W_TO_INT(x) (x)
171 #endif
172
173 #if SIZEOF_LONG == 4 && SIZEOF_W == 8
174 #define W_TO_LONG(x) %lobits32(x)
175 #elif SIZEOF_LONG == SIZEOF_W
176 #define W_TO_LONG(x) (x)
177 #endif
178
179 /* -----------------------------------------------------------------------------
180 Heap/stack access, and adjusting the heap/stack pointers.
181 -------------------------------------------------------------------------- */
182
183 #define Sp(n) W_[Sp + WDS(n)]
184 #define Hp(n) W_[Hp + WDS(n)]
185
186 #define Sp_adj(n) Sp = Sp + WDS(n) /* pronounced "spadge" */
187 #define Hp_adj(n) Hp = Hp + WDS(n)
188
189 /* -----------------------------------------------------------------------------
190 Assertions and Debuggery
191 -------------------------------------------------------------------------- */
192
193 #ifdef DEBUG
194 #define ASSERT(predicate) \
195 if (predicate) { \
196 /*null*/; \
197 } else { \
198 foreign "C" _assertFail(NULL, __LINE__) never returns; \
199 }
200 #else
201 #define ASSERT(p) /* nothing */
202 #endif
203
204 #ifdef DEBUG
205 #define DEBUG_ONLY(s) s
206 #else
207 #define DEBUG_ONLY(s) /* nothing */
208 #endif
209
210 /*
211 * The IF_DEBUG macro is useful for debug messages that depend on one
212 * of the RTS debug options. For example:
213 *
214 * IF_DEBUG(RtsFlags_DebugFlags_apply,
215 * foreign "C" fprintf(stderr, stg_ap_0_ret_str));
216 *
217 * Note the syntax is slightly different to the C version of this macro.
218 */
219 #ifdef DEBUG
220 #define IF_DEBUG(c,s) if (RtsFlags_DebugFlags_##c(RtsFlags) != 0::I32) { s; }
221 #else
222 #define IF_DEBUG(c,s) /* nothing */
223 #endif
224
225 /* -----------------------------------------------------------------------------
226 Entering
227
228 It isn't safe to "enter" every closure. Functions in particular
229 have no entry code as such; their entry point contains the code to
230 apply the function.
231
232 ToDo: range should end in N_CLOSURE_TYPES-1, not N_CLOSURE_TYPES,
233 but switch doesn't allow us to use exprs there yet.
234
235 If R1 points to a tagged object it points either to
236 * A constructor.
237 * A function with arity <= TAG_MASK.
238 In both cases the right thing to do is to return.
239 Note: it is rather lucky that we can use the tag bits to do this
240 for both objects. Maybe it points to a brittle design?
241
242 Indirections can contain tagged pointers, so their tag is checked.
243 -------------------------------------------------------------------------- */
244
245 #ifdef PROFILING
246
247 // When profiling, we cannot shortcut ENTER() by checking the tag,
248 // because LDV profiling relies on entering closures to mark them as
249 // "used".
250
251 #define LOAD_INFO(ret,x) \
252 info = %INFO_PTR(UNTAG(x));
253
254 #define UNTAG_IF_PROF(x) UNTAG(x)
255
256 #else
257
258 #define LOAD_INFO(ret,x) \
259 if (GETTAG(x) != 0) { \
260 ret(x); \
261 } \
262 info = %INFO_PTR(x);
263
264 #define UNTAG_IF_PROF(x) (x) /* already untagged */
265
266 #endif
267
268 // We need two versions of ENTER():
269 // - ENTER(x) takes the closure as an argument and uses return(),
270 // for use in civilized code where the stack is handled by GHC
271 //
272 // - ENTER_NOSTACK() where the closure is in R1, and returns are
273 // explicit jumps, for use when we are doing the stack management
274 // ourselves.
275
276 #define ENTER(x) ENTER_(return,x)
277 #define ENTER_R1() ENTER_(RET_R1,R1)
278
279 #define RET_R1(x) jump %ENTRY_CODE(Sp(0)) [R1]
280
281 #define ENTER_(ret,x) \
282 again: \
283 W_ info; \
284 LOAD_INFO(ret,x) \
285 switch [INVALID_OBJECT .. N_CLOSURE_TYPES] \
286 (TO_W_( %INFO_TYPE(%STD_INFO(info)) )) { \
287 case \
288 IND, \
289 IND_PERM, \
290 IND_STATIC: \
291 { \
292 x = StgInd_indirectee(x); \
293 goto again; \
294 } \
295 case \
296 FUN, \
297 FUN_1_0, \
298 FUN_0_1, \
299 FUN_2_0, \
300 FUN_1_1, \
301 FUN_0_2, \
302 FUN_STATIC, \
303 BCO, \
304 PAP: \
305 { \
306 ret(x); \
307 } \
308 default: \
309 { \
310 x = UNTAG_IF_PROF(x); \
311 jump %ENTRY_CODE(info) (x); \
312 } \
313 }
314
315 // The FUN cases almost never happen: a pointer to a non-static FUN
316 // should always be tagged. This unfortunately isn't true for the
317 // interpreter right now, which leaves untagged FUNs on the stack.
318
319 /* -----------------------------------------------------------------------------
320 Constants.
321 -------------------------------------------------------------------------- */
322
323 #include "rts/Constants.h"
324 #include "DerivedConstants.h"
325 #include "rts/storage/ClosureTypes.h"
326 #include "rts/storage/FunTypes.h"
327 #include "rts/storage/SMPClosureOps.h"
328 #include "rts/OSThreads.h"
329
330 /*
331 * Need MachRegs, because some of the RTS code is conditionally
332 * compiled based on REG_R1, REG_R2, etc.
333 */
334 #include "stg/RtsMachRegs.h"
335
336 #include "rts/prof/LDV.h"
337
338 #undef BLOCK_SIZE
339 #undef MBLOCK_SIZE
340 #include "rts/storage/Block.h" /* For Bdescr() */
341
342
343 #define MyCapability() (BaseReg - OFFSET_Capability_r)
344
345 /* -------------------------------------------------------------------------
346 Info tables
347 ------------------------------------------------------------------------- */
348
349 #if defined(PROFILING)
350 #define PROF_HDR_FIELDS(w_,hdr1,hdr2) \
351 w_ hdr1, \
352 w_ hdr2,
353 #else
354 #define PROF_HDR_FIELDS(w_,hdr1,hdr2) /* nothing */
355 #endif
356
357 /* -------------------------------------------------------------------------
358 Allocation and garbage collection
359 ------------------------------------------------------------------------- */
360
361 /*
362 * ALLOC_PRIM is for allocating memory on the heap for a primitive
363 * object. It is used all over PrimOps.cmm.
364 *
365 * We make the simplifying assumption that the "admin" part of a
366 * primitive closure is just the header when calculating sizes for
367 * ticky-ticky. It's not clear whether eg. the size field of an array
368 * should be counted as "admin", or the various fields of a BCO.
369 */
370 #define ALLOC_PRIM(bytes) \
371 HP_CHK_GEN_TICKY(bytes); \
372 TICK_ALLOC_PRIM(SIZEOF_StgHeader,bytes-SIZEOF_StgHeader,0); \
373 CCCS_ALLOC(bytes);
374
375 #define HEAP_CHECK(bytes,failure) \
376 TICK_BUMP(HEAP_CHK_ctr); \
377 Hp = Hp + (bytes); \
378 if (Hp > HpLim) { HpAlloc = (bytes); failure; } \
379 TICK_ALLOC_HEAP_NOCTR(bytes);
380
381 #define ALLOC_PRIM_WITH_CUSTOM_FAILURE(bytes,failure) \
382 HEAP_CHECK(bytes,failure) \
383 TICK_ALLOC_PRIM(SIZEOF_StgHeader,bytes-SIZEOF_StgHeader,0); \
384 CCCS_ALLOC(bytes);
385
386 #define ALLOC_PRIM_(bytes,fun) \
387 ALLOC_PRIM_WITH_CUSTOM_FAILURE(bytes,GC_PRIM(fun));
388
389 #define ALLOC_PRIM_P(bytes,fun,arg) \
390 ALLOC_PRIM_WITH_CUSTOM_FAILURE(bytes,GC_PRIM_P(fun,arg));
391
392 #define ALLOC_PRIM_N(bytes,fun,arg) \
393 ALLOC_PRIM_WITH_CUSTOM_FAILURE(bytes,GC_PRIM_N(fun,arg));
394
395 /* CCS_ALLOC wants the size in words, because ccs->mem_alloc is in words */
396 #define CCCS_ALLOC(__alloc) CCS_ALLOC(BYTES_TO_WDS(__alloc), CCCS)
397
398 #define HP_CHK_GEN_TICKY(bytes) \
399 HP_CHK_GEN(bytes); \
400 TICK_ALLOC_HEAP_NOCTR(bytes);
401
402 #define HP_CHK_P(bytes, fun, arg) \
403 HEAP_CHECK(bytes, GC_PRIM_P(fun,arg))
404
405 // TODO I'm not seeing where ALLOC_P_TICKY is used; can it be removed?
406 // -NSF March 2013
407 #define ALLOC_P_TICKY(bytes, fun, arg) \
408 HP_CHK_P(bytes); \
409 TICK_ALLOC_HEAP_NOCTR(bytes);
410
411 #define CHECK_GC() \
412 (bdescr_link(CurrentNursery) == NULL || \
413 generation_n_new_large_words(W_[g0]) >= TO_W_(CLong[large_alloc_lim]))
414
415 // allocate() allocates from the nursery, so we check to see
416 // whether the nursery is nearly empty in any function that uses
417 // allocate() - this includes many of the primops.
418 //
419 // HACK alert: the __L__ stuff is here to coax the common-block
420 // eliminator into commoning up the call stg_gc_noregs() with the same
421 // code that gets generated by a STK_CHK_GEN() in the same proc. We
422 // also need an if (0) { goto __L__; } so that the __L__ label isn't
423 // optimised away by the control-flow optimiser prior to common-block
424 // elimination (it will be optimised away later).
425 //
426 // This saves some code in gmp-wrappers.cmm where we have lots of
427 // MAYBE_GC() in the same proc as STK_CHK_GEN().
428 //
429 #define MAYBE_GC(retry) \
430 if (CHECK_GC()) { \
431 HpAlloc = 0; \
432 goto __L__; \
433 __L__: \
434 call stg_gc_noregs(); \
435 goto retry; \
436 } \
437 if (0) { goto __L__; }
438
439 #define GC_PRIM(fun) \
440 R9 = fun; \
441 jump stg_gc_prim();
442
443 #define GC_PRIM_N(fun,arg) \
444 R9 = fun; \
445 jump stg_gc_prim_n(arg);
446
447 #define GC_PRIM_P(fun,arg) \
448 R9 = fun; \
449 jump stg_gc_prim_p(arg);
450
451 #define GC_PRIM_PP(fun,arg1,arg2) \
452 R9 = fun; \
453 jump stg_gc_prim_pp(arg1,arg2);
454
455 #define MAYBE_GC_(fun) \
456 if (CHECK_GC()) { \
457 HpAlloc = 0; \
458 GC_PRIM(fun) \
459 }
460
461 #define MAYBE_GC_N(fun,arg) \
462 if (CHECK_GC()) { \
463 HpAlloc = 0; \
464 GC_PRIM_N(fun,arg) \
465 }
466
467 #define MAYBE_GC_P(fun,arg) \
468 if (CHECK_GC()) { \
469 HpAlloc = 0; \
470 GC_PRIM_P(fun,arg) \
471 }
472
473 #define MAYBE_GC_PP(fun,arg1,arg2) \
474 if (CHECK_GC()) { \
475 HpAlloc = 0; \
476 GC_PRIM_PP(fun,arg1,arg2) \
477 }
478
479 #define STK_CHK(n, fun) \
480 TICK_BUMP(STK_CHK_ctr); \
481 if (Sp - (n) < SpLim) { \
482 GC_PRIM(fun) \
483 }
484
485 #define STK_CHK_P(n, fun, arg) \
486 if (Sp - (n) < SpLim) { \
487 GC_PRIM_P(fun,arg) \
488 }
489
490 #define STK_CHK_PP(n, fun, arg1, arg2) \
491 if (Sp - (n) < SpLim) { \
492 GC_PRIM_PP(fun,arg1,arg2) \
493 }
494
495 #define STK_CHK_ENTER(n, closure) \
496 if (Sp - (n) < SpLim) { \
497 jump __stg_gc_enter_1(closure); \
498 }
499
500 // A funky heap check used by AutoApply.cmm
501
502 #define HP_CHK_NP_ASSIGN_SP0(size,f) \
503 HEAP_CHECK(size, Sp(0) = f; jump __stg_gc_enter_1 [R1];)
504
505 /* -----------------------------------------------------------------------------
506 Closure headers
507 -------------------------------------------------------------------------- */
508
509 /*
510 * This is really ugly, since we don't do the rest of StgHeader this
511 * way. The problem is that values from DerivedConstants.h cannot be
512 * dependent on the way (SMP, PROF etc.). For SIZEOF_StgHeader we get
513 * the value from GHC, but it seems like too much trouble to do that
514 * for StgThunkHeader.
515 */
516 #define SIZEOF_StgThunkHeader SIZEOF_StgHeader+SIZEOF_StgSMPThunkHeader
517
518 #define StgThunk_payload(__ptr__,__ix__) \
519 W_[__ptr__+SIZEOF_StgThunkHeader+ WDS(__ix__)]
520
521 /* -----------------------------------------------------------------------------
522 Closures
523 -------------------------------------------------------------------------- */
524
525 /* The offset of the payload of an array */
526 #define BYTE_ARR_CTS(arr) ((arr) + SIZEOF_StgArrWords)
527
528 /* The number of words allocated in an array payload */
529 #define BYTE_ARR_WDS(arr) ROUNDUP_BYTES_TO_WDS(StgArrWords_bytes(arr))
530
531 /* Getting/setting the info pointer of a closure */
532 #define SET_INFO(p,info) StgHeader_info(p) = info
533 #define GET_INFO(p) StgHeader_info(p)
534
535 /* Determine the size of an ordinary closure from its info table */
536 #define sizeW_fromITBL(itbl) \
537 SIZEOF_StgHeader + WDS(%INFO_PTRS(itbl)) + WDS(%INFO_NPTRS(itbl))
538
539 /* NB. duplicated from InfoTables.h! */
540 #define BITMAP_SIZE(bitmap) ((bitmap) & BITMAP_SIZE_MASK)
541 #define BITMAP_BITS(bitmap) ((bitmap) >> BITMAP_BITS_SHIFT)
542
543 /* Debugging macros */
544 #define LOOKS_LIKE_INFO_PTR(p) \
545 ((p) != NULL && \
546 LOOKS_LIKE_INFO_PTR_NOT_NULL(p))
547
548 #define LOOKS_LIKE_INFO_PTR_NOT_NULL(p) \
549 ( (TO_W_(%INFO_TYPE(%STD_INFO(p))) != INVALID_OBJECT) && \
550 (TO_W_(%INFO_TYPE(%STD_INFO(p))) < N_CLOSURE_TYPES))
551
552 #define LOOKS_LIKE_CLOSURE_PTR(p) (LOOKS_LIKE_INFO_PTR(GET_INFO(UNTAG(p))))
553
554 /*
555 * The layout of the StgFunInfoExtra part of an info table changes
556 * depending on TABLES_NEXT_TO_CODE. So we define field access
557 * macros which use the appropriate version here:
558 */
559 #ifdef TABLES_NEXT_TO_CODE
560 /*
561 * when TABLES_NEXT_TO_CODE, slow_apply is stored as an offset
562 * instead of the normal pointer.
563 */
564
565 #define StgFunInfoExtra_slow_apply(fun_info) \
566 (TO_W_(StgFunInfoExtraRev_slow_apply_offset(fun_info)) \
567 + (fun_info) + SIZEOF_StgFunInfoExtraRev + SIZEOF_StgInfoTable)
568
569 #define StgFunInfoExtra_fun_type(i) StgFunInfoExtraRev_fun_type(i)
570 #define StgFunInfoExtra_arity(i) StgFunInfoExtraRev_arity(i)
571 #define StgFunInfoExtra_bitmap(i) StgFunInfoExtraRev_bitmap(i)
572 #else
573 #define StgFunInfoExtra_slow_apply(i) StgFunInfoExtraFwd_slow_apply(i)
574 #define StgFunInfoExtra_fun_type(i) StgFunInfoExtraFwd_fun_type(i)
575 #define StgFunInfoExtra_arity(i) StgFunInfoExtraFwd_arity(i)
576 #define StgFunInfoExtra_bitmap(i) StgFunInfoExtraFwd_bitmap(i)
577 #endif
578
579 #define mutArrCardMask ((1 << MUT_ARR_PTRS_CARD_BITS) - 1)
580 #define mutArrPtrCardDown(i) ((i) >> MUT_ARR_PTRS_CARD_BITS)
581 #define mutArrPtrCardUp(i) (((i) + mutArrCardMask) >> MUT_ARR_PTRS_CARD_BITS)
582 #define mutArrPtrsCardWords(n) ROUNDUP_BYTES_TO_WDS(mutArrPtrCardUp(n))
583
584 #if defined(PROFILING) || (!defined(THREADED_RTS) && defined(DEBUG))
585 #define OVERWRITING_CLOSURE(c) foreign "C" overwritingClosure(c "ptr")
586 #else
587 #define OVERWRITING_CLOSURE(c) /* nothing */
588 #endif
589
590 #ifdef THREADED_RTS
591 #define prim_write_barrier prim %write_barrier()
592 #else
593 #define prim_write_barrier /* nothing */
594 #endif
595
596 /* -----------------------------------------------------------------------------
597 Ticky macros
598 -------------------------------------------------------------------------- */
599
600 #ifdef TICKY_TICKY
601 #define TICK_BUMP_BY(ctr,n) CLong[ctr] = CLong[ctr] + n
602 #else
603 #define TICK_BUMP_BY(ctr,n) /* nothing */
604 #endif
605
606 #define TICK_BUMP(ctr) TICK_BUMP_BY(ctr,1)
607
608 #define TICK_ENT_DYN_IND() TICK_BUMP(ENT_DYN_IND_ctr)
609 #define TICK_ENT_DYN_THK() TICK_BUMP(ENT_DYN_THK_ctr)
610 #define TICK_ENT_VIA_NODE() TICK_BUMP(ENT_VIA_NODE_ctr)
611 #define TICK_ENT_STATIC_IND() TICK_BUMP(ENT_STATIC_IND_ctr)
612 #define TICK_ENT_PERM_IND() TICK_BUMP(ENT_PERM_IND_ctr)
613 #define TICK_ENT_PAP() TICK_BUMP(ENT_PAP_ctr)
614 #define TICK_ENT_AP() TICK_BUMP(ENT_AP_ctr)
615 #define TICK_ENT_AP_STACK() TICK_BUMP(ENT_AP_STACK_ctr)
616 #define TICK_ENT_BH() TICK_BUMP(ENT_BH_ctr)
617 #define TICK_ENT_LNE() TICK_BUMP(ENT_LNE_ctr)
618 #define TICK_UNKNOWN_CALL() TICK_BUMP(UNKNOWN_CALL_ctr)
619 #define TICK_UPDF_PUSHED() TICK_BUMP(UPDF_PUSHED_ctr)
620 #define TICK_CATCHF_PUSHED() TICK_BUMP(CATCHF_PUSHED_ctr)
621 #define TICK_UPDF_OMITTED() TICK_BUMP(UPDF_OMITTED_ctr)
622 #define TICK_UPD_NEW_IND() TICK_BUMP(UPD_NEW_IND_ctr)
623 #define TICK_UPD_NEW_PERM_IND() TICK_BUMP(UPD_NEW_PERM_IND_ctr)
624 #define TICK_UPD_OLD_IND() TICK_BUMP(UPD_OLD_IND_ctr)
625 #define TICK_UPD_OLD_PERM_IND() TICK_BUMP(UPD_OLD_PERM_IND_ctr)
626
627 #define TICK_SLOW_CALL_FUN_TOO_FEW() TICK_BUMP(SLOW_CALL_FUN_TOO_FEW_ctr)
628 #define TICK_SLOW_CALL_FUN_CORRECT() TICK_BUMP(SLOW_CALL_FUN_CORRECT_ctr)
629 #define TICK_SLOW_CALL_FUN_TOO_MANY() TICK_BUMP(SLOW_CALL_FUN_TOO_MANY_ctr)
630 #define TICK_SLOW_CALL_PAP_TOO_FEW() TICK_BUMP(SLOW_CALL_PAP_TOO_FEW_ctr)
631 #define TICK_SLOW_CALL_PAP_CORRECT() TICK_BUMP(SLOW_CALL_PAP_CORRECT_ctr)
632 #define TICK_SLOW_CALL_PAP_TOO_MANY() TICK_BUMP(SLOW_CALL_PAP_TOO_MANY_ctr)
633
634 #define TICK_SLOW_CALL_fast_v16() TICK_BUMP(SLOW_CALL_fast_v16_ctr)
635 #define TICK_SLOW_CALL_fast_v() TICK_BUMP(SLOW_CALL_fast_v_ctr)
636 #define TICK_SLOW_CALL_fast_p() TICK_BUMP(SLOW_CALL_fast_p_ctr)
637 #define TICK_SLOW_CALL_fast_pv() TICK_BUMP(SLOW_CALL_fast_pv_ctr)
638 #define TICK_SLOW_CALL_fast_pp() TICK_BUMP(SLOW_CALL_fast_pp_ctr)
639 #define TICK_SLOW_CALL_fast_ppv() TICK_BUMP(SLOW_CALL_fast_ppv_ctr)
640 #define TICK_SLOW_CALL_fast_ppp() TICK_BUMP(SLOW_CALL_fast_ppp_ctr)
641 #define TICK_SLOW_CALL_fast_pppv() TICK_BUMP(SLOW_CALL_fast_pppv_ctr)
642 #define TICK_SLOW_CALL_fast_pppp() TICK_BUMP(SLOW_CALL_fast_pppp_ctr)
643 #define TICK_SLOW_CALL_fast_ppppp() TICK_BUMP(SLOW_CALL_fast_ppppp_ctr)
644 #define TICK_SLOW_CALL_fast_pppppp() TICK_BUMP(SLOW_CALL_fast_pppppp_ctr)
645 #define TICK_VERY_SLOW_CALL() TICK_BUMP(VERY_SLOW_CALL_ctr)
646
647 /* NOTE: TICK_HISTO_BY and TICK_HISTO
648 currently have no effect.
649 The old code for it didn't typecheck and I
650 just commented it out to get ticky to work.
651 - krc 1/2007 */
652
653 #define TICK_HISTO_BY(histo,n,i) /* nothing */
654
655 #define TICK_HISTO(histo,n) TICK_HISTO_BY(histo,n,1)
656
657 /* An unboxed tuple with n components. */
658 #define TICK_RET_UNBOXED_TUP(n) \
659 TICK_BUMP(RET_UNBOXED_TUP_ctr++); \
660 TICK_HISTO(RET_UNBOXED_TUP,n)
661
662 /*
663 * A slow call with n arguments. In the unevald case, this call has
664 * already been counted once, so don't count it again.
665 */
666 #define TICK_SLOW_CALL(n) \
667 TICK_BUMP(SLOW_CALL_ctr); \
668 TICK_HISTO(SLOW_CALL,n)
669
670 /*
671 * This slow call was found to be to an unevaluated function; undo the
672 * ticks we did in TICK_SLOW_CALL.
673 */
674 #define TICK_SLOW_CALL_UNEVALD(n) \
675 TICK_BUMP(SLOW_CALL_UNEVALD_ctr); \
676 TICK_BUMP_BY(SLOW_CALL_ctr,-1); \
677 TICK_HISTO_BY(SLOW_CALL,n,-1);
678
679 /* Updating a closure with a new CON */
680 #define TICK_UPD_CON_IN_NEW(n) \
681 TICK_BUMP(UPD_CON_IN_NEW_ctr); \
682 TICK_HISTO(UPD_CON_IN_NEW,n)
683
684 #define TICK_ALLOC_HEAP_NOCTR(bytes) \
685 TICK_BUMP(ALLOC_RTS_ctr); \
686 TICK_BUMP_BY(ALLOC_RTS_tot,bytes)
687
688 /* -----------------------------------------------------------------------------
689 Saving and restoring STG registers
690
691 STG registers must be saved around a C call, just in case the STG
692 register is mapped to a caller-saves machine register. Normally we
693 don't need to worry about this the code generator has already
694 loaded any live STG registers into variables for us, but in
695 hand-written low-level Cmm code where we don't know which registers
696 are live, we might have to save them all.
697 -------------------------------------------------------------------------- */
698
699 #define SAVE_STGREGS \
700 W_ r1, r2, r3, r4, r5, r6, r7, r8; \
701 F_ f1, f2, f3, f4, f5, f6; \
702 D_ d1, d2, d3, d4, d5, d6; \
703 L_ l1; \
704 \
705 r1 = R1; \
706 r2 = R2; \
707 r3 = R3; \
708 r4 = R4; \
709 r5 = R5; \
710 r6 = R6; \
711 r7 = R7; \
712 r8 = R8; \
713 \
714 f1 = F1; \
715 f2 = F2; \
716 f3 = F3; \
717 f4 = F4; \
718 f5 = F5; \
719 f6 = F6; \
720 \
721 d1 = D1; \
722 d2 = D2; \
723 d3 = D3; \
724 d4 = D4; \
725 d5 = D5; \
726 d6 = D6; \
727 \
728 l1 = L1;
729
730
731 #define RESTORE_STGREGS \
732 R1 = r1; \
733 R2 = r2; \
734 R3 = r3; \
735 R4 = r4; \
736 R5 = r5; \
737 R6 = r6; \
738 R7 = r7; \
739 R8 = r8; \
740 \
741 F1 = f1; \
742 F2 = f2; \
743 F3 = f3; \
744 F4 = f4; \
745 F5 = f5; \
746 F6 = f6; \
747 \
748 D1 = d1; \
749 D2 = d2; \
750 D3 = d3; \
751 D4 = d4; \
752 D5 = d5; \
753 D6 = d6; \
754 \
755 L1 = l1;
756
757 /* -----------------------------------------------------------------------------
758 Misc junk
759 -------------------------------------------------------------------------- */
760
761 #define NO_TREC stg_NO_TREC_closure
762 #define END_TSO_QUEUE stg_END_TSO_QUEUE_closure
763 #define STM_AWOKEN stg_STM_AWOKEN_closure
764 #define END_INVARIANT_CHECK_QUEUE stg_END_INVARIANT_CHECK_QUEUE_closure
765
766 #define recordMutableCap(p, gen) \
767 W_ __bd; \
768 W_ mut_list; \
769 mut_list = Capability_mut_lists(MyCapability()) + WDS(gen); \
770 __bd = W_[mut_list]; \
771 if (bdescr_free(__bd) >= bdescr_start(__bd) + BLOCK_SIZE) { \
772 W_ __new_bd; \
773 ("ptr" __new_bd) = foreign "C" allocBlock_lock(); \
774 bdescr_link(__new_bd) = __bd; \
775 __bd = __new_bd; \
776 W_[mut_list] = __bd; \
777 } \
778 W_ free; \
779 free = bdescr_free(__bd); \
780 W_[free] = p; \
781 bdescr_free(__bd) = free + WDS(1);
782
783 #define recordMutable(p) \
784 P_ __p; \
785 W_ __bd; \
786 W_ __gen; \
787 __p = p; \
788 __bd = Bdescr(__p); \
789 __gen = TO_W_(bdescr_gen_no(__bd)); \
790 if (__gen > 0) { recordMutableCap(__p, __gen); }
791
792 #endif /* CMM_H */