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