A collection of type-inference refactorings.
[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 #define V32_ bits256
103 #define V64_ bits512
104
105 #define SIZEOF_StgDouble 8
106 #define SIZEOF_StgWord64 8
107
108 /* -----------------------------------------------------------------------------
109 Misc useful stuff
110 -------------------------------------------------------------------------- */
111
112 #define ccall foreign "C"
113
114 #define NULL (0::W_)
115
116 #define STRING(name,str) \
117 section "rodata" { \
118 name : bits8[] str; \
119 } \
120
121 #ifdef TABLES_NEXT_TO_CODE
122 #define RET_LBL(f) f##_info
123 #else
124 #define RET_LBL(f) f##_ret
125 #endif
126
127 #ifdef TABLES_NEXT_TO_CODE
128 #define ENTRY_LBL(f) f##_info
129 #else
130 #define ENTRY_LBL(f) f##_entry
131 #endif
132
133 /* -----------------------------------------------------------------------------
134 Byte/word macros
135
136 Everything in C-- is in byte offsets (well, most things). We use
137 some macros to allow us to express offsets in words and to try to
138 avoid byte/word confusion.
139 -------------------------------------------------------------------------- */
140
141 #define SIZEOF_W SIZEOF_VOID_P
142 #define W_MASK (SIZEOF_W-1)
143
144 #if SIZEOF_W == 4
145 #define W_SHIFT 2
146 #elif SIZEOF_W == 8
147 #define W_SHIFT 3
148 #endif
149
150 /* Converting quantities of words to bytes */
151 #define WDS(n) ((n)*SIZEOF_W)
152
153 /*
154 * Converting quantities of bytes to words
155 * NB. these work on *unsigned* values only
156 */
157 #define BYTES_TO_WDS(n) ((n) / SIZEOF_W)
158 #define ROUNDUP_BYTES_TO_WDS(n) (((n) + SIZEOF_W - 1) / SIZEOF_W)
159
160 /* TO_W_(n) converts n to W_ type from a smaller type */
161 #if SIZEOF_W == 4
162 #define TO_W_(x) %sx32(x)
163 #define HALF_W_(x) %lobits16(x)
164 #elif SIZEOF_W == 8
165 #define TO_W_(x) %sx64(x)
166 #define HALF_W_(x) %lobits32(x)
167 #endif
168
169 #if SIZEOF_INT == 4 && SIZEOF_W == 8
170 #define W_TO_INT(x) %lobits32(x)
171 #elif SIZEOF_INT == SIZEOF_W
172 #define W_TO_INT(x) (x)
173 #endif
174
175 #if SIZEOF_LONG == 4 && SIZEOF_W == 8
176 #define W_TO_LONG(x) %lobits32(x)
177 #elif SIZEOF_LONG == SIZEOF_W
178 #define W_TO_LONG(x) (x)
179 #endif
180
181 /* -----------------------------------------------------------------------------
182 Atomic memory operations.
183 -------------------------------------------------------------------------- */
184
185 #if SIZEOF_W == 4
186 #define cmpxchgW cmpxchg32
187 #elif SIZEOF_W == 8
188 #define cmpxchgW cmpxchg64
189 #endif
190
191 /* -----------------------------------------------------------------------------
192 Heap/stack access, and adjusting the heap/stack pointers.
193 -------------------------------------------------------------------------- */
194
195 #define Sp(n) W_[Sp + WDS(n)]
196 #define Hp(n) W_[Hp + WDS(n)]
197
198 #define Sp_adj(n) Sp = Sp + WDS(n) /* pronounced "spadge" */
199 #define Hp_adj(n) Hp = Hp + WDS(n)
200
201 /* -----------------------------------------------------------------------------
202 Assertions and Debuggery
203 -------------------------------------------------------------------------- */
204
205 #ifdef DEBUG
206 #define ASSERT(predicate) \
207 if (predicate) { \
208 /*null*/; \
209 } else { \
210 foreign "C" _assertFail(NULL, __LINE__) never returns; \
211 }
212 #else
213 #define ASSERT(p) /* nothing */
214 #endif
215
216 #ifdef DEBUG
217 #define DEBUG_ONLY(s) s
218 #else
219 #define DEBUG_ONLY(s) /* nothing */
220 #endif
221
222 /*
223 * The IF_DEBUG macro is useful for debug messages that depend on one
224 * of the RTS debug options. For example:
225 *
226 * IF_DEBUG(RtsFlags_DebugFlags_apply,
227 * foreign "C" fprintf(stderr, stg_ap_0_ret_str));
228 *
229 * Note the syntax is slightly different to the C version of this macro.
230 */
231 #ifdef DEBUG
232 #define IF_DEBUG(c,s) if (RtsFlags_DebugFlags_##c(RtsFlags) != 0::I32) { s; }
233 #else
234 #define IF_DEBUG(c,s) /* nothing */
235 #endif
236
237 /* -----------------------------------------------------------------------------
238 Entering
239
240 It isn't safe to "enter" every closure. Functions in particular
241 have no entry code as such; their entry point contains the code to
242 apply the function.
243
244 ToDo: range should end in N_CLOSURE_TYPES-1, not N_CLOSURE_TYPES,
245 but switch doesn't allow us to use exprs there yet.
246
247 If R1 points to a tagged object it points either to
248 * A constructor.
249 * A function with arity <= TAG_MASK.
250 In both cases the right thing to do is to return.
251 Note: it is rather lucky that we can use the tag bits to do this
252 for both objects. Maybe it points to a brittle design?
253
254 Indirections can contain tagged pointers, so their tag is checked.
255 -------------------------------------------------------------------------- */
256
257 #ifdef PROFILING
258
259 // When profiling, we cannot shortcut ENTER() by checking the tag,
260 // because LDV profiling relies on entering closures to mark them as
261 // "used".
262
263 #define LOAD_INFO(ret,x) \
264 info = %INFO_PTR(UNTAG(x));
265
266 #define UNTAG_IF_PROF(x) UNTAG(x)
267
268 #else
269
270 #define LOAD_INFO(ret,x) \
271 if (GETTAG(x) != 0) { \
272 ret(x); \
273 } \
274 info = %INFO_PTR(x);
275
276 #define UNTAG_IF_PROF(x) (x) /* already untagged */
277
278 #endif
279
280 // We need two versions of ENTER():
281 // - ENTER(x) takes the closure as an argument and uses return(),
282 // for use in civilized code where the stack is handled by GHC
283 //
284 // - ENTER_NOSTACK() where the closure is in R1, and returns are
285 // explicit jumps, for use when we are doing the stack management
286 // ourselves.
287
288 #define ENTER(x) ENTER_(return,x)
289 #define ENTER_R1() ENTER_(RET_R1,R1)
290
291 #define RET_R1(x) jump %ENTRY_CODE(Sp(0)) [R1]
292
293 #define ENTER_(ret,x) \
294 again: \
295 W_ info; \
296 LOAD_INFO(ret,x) \
297 switch [INVALID_OBJECT .. N_CLOSURE_TYPES] \
298 (TO_W_( %INFO_TYPE(%STD_INFO(info)) )) { \
299 case \
300 IND, \
301 IND_STATIC: \
302 { \
303 x = StgInd_indirectee(x); \
304 goto again; \
305 } \
306 case \
307 FUN, \
308 FUN_1_0, \
309 FUN_0_1, \
310 FUN_2_0, \
311 FUN_1_1, \
312 FUN_0_2, \
313 FUN_STATIC, \
314 BCO, \
315 PAP: \
316 { \
317 ret(x); \
318 } \
319 default: \
320 { \
321 x = UNTAG_IF_PROF(x); \
322 jump %ENTRY_CODE(info) (x); \
323 } \
324 }
325
326 // The FUN cases almost never happen: a pointer to a non-static FUN
327 // should always be tagged. This unfortunately isn't true for the
328 // interpreter right now, which leaves untagged FUNs on the stack.
329
330 /* -----------------------------------------------------------------------------
331 Constants.
332 -------------------------------------------------------------------------- */
333
334 #include "rts/Constants.h"
335 #include "DerivedConstants.h"
336 #include "rts/storage/ClosureTypes.h"
337 #include "rts/storage/FunTypes.h"
338 #include "rts/OSThreads.h"
339
340 /*
341 * Need MachRegs, because some of the RTS code is conditionally
342 * compiled based on REG_R1, REG_R2, etc.
343 */
344 #include "stg/RtsMachRegs.h"
345
346 #include "rts/prof/LDV.h"
347
348 #undef BLOCK_SIZE
349 #undef MBLOCK_SIZE
350 #include "rts/storage/Block.h" /* For Bdescr() */
351
352
353 #define MyCapability() (BaseReg - OFFSET_Capability_r)
354
355 /* -------------------------------------------------------------------------
356 Info tables
357 ------------------------------------------------------------------------- */
358
359 #if defined(PROFILING)
360 #define PROF_HDR_FIELDS(w_,hdr1,hdr2) \
361 w_ hdr1, \
362 w_ hdr2,
363 #else
364 #define PROF_HDR_FIELDS(w_,hdr1,hdr2) /* nothing */
365 #endif
366
367 /* -------------------------------------------------------------------------
368 Allocation and garbage collection
369 ------------------------------------------------------------------------- */
370
371 /*
372 * ALLOC_PRIM is for allocating memory on the heap for a primitive
373 * object. It is used all over PrimOps.cmm.
374 *
375 * We make the simplifying assumption that the "admin" part of a
376 * primitive closure is just the header when calculating sizes for
377 * ticky-ticky. It's not clear whether eg. the size field of an array
378 * should be counted as "admin", or the various fields of a BCO.
379 */
380 #define ALLOC_PRIM(bytes) \
381 HP_CHK_GEN_TICKY(bytes); \
382 TICK_ALLOC_PRIM(SIZEOF_StgHeader,bytes-SIZEOF_StgHeader,0); \
383 CCCS_ALLOC(bytes);
384
385 #define HEAP_CHECK(bytes,failure) \
386 TICK_BUMP(HEAP_CHK_ctr); \
387 Hp = Hp + (bytes); \
388 if (Hp > HpLim) { HpAlloc = (bytes); failure; } \
389 TICK_ALLOC_HEAP_NOCTR(bytes);
390
391 #define ALLOC_PRIM_WITH_CUSTOM_FAILURE(bytes,failure) \
392 HEAP_CHECK(bytes,failure) \
393 TICK_ALLOC_PRIM(SIZEOF_StgHeader,bytes-SIZEOF_StgHeader,0); \
394 CCCS_ALLOC(bytes);
395
396 #define ALLOC_PRIM_(bytes,fun) \
397 ALLOC_PRIM_WITH_CUSTOM_FAILURE(bytes,GC_PRIM(fun));
398
399 #define ALLOC_PRIM_P(bytes,fun,arg) \
400 ALLOC_PRIM_WITH_CUSTOM_FAILURE(bytes,GC_PRIM_P(fun,arg));
401
402 #define ALLOC_PRIM_N(bytes,fun,arg) \
403 ALLOC_PRIM_WITH_CUSTOM_FAILURE(bytes,GC_PRIM_N(fun,arg));
404
405 /* CCS_ALLOC wants the size in words, because ccs->mem_alloc is in words */
406 #define CCCS_ALLOC(__alloc) CCS_ALLOC(BYTES_TO_WDS(__alloc), CCCS)
407
408 #define HP_CHK_GEN_TICKY(bytes) \
409 HP_CHK_GEN(bytes); \
410 TICK_ALLOC_HEAP_NOCTR(bytes);
411
412 #define HP_CHK_P(bytes, fun, arg) \
413 HEAP_CHECK(bytes, GC_PRIM_P(fun,arg))
414
415 // TODO I'm not seeing where ALLOC_P_TICKY is used; can it be removed?
416 // -NSF March 2013
417 #define ALLOC_P_TICKY(bytes, fun, arg) \
418 HP_CHK_P(bytes); \
419 TICK_ALLOC_HEAP_NOCTR(bytes);
420
421 #define CHECK_GC() \
422 (bdescr_link(CurrentNursery) == NULL || \
423 generation_n_new_large_words(W_[g0]) >= TO_W_(CLong[large_alloc_lim]))
424
425 // allocate() allocates from the nursery, so we check to see
426 // whether the nursery is nearly empty in any function that uses
427 // allocate() - this includes many of the primops.
428 //
429 // HACK alert: the __L__ stuff is here to coax the common-block
430 // eliminator into commoning up the call stg_gc_noregs() with the same
431 // code that gets generated by a STK_CHK_GEN() in the same proc. We
432 // also need an if (0) { goto __L__; } so that the __L__ label isn't
433 // optimised away by the control-flow optimiser prior to common-block
434 // elimination (it will be optimised away later).
435 //
436 // This saves some code in gmp-wrappers.cmm where we have lots of
437 // MAYBE_GC() in the same proc as STK_CHK_GEN().
438 //
439 #define MAYBE_GC(retry) \
440 if (CHECK_GC()) { \
441 HpAlloc = 0; \
442 goto __L__; \
443 __L__: \
444 call stg_gc_noregs(); \
445 goto retry; \
446 } \
447 if (0) { goto __L__; }
448
449 #define GC_PRIM(fun) \
450 jump stg_gc_prim(fun);
451
452 // Version of GC_PRIM for use in low-level Cmm. We can call
453 // stg_gc_prim, because it takes one argument and therefore has a
454 // platform-independent calling convention (Note [Syntax of .cmm
455 // files] in CmmParse.y).
456 #define GC_PRIM_LL(fun) \
457 R1 = fun; \
458 jump stg_gc_prim [R1];
459
460 // We pass the fun as the second argument, because the arg is
461 // usually already in the first argument position (R1), so this
462 // avoids moving it to a different register / stack slot.
463 #define GC_PRIM_N(fun,arg) \
464 jump stg_gc_prim_n(arg,fun);
465
466 #define GC_PRIM_P(fun,arg) \
467 jump stg_gc_prim_p(arg,fun);
468
469 #define GC_PRIM_P_LL(fun,arg) \
470 R1 = arg; \
471 R2 = fun; \
472 jump stg_gc_prim_p_ll [R1,R2];
473
474 #define GC_PRIM_PP(fun,arg1,arg2) \
475 jump stg_gc_prim_pp(arg1,arg2,fun);
476
477 #define MAYBE_GC_(fun) \
478 if (CHECK_GC()) { \
479 HpAlloc = 0; \
480 GC_PRIM(fun) \
481 }
482
483 #define MAYBE_GC_N(fun,arg) \
484 if (CHECK_GC()) { \
485 HpAlloc = 0; \
486 GC_PRIM_N(fun,arg) \
487 }
488
489 #define MAYBE_GC_P(fun,arg) \
490 if (CHECK_GC()) { \
491 HpAlloc = 0; \
492 GC_PRIM_P(fun,arg) \
493 }
494
495 #define MAYBE_GC_PP(fun,arg1,arg2) \
496 if (CHECK_GC()) { \
497 HpAlloc = 0; \
498 GC_PRIM_PP(fun,arg1,arg2) \
499 }
500
501 #define STK_CHK_LL(n, fun) \
502 TICK_BUMP(STK_CHK_ctr); \
503 if (Sp - (n) < SpLim) { \
504 GC_PRIM_LL(fun) \
505 }
506
507 #define STK_CHK_P_LL(n, fun, arg) \
508 TICK_BUMP(STK_CHK_ctr); \
509 if (Sp - (n) < SpLim) { \
510 GC_PRIM_P_LL(fun,arg) \
511 }
512
513 #define STK_CHK_PP(n, fun, arg1, arg2) \
514 TICK_BUMP(STK_CHK_ctr); \
515 if (Sp - (n) < SpLim) { \
516 GC_PRIM_PP(fun,arg1,arg2) \
517 }
518
519 #define STK_CHK_ENTER(n, closure) \
520 TICK_BUMP(STK_CHK_ctr); \
521 if (Sp - (n) < SpLim) { \
522 jump __stg_gc_enter_1(closure); \
523 }
524
525 // A funky heap check used by AutoApply.cmm
526
527 #define HP_CHK_NP_ASSIGN_SP0(size,f) \
528 HEAP_CHECK(size, Sp(0) = f; jump __stg_gc_enter_1 [R1];)
529
530 /* -----------------------------------------------------------------------------
531 Closure headers
532 -------------------------------------------------------------------------- */
533
534 /*
535 * This is really ugly, since we don't do the rest of StgHeader this
536 * way. The problem is that values from DerivedConstants.h cannot be
537 * dependent on the way (SMP, PROF etc.). For SIZEOF_StgHeader we get
538 * the value from GHC, but it seems like too much trouble to do that
539 * for StgThunkHeader.
540 */
541 #define SIZEOF_StgThunkHeader SIZEOF_StgHeader+SIZEOF_StgSMPThunkHeader
542
543 #define StgThunk_payload(__ptr__,__ix__) \
544 W_[__ptr__+SIZEOF_StgThunkHeader+ WDS(__ix__)]
545
546 /* -----------------------------------------------------------------------------
547 Closures
548 -------------------------------------------------------------------------- */
549
550 /* The offset of the payload of an array */
551 #define BYTE_ARR_CTS(arr) ((arr) + SIZEOF_StgArrBytes)
552
553 /* The number of words allocated in an array payload */
554 #define BYTE_ARR_WDS(arr) ROUNDUP_BYTES_TO_WDS(StgArrBytes_bytes(arr))
555
556 /* Getting/setting the info pointer of a closure */
557 #define SET_INFO(p,info) StgHeader_info(p) = info
558 #define GET_INFO(p) StgHeader_info(p)
559
560 /* Determine the size of an ordinary closure from its info table */
561 #define sizeW_fromITBL(itbl) \
562 SIZEOF_StgHeader + WDS(%INFO_PTRS(itbl)) + WDS(%INFO_NPTRS(itbl))
563
564 /* NB. duplicated from InfoTables.h! */
565 #define BITMAP_SIZE(bitmap) ((bitmap) & BITMAP_SIZE_MASK)
566 #define BITMAP_BITS(bitmap) ((bitmap) >> BITMAP_BITS_SHIFT)
567
568 /* Debugging macros */
569 #define LOOKS_LIKE_INFO_PTR(p) \
570 ((p) != NULL && \
571 LOOKS_LIKE_INFO_PTR_NOT_NULL(p))
572
573 #define LOOKS_LIKE_INFO_PTR_NOT_NULL(p) \
574 ( (TO_W_(%INFO_TYPE(%STD_INFO(p))) != INVALID_OBJECT) && \
575 (TO_W_(%INFO_TYPE(%STD_INFO(p))) < N_CLOSURE_TYPES))
576
577 #define LOOKS_LIKE_CLOSURE_PTR(p) (LOOKS_LIKE_INFO_PTR(GET_INFO(UNTAG(p))))
578
579 /*
580 * The layout of the StgFunInfoExtra part of an info table changes
581 * depending on TABLES_NEXT_TO_CODE. So we define field access
582 * macros which use the appropriate version here:
583 */
584 #ifdef TABLES_NEXT_TO_CODE
585 /*
586 * when TABLES_NEXT_TO_CODE, slow_apply is stored as an offset
587 * instead of the normal pointer.
588 */
589
590 #define StgFunInfoExtra_slow_apply(fun_info) \
591 (TO_W_(StgFunInfoExtraRev_slow_apply_offset(fun_info)) \
592 + (fun_info) + SIZEOF_StgFunInfoExtraRev + SIZEOF_StgInfoTable)
593
594 #define StgFunInfoExtra_fun_type(i) StgFunInfoExtraRev_fun_type(i)
595 #define StgFunInfoExtra_arity(i) StgFunInfoExtraRev_arity(i)
596 #define StgFunInfoExtra_bitmap(i) StgFunInfoExtraRev_bitmap(i)
597 #else
598 #define StgFunInfoExtra_slow_apply(i) StgFunInfoExtraFwd_slow_apply(i)
599 #define StgFunInfoExtra_fun_type(i) StgFunInfoExtraFwd_fun_type(i)
600 #define StgFunInfoExtra_arity(i) StgFunInfoExtraFwd_arity(i)
601 #define StgFunInfoExtra_bitmap(i) StgFunInfoExtraFwd_bitmap(i)
602 #endif
603
604 #define mutArrCardMask ((1 << MUT_ARR_PTRS_CARD_BITS) - 1)
605 #define mutArrPtrCardDown(i) ((i) >> MUT_ARR_PTRS_CARD_BITS)
606 #define mutArrPtrCardUp(i) (((i) + mutArrCardMask) >> MUT_ARR_PTRS_CARD_BITS)
607 #define mutArrPtrsCardWords(n) ROUNDUP_BYTES_TO_WDS(mutArrPtrCardUp(n))
608
609 #if defined(PROFILING) || (!defined(THREADED_RTS) && defined(DEBUG))
610 #define OVERWRITING_CLOSURE(c) foreign "C" overwritingClosure(c "ptr")
611 #define OVERWRITING_CLOSURE_OFS(c,n) \
612 foreign "C" overwritingClosureOfs(c "ptr", n)
613 #else
614 #define OVERWRITING_CLOSURE(c) /* nothing */
615 #define OVERWRITING_CLOSURE_OFS(c,n) /* nothing */
616 #endif
617
618 #ifdef THREADED_RTS
619 #define prim_write_barrier prim %write_barrier()
620 #else
621 #define prim_write_barrier /* nothing */
622 #endif
623
624 /* -----------------------------------------------------------------------------
625 Ticky macros
626 -------------------------------------------------------------------------- */
627
628 #ifdef TICKY_TICKY
629 #define TICK_BUMP_BY(ctr,n) CLong[ctr] = CLong[ctr] + n
630 #else
631 #define TICK_BUMP_BY(ctr,n) /* nothing */
632 #endif
633
634 #define TICK_BUMP(ctr) TICK_BUMP_BY(ctr,1)
635
636 #define TICK_ENT_DYN_IND() TICK_BUMP(ENT_DYN_IND_ctr)
637 #define TICK_ENT_DYN_THK() TICK_BUMP(ENT_DYN_THK_ctr)
638 #define TICK_ENT_VIA_NODE() TICK_BUMP(ENT_VIA_NODE_ctr)
639 #define TICK_ENT_STATIC_IND() TICK_BUMP(ENT_STATIC_IND_ctr)
640 #define TICK_ENT_PERM_IND() TICK_BUMP(ENT_PERM_IND_ctr)
641 #define TICK_ENT_PAP() TICK_BUMP(ENT_PAP_ctr)
642 #define TICK_ENT_AP() TICK_BUMP(ENT_AP_ctr)
643 #define TICK_ENT_AP_STACK() TICK_BUMP(ENT_AP_STACK_ctr)
644 #define TICK_ENT_BH() TICK_BUMP(ENT_BH_ctr)
645 #define TICK_ENT_LNE() TICK_BUMP(ENT_LNE_ctr)
646 #define TICK_UNKNOWN_CALL() TICK_BUMP(UNKNOWN_CALL_ctr)
647 #define TICK_UPDF_PUSHED() TICK_BUMP(UPDF_PUSHED_ctr)
648 #define TICK_CATCHF_PUSHED() TICK_BUMP(CATCHF_PUSHED_ctr)
649 #define TICK_UPDF_OMITTED() TICK_BUMP(UPDF_OMITTED_ctr)
650 #define TICK_UPD_NEW_IND() TICK_BUMP(UPD_NEW_IND_ctr)
651 #define TICK_UPD_NEW_PERM_IND() TICK_BUMP(UPD_NEW_PERM_IND_ctr)
652 #define TICK_UPD_OLD_IND() TICK_BUMP(UPD_OLD_IND_ctr)
653 #define TICK_UPD_OLD_PERM_IND() TICK_BUMP(UPD_OLD_PERM_IND_ctr)
654
655 #define TICK_SLOW_CALL_FUN_TOO_FEW() TICK_BUMP(SLOW_CALL_FUN_TOO_FEW_ctr)
656 #define TICK_SLOW_CALL_FUN_CORRECT() TICK_BUMP(SLOW_CALL_FUN_CORRECT_ctr)
657 #define TICK_SLOW_CALL_FUN_TOO_MANY() TICK_BUMP(SLOW_CALL_FUN_TOO_MANY_ctr)
658 #define TICK_SLOW_CALL_PAP_TOO_FEW() TICK_BUMP(SLOW_CALL_PAP_TOO_FEW_ctr)
659 #define TICK_SLOW_CALL_PAP_CORRECT() TICK_BUMP(SLOW_CALL_PAP_CORRECT_ctr)
660 #define TICK_SLOW_CALL_PAP_TOO_MANY() TICK_BUMP(SLOW_CALL_PAP_TOO_MANY_ctr)
661
662 #define TICK_SLOW_CALL_fast_v16() TICK_BUMP(SLOW_CALL_fast_v16_ctr)
663 #define TICK_SLOW_CALL_fast_v() TICK_BUMP(SLOW_CALL_fast_v_ctr)
664 #define TICK_SLOW_CALL_fast_p() TICK_BUMP(SLOW_CALL_fast_p_ctr)
665 #define TICK_SLOW_CALL_fast_pv() TICK_BUMP(SLOW_CALL_fast_pv_ctr)
666 #define TICK_SLOW_CALL_fast_pp() TICK_BUMP(SLOW_CALL_fast_pp_ctr)
667 #define TICK_SLOW_CALL_fast_ppv() TICK_BUMP(SLOW_CALL_fast_ppv_ctr)
668 #define TICK_SLOW_CALL_fast_ppp() TICK_BUMP(SLOW_CALL_fast_ppp_ctr)
669 #define TICK_SLOW_CALL_fast_pppv() TICK_BUMP(SLOW_CALL_fast_pppv_ctr)
670 #define TICK_SLOW_CALL_fast_pppp() TICK_BUMP(SLOW_CALL_fast_pppp_ctr)
671 #define TICK_SLOW_CALL_fast_ppppp() TICK_BUMP(SLOW_CALL_fast_ppppp_ctr)
672 #define TICK_SLOW_CALL_fast_pppppp() TICK_BUMP(SLOW_CALL_fast_pppppp_ctr)
673 #define TICK_VERY_SLOW_CALL() TICK_BUMP(VERY_SLOW_CALL_ctr)
674
675 /* NOTE: TICK_HISTO_BY and TICK_HISTO
676 currently have no effect.
677 The old code for it didn't typecheck and I
678 just commented it out to get ticky to work.
679 - krc 1/2007 */
680
681 #define TICK_HISTO_BY(histo,n,i) /* nothing */
682
683 #define TICK_HISTO(histo,n) TICK_HISTO_BY(histo,n,1)
684
685 /* An unboxed tuple with n components. */
686 #define TICK_RET_UNBOXED_TUP(n) \
687 TICK_BUMP(RET_UNBOXED_TUP_ctr++); \
688 TICK_HISTO(RET_UNBOXED_TUP,n)
689
690 /*
691 * A slow call with n arguments. In the unevald case, this call has
692 * already been counted once, so don't count it again.
693 */
694 #define TICK_SLOW_CALL(n) \
695 TICK_BUMP(SLOW_CALL_ctr); \
696 TICK_HISTO(SLOW_CALL,n)
697
698 /*
699 * This slow call was found to be to an unevaluated function; undo the
700 * ticks we did in TICK_SLOW_CALL.
701 */
702 #define TICK_SLOW_CALL_UNEVALD(n) \
703 TICK_BUMP(SLOW_CALL_UNEVALD_ctr); \
704 TICK_BUMP_BY(SLOW_CALL_ctr,-1); \
705 TICK_HISTO_BY(SLOW_CALL,n,-1);
706
707 /* Updating a closure with a new CON */
708 #define TICK_UPD_CON_IN_NEW(n) \
709 TICK_BUMP(UPD_CON_IN_NEW_ctr); \
710 TICK_HISTO(UPD_CON_IN_NEW,n)
711
712 #define TICK_ALLOC_HEAP_NOCTR(bytes) \
713 TICK_BUMP(ALLOC_RTS_ctr); \
714 TICK_BUMP_BY(ALLOC_RTS_tot,bytes)
715
716 /* -----------------------------------------------------------------------------
717 Saving and restoring STG registers
718
719 STG registers must be saved around a C call, just in case the STG
720 register is mapped to a caller-saves machine register. Normally we
721 don't need to worry about this the code generator has already
722 loaded any live STG registers into variables for us, but in
723 hand-written low-level Cmm code where we don't know which registers
724 are live, we might have to save them all.
725 -------------------------------------------------------------------------- */
726
727 #define SAVE_STGREGS \
728 W_ r1, r2, r3, r4, r5, r6, r7, r8; \
729 F_ f1, f2, f3, f4, f5, f6; \
730 D_ d1, d2, d3, d4, d5, d6; \
731 L_ l1; \
732 \
733 r1 = R1; \
734 r2 = R2; \
735 r3 = R3; \
736 r4 = R4; \
737 r5 = R5; \
738 r6 = R6; \
739 r7 = R7; \
740 r8 = R8; \
741 \
742 f1 = F1; \
743 f2 = F2; \
744 f3 = F3; \
745 f4 = F4; \
746 f5 = F5; \
747 f6 = F6; \
748 \
749 d1 = D1; \
750 d2 = D2; \
751 d3 = D3; \
752 d4 = D4; \
753 d5 = D5; \
754 d6 = D6; \
755 \
756 l1 = L1;
757
758
759 #define RESTORE_STGREGS \
760 R1 = r1; \
761 R2 = r2; \
762 R3 = r3; \
763 R4 = r4; \
764 R5 = r5; \
765 R6 = r6; \
766 R7 = r7; \
767 R8 = r8; \
768 \
769 F1 = f1; \
770 F2 = f2; \
771 F3 = f3; \
772 F4 = f4; \
773 F5 = f5; \
774 F6 = f6; \
775 \
776 D1 = d1; \
777 D2 = d2; \
778 D3 = d3; \
779 D4 = d4; \
780 D5 = d5; \
781 D6 = d6; \
782 \
783 L1 = l1;
784
785 /* -----------------------------------------------------------------------------
786 Misc junk
787 -------------------------------------------------------------------------- */
788
789 #define NO_TREC stg_NO_TREC_closure
790 #define END_TSO_QUEUE stg_END_TSO_QUEUE_closure
791 #define STM_AWOKEN stg_STM_AWOKEN_closure
792 #define END_INVARIANT_CHECK_QUEUE stg_END_INVARIANT_CHECK_QUEUE_closure
793
794 #define recordMutableCap(p, gen) \
795 W_ __bd; \
796 W_ mut_list; \
797 mut_list = Capability_mut_lists(MyCapability()) + WDS(gen); \
798 __bd = W_[mut_list]; \
799 if (bdescr_free(__bd) >= bdescr_start(__bd) + BLOCK_SIZE) { \
800 W_ __new_bd; \
801 ("ptr" __new_bd) = foreign "C" allocBlock_lock(); \
802 bdescr_link(__new_bd) = __bd; \
803 __bd = __new_bd; \
804 W_[mut_list] = __bd; \
805 } \
806 W_ free; \
807 free = bdescr_free(__bd); \
808 W_[free] = p; \
809 bdescr_free(__bd) = free + WDS(1);
810
811 #define recordMutable(p) \
812 P_ __p; \
813 W_ __bd; \
814 W_ __gen; \
815 __p = p; \
816 __bd = Bdescr(__p); \
817 __gen = TO_W_(bdescr_gen_no(__bd)); \
818 if (__gen > 0) { recordMutableCap(__p, __gen); }
819
820 /* -----------------------------------------------------------------------------
821 Arrays
822 -------------------------------------------------------------------------- */
823
824 /* Complete function body for the clone family of (mutable) array ops.
825 Defined as a macro to avoid function call overhead or code
826 duplication. */
827 #define cloneArray(info, src, offset, n) \
828 W_ words, size; \
829 gcptr dst, dst_p, src_p; \
830 \
831 again: MAYBE_GC(again); \
832 \
833 size = n + mutArrPtrsCardWords(n); \
834 words = BYTES_TO_WDS(SIZEOF_StgMutArrPtrs) + size; \
835 ("ptr" dst) = ccall allocate(MyCapability() "ptr", words); \
836 TICK_ALLOC_PRIM(SIZEOF_StgMutArrPtrs, WDS(size), 0); \
837 \
838 SET_HDR(dst, info, CCCS); \
839 StgMutArrPtrs_ptrs(dst) = n; \
840 StgMutArrPtrs_size(dst) = size; \
841 \
842 dst_p = dst + SIZEOF_StgMutArrPtrs; \
843 src_p = src + SIZEOF_StgMutArrPtrs + WDS(offset); \
844 while: \
845 if (n != 0) { \
846 n = n - 1; \
847 W_[dst_p] = W_[src_p]; \
848 dst_p = dst_p + WDS(1); \
849 src_p = src_p + WDS(1); \
850 goto while; \
851 } \
852 \
853 return (dst);
854
855 #define copyArray(src, src_off, dst, dst_off, n) \
856 W_ dst_elems_p, dst_p, src_p, dst_cards_p, bytes; \
857 \
858 if ((n) != 0) { \
859 SET_HDR(dst, stg_MUT_ARR_PTRS_DIRTY_info, CCCS); \
860 \
861 dst_elems_p = (dst) + SIZEOF_StgMutArrPtrs; \
862 dst_p = dst_elems_p + WDS(dst_off); \
863 src_p = (src) + SIZEOF_StgMutArrPtrs + WDS(src_off); \
864 bytes = WDS(n); \
865 \
866 prim %memcpy(dst_p, src_p, bytes, SIZEOF_W); \
867 \
868 dst_cards_p = dst_elems_p + WDS(StgMutArrPtrs_ptrs(dst)); \
869 setCards(dst_cards_p, dst_off, n); \
870 } \
871 \
872 return ();
873
874 #define copyMutableArray(src, src_off, dst, dst_off, n) \
875 W_ dst_elems_p, dst_p, src_p, dst_cards_p, bytes; \
876 \
877 if ((n) != 0) { \
878 SET_HDR(dst, stg_MUT_ARR_PTRS_DIRTY_info, CCCS); \
879 \
880 dst_elems_p = (dst) + SIZEOF_StgMutArrPtrs; \
881 dst_p = dst_elems_p + WDS(dst_off); \
882 src_p = (src) + SIZEOF_StgMutArrPtrs + WDS(src_off); \
883 bytes = WDS(n); \
884 \
885 if ((src) == (dst)) { \
886 prim %memmove(dst_p, src_p, bytes, SIZEOF_W); \
887 } else { \
888 prim %memcpy(dst_p, src_p, bytes, SIZEOF_W); \
889 } \
890 \
891 dst_cards_p = dst_elems_p + WDS(StgMutArrPtrs_ptrs(dst)); \
892 setCards(dst_cards_p, dst_off, n); \
893 } \
894 \
895 return ();
896
897 /*
898 * Set the cards in the cards table pointed to by dst_cards_p for an
899 * update to n elements, starting at element dst_off.
900 */
901 #define setCards(dst_cards_p, dst_off, n) \
902 W_ __start_card, __end_card, __cards; \
903 __start_card = mutArrPtrCardDown(dst_off); \
904 __end_card = mutArrPtrCardDown((dst_off) + (n) - 1); \
905 __cards = __end_card - __start_card + 1; \
906 prim %memset((dst_cards_p) + __start_card, 1, __cards, 1);
907
908 /* Complete function body for the clone family of small (mutable)
909 array ops. Defined as a macro to avoid function call overhead or
910 code duplication. */
911 #define cloneSmallArray(info, src, offset, n) \
912 W_ words, size; \
913 gcptr dst, dst_p, src_p; \
914 \
915 again: MAYBE_GC(again); \
916 \
917 words = BYTES_TO_WDS(SIZEOF_StgSmallMutArrPtrs) + n; \
918 ("ptr" dst) = ccall allocate(MyCapability() "ptr", words); \
919 TICK_ALLOC_PRIM(SIZEOF_StgSmallMutArrPtrs, WDS(n), 0); \
920 \
921 SET_HDR(dst, info, CCCS); \
922 StgSmallMutArrPtrs_ptrs(dst) = n; \
923 \
924 dst_p = dst + SIZEOF_StgSmallMutArrPtrs; \
925 src_p = src + SIZEOF_StgSmallMutArrPtrs + WDS(offset); \
926 while: \
927 if (n != 0) { \
928 n = n - 1; \
929 W_[dst_p] = W_[src_p]; \
930 dst_p = dst_p + WDS(1); \
931 src_p = src_p + WDS(1); \
932 goto while; \
933 } \
934 \
935 return (dst);
936
937 #endif /* CMM_H */