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