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