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