Cmm.h 38.4 KB
Newer Older
1 2
/* -----------------------------------------------------------------------------
 *
3
 * (c) The University of Glasgow 2004-2013
4 5 6 7 8 9 10 11 12 13 14 15 16 17 18 19 20 21 22
 *
 * This file is included at the top of all .cmm source files (and
 * *only* .cmm files).  It defines a collection of useful macros for
 * making .cmm code a bit less error-prone to write, and a bit easier
 * on the eye for the reader.
 *
 * For the syntax of .cmm files, see the parser in ghc/compiler/cmm/CmmParse.y.
 *
 * Accessing fields of structures defined in the RTS header files is
 * done via automatically-generated macros in DerivedConstants.h.  For
 * example, where previously we used
 *
 *          CurrentTSO->what_next = x
 *
 * in C-- we now use
 *
 *          StgTSO_what_next(CurrentTSO) = x
 *
 * where the StgTSO_what_next() macro is automatically generated by
Gabor Greif's avatar
Gabor Greif committed
23
 * mkDerivedConstants.c.  If you need to access a field that doesn't
24 25 26 27
 * already have a macro, edit that file (it's pretty self-explanatory).
 *
 * -------------------------------------------------------------------------- */

28
#pragma once
29

30 31 32 33 34
/*
 * In files that are included into both C and C-- (and perhaps
 * Haskell) sources, we sometimes need to conditionally compile bits
 * depending on the language.  CMINUSMINUS==1 in .cmm sources:
 */
35 36 37 38 39
#define CMINUSMINUS 1

#include "ghcconfig.h"

/* -----------------------------------------------------------------------------
40
   Types
41 42 43 44 45 46

   The following synonyms for C-- types are declared here:

     I8, I16, I32, I64    MachRep-style names for convenience

     W_                   is shorthand for the word type (== StgWord)
47 48 49 50 51
     F_                   shorthand for float  (F_ == StgFloat == C's float)
     D_                   shorthand for double (D_ == StgDouble == C's double)

     CInt                 has the same size as an int in C on this platform
     CLong                has the same size as a long in C on this platform
Ben Gamari's avatar
Ben Gamari committed
52
     CBool                has the same size as a bool in C on this platform
53 54 55 56 57 58 59

  --------------------------------------------------------------------------- */

#define I8  bits8
#define I16 bits16
#define I32 bits32
#define I64 bits64
60
#define P_  gcptr
61 62 63

#if SIZEOF_VOID_P == 4
#define W_ bits32
Simon Marlow's avatar
Simon Marlow committed
64 65
/* Maybe it's better to include MachDeps.h */
#define TAG_BITS                2
66 67
#elif SIZEOF_VOID_P == 8
#define W_ bits64
Simon Marlow's avatar
Simon Marlow committed
68 69
/* Maybe it's better to include MachDeps.h */
#define TAG_BITS                3
70 71 72 73
#else
#error Unknown word size
#endif

Simon Marlow's avatar
Simon Marlow committed
74
/*
Simon Marlow's avatar
Simon Marlow committed
75
 * The RTS must sometimes UNTAG a pointer before dereferencing it.
76
 * See the wiki page commentary/rts/haskell-execution/pointer-tagging
Simon Marlow's avatar
Simon Marlow committed
77 78 79 80 81
 */
#define TAG_MASK ((1 << TAG_BITS) - 1)
#define UNTAG(p) (p & ~TAG_MASK)
#define GETTAG(p) (p & TAG_MASK)

82 83
#if SIZEOF_INT == 4
#define CInt bits32
84
#elif SIZEOF_INT == 8
85 86 87 88 89 90 91
#define CInt bits64
#else
#error Unknown int size
#endif

#if SIZEOF_LONG == 4
#define CLong bits32
92
#elif SIZEOF_LONG == 8
93 94 95 96 97
#define CLong bits64
#else
#error Unknown long size
#endif

Ben Gamari's avatar
Ben Gamari committed
98 99
#define CBool bits8

100 101 102 103
#define F_   float32
#define D_   float64
#define L_   bits64
#define V16_ bits128
104
#define V32_ bits256
105
#define V64_ bits512
106 107 108 109 110 111 112 113

#define SIZEOF_StgDouble 8
#define SIZEOF_StgWord64 8

/* -----------------------------------------------------------------------------
   Misc useful stuff
   -------------------------------------------------------------------------- */

114 115
#define ccall foreign "C"

116 117
#define NULL (0::W_)

118 119 120 121
#define STRING(name,str)                        \
  section "rodata" {                            \
        name : bits8[] str;                     \
  }                                             \
122

Ben Gamari's avatar
Ben Gamari committed
123
#if defined(TABLES_NEXT_TO_CODE)
Simon Marlow's avatar
Simon Marlow committed
124 125 126 127 128
#define RET_LBL(f) f##_info
#else
#define RET_LBL(f) f##_ret
#endif

Ben Gamari's avatar
Ben Gamari committed
129
#if defined(TABLES_NEXT_TO_CODE)
Simon Marlow's avatar
Simon Marlow committed
130 131 132 133 134
#define ENTRY_LBL(f) f##_info
#else
#define ENTRY_LBL(f) f##_entry
#endif

135 136 137 138 139 140 141 142 143 144 145 146 147 148
/* -----------------------------------------------------------------------------
   Byte/word macros

   Everything in C-- is in byte offsets (well, most things).  We use
   some macros to allow us to express offsets in words and to try to
   avoid byte/word confusion.
   -------------------------------------------------------------------------- */

#define SIZEOF_W  SIZEOF_VOID_P
#define W_MASK    (SIZEOF_W-1)

#if SIZEOF_W == 4
#define W_SHIFT 2
#elif SIZEOF_W == 8
149
#define W_SHIFT 3
150 151
#endif

152
/* Converting quantities of words to bytes */
153 154
#define WDS(n) ((n)*SIZEOF_W)

155 156 157 158
/*
 * Converting quantities of bytes to words
 * NB. these work on *unsigned* values only
 */
159 160 161
#define BYTES_TO_WDS(n) ((n) / SIZEOF_W)
#define ROUNDUP_BYTES_TO_WDS(n) (((n) + SIZEOF_W - 1) / SIZEOF_W)

162 163 164 165
/*
 * TO_W_(n) and TO_ZXW_(n) convert n to W_ type from a smaller type,
 * with and without sign extension respectively
 */
166
#if SIZEOF_W == 4
167
#define TO_I64(x) %sx64(x)
168
#define TO_W_(x) %sx32(x)
169
#define TO_ZXW_(x) %zx32(x)
170 171
#define HALF_W_(x) %lobits16(x)
#elif SIZEOF_W == 8
172
#define TO_I64(x) (x)
173
#define TO_W_(x) %sx64(x)
174
#define TO_ZXW_(x) %zx64(x)
175 176 177
#define HALF_W_(x) %lobits32(x)
#endif

178 179 180 181 182 183
#if SIZEOF_INT == 4 && SIZEOF_W == 8
#define W_TO_INT(x) %lobits32(x)
#elif SIZEOF_INT == SIZEOF_W
#define W_TO_INT(x) (x)
#endif

Ian Lynagh's avatar
Ian Lynagh committed
184 185 186 187 188 189
#if SIZEOF_LONG == 4 && SIZEOF_W == 8
#define W_TO_LONG(x) %lobits32(x)
#elif SIZEOF_LONG == SIZEOF_W
#define W_TO_LONG(x) (x)
#endif

190 191 192 193 194 195 196 197 198 199
/* -----------------------------------------------------------------------------
   Atomic memory operations.
   -------------------------------------------------------------------------- */

#if SIZEOF_W == 4
#define cmpxchgW cmpxchg32
#elif SIZEOF_W == 8
#define cmpxchgW cmpxchg64
#endif

200 201 202 203 204 205 206
/* -----------------------------------------------------------------------------
   Heap/stack access, and adjusting the heap/stack pointers.
   -------------------------------------------------------------------------- */

#define Sp(n)  W_[Sp + WDS(n)]
#define Hp(n)  W_[Hp + WDS(n)]

207
#define Sp_adj(n) Sp = Sp + WDS(n)  /* pronounced "spadge" */
208 209 210 211 212 213
#define Hp_adj(n) Hp = Hp + WDS(n)

/* -----------------------------------------------------------------------------
   Assertions and Debuggery
   -------------------------------------------------------------------------- */

Ben Gamari's avatar
Ben Gamari committed
214
#if defined(DEBUG)
215 216 217 218
#define ASSERT(predicate)                       \
        if (predicate) {                        \
            /*null*/;                           \
        } else {                                \
219
            foreign "C" _assertFail(__FILE__, __LINE__) never returns; \
220 221 222 223 224
        }
#else
#define ASSERT(p) /* nothing */
#endif

Ben Gamari's avatar
Ben Gamari committed
225
#if defined(DEBUG)
226 227 228 229 230
#define DEBUG_ONLY(s) s
#else
#define DEBUG_ONLY(s) /* nothing */
#endif

231 232 233
/*
 * The IF_DEBUG macro is useful for debug messages that depend on one
 * of the RTS debug options.  For example:
234
 *
235 236 237 238 239
 *   IF_DEBUG(RtsFlags_DebugFlags_apply,
 *      foreign "C" fprintf(stderr, stg_ap_0_ret_str));
 *
 * Note the syntax is slightly different to the C version of this macro.
 */
Ben Gamari's avatar
Ben Gamari committed
240
#if defined(DEBUG)
Ben Gamari's avatar
Ben Gamari committed
241
#define IF_DEBUG(c,s)  if (RtsFlags_DebugFlags_##c(RtsFlags) != 0::CBool) { s; }
242 243 244 245 246
#else
#define IF_DEBUG(c,s)  /* nothing */
#endif

/* -----------------------------------------------------------------------------
247
   Entering
248 249 250 251 252 253 254

   It isn't safe to "enter" every closure.  Functions in particular
   have no entry code as such; their entry point contains the code to
   apply the function.

   ToDo: range should end in N_CLOSURE_TYPES-1, not N_CLOSURE_TYPES,
   but switch doesn't allow us to use exprs there yet.
Simon Marlow's avatar
Simon Marlow committed
255 256 257 258 259 260 261 262 263

   If R1 points to a tagged object it points either to
   * A constructor.
   * A function with arity <= TAG_MASK.
   In both cases the right thing to do is to return.
   Note: it is rather lucky that we can use the tag bits to do this
         for both objects. Maybe it points to a brittle design?

   Indirections can contain tagged pointers, so their tag is checked.
264 265
   -------------------------------------------------------------------------- */

Ben Gamari's avatar
Ben Gamari committed
266
#if defined(PROFILING)
267 268 269 270 271

// When profiling, we cannot shortcut ENTER() by checking the tag,
// because LDV profiling relies on entering closures to mark them as
// "used".

Simon Marlow's avatar
Simon Marlow committed
272 273
#define LOAD_INFO(ret,x)                        \
    info = %INFO_PTR(UNTAG(x));
274

Simon Marlow's avatar
Simon Marlow committed
275
#define UNTAG_IF_PROF(x) UNTAG(x)
276 277 278

#else

279 280 281
#define LOAD_INFO(ret,x)                        \
  if (GETTAG(x) != 0) {                         \
      ret(x);                                   \
282
  }                                             \
283
  info = %INFO_PTR(x);
284

Simon Marlow's avatar
Simon Marlow committed
285
#define UNTAG_IF_PROF(x) (x) /* already untagged */
286 287 288

#endif

289 290 291 292 293 294 295 296
// We need two versions of ENTER():
//  - ENTER(x) takes the closure as an argument and uses return(),
//    for use in civilized code where the stack is handled by GHC
//
//  - ENTER_NOSTACK() where the closure is in R1, and returns are
//    explicit jumps, for use when we are doing the stack management
//    ourselves.

297 298 299 300
#if defined(PROFILING)
// See Note [Evaluating functions with profiling] in rts/Apply.cmm
#define ENTER(x) jump stg_ap_0_fast(x);
#else
301
#define ENTER(x) ENTER_(return,x)
302 303
#endif

304 305 306 307 308
#define ENTER_R1() ENTER_(RET_R1,R1)

#define RET_R1(x) jump %ENTRY_CODE(Sp(0)) [R1]

#define ENTER_(ret,x)                                   \
309 310
 again:                                                 \
  W_ info;                                              \
311 312 313
  LOAD_INFO(ret,x)                                      \
  /* See Note [Heap memory barriers] in SMP.h */        \
  prim_read_barrier;                                    \
314 315 316 317 318 319
  switch [INVALID_OBJECT .. N_CLOSURE_TYPES]            \
         (TO_W_( %INFO_TYPE(%STD_INFO(info)) )) {       \
  case                                                  \
    IND,                                                \
    IND_STATIC:                                         \
   {                                                    \
320
      x = StgInd_indirectee(x);                         \
321 322 323 324 325 326 327 328 329
      goto again;                                       \
   }                                                    \
  case                                                  \
    FUN,                                                \
    FUN_1_0,                                            \
    FUN_0_1,                                            \
    FUN_2_0,                                            \
    FUN_1_1,                                            \
    FUN_0_2,                                            \
Simon Marlow's avatar
Simon Marlow committed
330
    FUN_STATIC,                                         \
331 332 333
    BCO,                                                \
    PAP:                                                \
   {                                                    \
334
       ret(x);                                          \
335 336 337
   }                                                    \
  default:                                              \
   {                                                    \
Simon Marlow's avatar
Simon Marlow committed
338
       x = UNTAG_IF_PROF(x);                            \
339
       jump %ENTRY_CODE(info) (x);                      \
340
   }                                                    \
341 342
  }

Simon Marlow's avatar
Simon Marlow committed
343 344 345 346
// The FUN cases almost never happen: a pointer to a non-static FUN
// should always be tagged.  This unfortunately isn't true for the
// interpreter right now, which leaves untagged FUNs on the stack.

347 348 349 350
/* -----------------------------------------------------------------------------
   Constants.
   -------------------------------------------------------------------------- */

Simon Marlow's avatar
Simon Marlow committed
351
#include "rts/Constants.h"
352
#include "DerivedConstants.h"
Simon Marlow's avatar
Simon Marlow committed
353 354 355
#include "rts/storage/ClosureTypes.h"
#include "rts/storage/FunTypes.h"
#include "rts/OSThreads.h"
356

357 358 359 360
/*
 * Need MachRegs, because some of the RTS code is conditionally
 * compiled based on REG_R1, REG_R2, etc.
 */
361
#include "stg/MachRegsForHost.h"
362

Simon Marlow's avatar
Simon Marlow committed
363
#include "rts/prof/LDV.h"
364 365 366

#undef BLOCK_SIZE
#undef MBLOCK_SIZE
Simon Marlow's avatar
Simon Marlow committed
367
#include "rts/storage/Block.h"  /* For Bdescr() */
368 369


370 371
#define MyCapability()  (BaseReg - OFFSET_Capability_r)

372 373 374 375 376
/* -------------------------------------------------------------------------
   Info tables
   ------------------------------------------------------------------------- */

#if defined(PROFILING)
Simon Marlow's avatar
Simon Marlow committed
377 378
#define PROF_HDR_FIELDS(w_,hdr1,hdr2)          \
  w_ hdr1,                                     \
Simon Marlow's avatar
Simon Marlow committed
379
  w_ hdr2,
380
#else
Simon Marlow's avatar
Simon Marlow committed
381
#define PROF_HDR_FIELDS(w_,hdr1,hdr2) /* nothing */
382 383
#endif

384 385 386 387
/* -------------------------------------------------------------------------
   Allocation and garbage collection
   ------------------------------------------------------------------------- */

388 389 390 391 392 393 394 395 396
/*
 * ALLOC_PRIM is for allocating memory on the heap for a primitive
 * object.  It is used all over PrimOps.cmm.
 *
 * We make the simplifying assumption that the "admin" part of a
 * primitive closure is just the header when calculating sizes for
 * ticky-ticky.  It's not clear whether eg. the size field of an array
 * should be counted as "admin", or the various fields of a BCO.
 */
397 398
#define ALLOC_PRIM(bytes)                                       \
   HP_CHK_GEN_TICKY(bytes);                                     \
399
   TICK_ALLOC_PRIM(SIZEOF_StgHeader,bytes-SIZEOF_StgHeader,0);  \
400 401
   CCCS_ALLOC(bytes);

402
#define HEAP_CHECK(bytes,failure)                       \
403
    TICK_BUMP(HEAP_CHK_ctr);                            \
404 405
    Hp = Hp + (bytes);                                  \
    if (Hp > HpLim) { HpAlloc = (bytes); failure; }     \
406 407 408 409 410 411 412
    TICK_ALLOC_HEAP_NOCTR(bytes);

#define ALLOC_PRIM_WITH_CUSTOM_FAILURE(bytes,failure)           \
    HEAP_CHECK(bytes,failure)                                   \
    TICK_ALLOC_PRIM(SIZEOF_StgHeader,bytes-SIZEOF_StgHeader,0); \
    CCCS_ALLOC(bytes);

413 414 415
#define ALLOC_PRIM_(bytes,fun)                                  \
    ALLOC_PRIM_WITH_CUSTOM_FAILURE(bytes,GC_PRIM(fun));

416 417 418 419 420 421
#define ALLOC_PRIM_P(bytes,fun,arg)                             \
    ALLOC_PRIM_WITH_CUSTOM_FAILURE(bytes,GC_PRIM_P(fun,arg));

#define ALLOC_PRIM_N(bytes,fun,arg)                             \
    ALLOC_PRIM_WITH_CUSTOM_FAILURE(bytes,GC_PRIM_N(fun,arg));

422
/* CCS_ALLOC wants the size in words, because ccs->mem_alloc is in words */
423
#define CCCS_ALLOC(__alloc) CCS_ALLOC(BYTES_TO_WDS(__alloc), CCCS)
424

nfrisby's avatar
nfrisby committed
425 426 427
#define HP_CHK_GEN_TICKY(bytes)                 \
   HP_CHK_GEN(bytes);                           \
   TICK_ALLOC_HEAP_NOCTR(bytes);
428

429 430 431
#define HP_CHK_P(bytes, fun, arg)               \
   HEAP_CHECK(bytes, GC_PRIM_P(fun,arg))

nfrisby's avatar
nfrisby committed
432 433
// TODO I'm not seeing where ALLOC_P_TICKY is used; can it be removed?
//         -NSF March 2013
434 435
#define ALLOC_P_TICKY(bytes, fun, arg)          \
   HP_CHK_P(bytes);                             \
nfrisby's avatar
nfrisby committed
436
   TICK_ALLOC_HEAP_NOCTR(bytes);
437 438 439 440 441

#define CHECK_GC()                                                      \
  (bdescr_link(CurrentNursery) == NULL ||                               \
   generation_n_new_large_words(W_[g0]) >= TO_W_(CLong[large_alloc_lim]))

442
// allocate() allocates from the nursery, so we check to see
443
// whether the nursery is nearly empty in any function that uses
444
// allocate() - this includes many of the primops.
445 446 447 448 449 450 451 452 453 454 455 456 457 458 459 460 461 462 463 464 465 466
//
// HACK alert: the __L__ stuff is here to coax the common-block
// eliminator into commoning up the call stg_gc_noregs() with the same
// code that gets generated by a STK_CHK_GEN() in the same proc.  We
// also need an if (0) { goto __L__; } so that the __L__ label isn't
// optimised away by the control-flow optimiser prior to common-block
// elimination (it will be optimised away later).
//
// This saves some code in gmp-wrappers.cmm where we have lots of
// MAYBE_GC() in the same proc as STK_CHK_GEN().
//
#define MAYBE_GC(retry)                         \
    if (CHECK_GC()) {                           \
        HpAlloc = 0;                            \
        goto __L__;                             \
  __L__:                                        \
        call stg_gc_noregs();                   \
        goto retry;                             \
   }                                            \
   if (0) { goto __L__; }

#define GC_PRIM(fun)                            \
467 468 469 470 471 472 473 474 475 476 477 478 479
        jump stg_gc_prim(fun);

// Version of GC_PRIM for use in low-level Cmm.  We can call
// stg_gc_prim, because it takes one argument and therefore has a
// platform-independent calling convention (Note [Syntax of .cmm
// files] in CmmParse.y).
#define GC_PRIM_LL(fun)                         \
        R1 = fun;                               \
        jump stg_gc_prim [R1];

// We pass the fun as the second argument, because the arg is
// usually already in the first argument position (R1), so this
// avoids moving it to a different register / stack slot.
480
#define GC_PRIM_N(fun,arg)                      \
481
        jump stg_gc_prim_n(arg,fun);
482 483

#define GC_PRIM_P(fun,arg)                      \
484 485 486 487 488 489
        jump stg_gc_prim_p(arg,fun);

#define GC_PRIM_P_LL(fun,arg)                   \
        R1 = arg;                               \
        R2 = fun;                               \
        jump stg_gc_prim_p_ll [R1,R2];
490 491

#define GC_PRIM_PP(fun,arg1,arg2)               \
492
        jump stg_gc_prim_pp(arg1,arg2,fun);
493 494 495 496 497 498 499 500 501 502 503 504 505 506 507 508 509

#define MAYBE_GC_(fun)                          \
    if (CHECK_GC()) {                           \
        HpAlloc = 0;                            \
        GC_PRIM(fun)                            \
   }

#define MAYBE_GC_N(fun,arg)                     \
    if (CHECK_GC()) {                           \
        HpAlloc = 0;                            \
        GC_PRIM_N(fun,arg)                      \
   }

#define MAYBE_GC_P(fun,arg)                     \
    if (CHECK_GC()) {                           \
        HpAlloc = 0;                            \
        GC_PRIM_P(fun,arg)                      \
510 511
   }

512 513 514 515 516 517
#define MAYBE_GC_PP(fun,arg1,arg2)              \
    if (CHECK_GC()) {                           \
        HpAlloc = 0;                            \
        GC_PRIM_PP(fun,arg1,arg2)               \
   }

518
#define STK_CHK_LL(n, fun)                      \
519
    TICK_BUMP(STK_CHK_ctr);                     \
520
    if (Sp - (n) < SpLim) {                     \
521
        GC_PRIM_LL(fun)                         \
522 523
    }

524 525
#define STK_CHK_P_LL(n, fun, arg)               \
    TICK_BUMP(STK_CHK_ctr);                     \
526
    if (Sp - (n) < SpLim) {                     \
527
        GC_PRIM_P_LL(fun,arg)                   \
528 529 530
    }

#define STK_CHK_PP(n, fun, arg1, arg2)          \
531
    TICK_BUMP(STK_CHK_ctr);                     \
532
    if (Sp - (n) < SpLim) {                     \
533 534 535 536
        GC_PRIM_PP(fun,arg1,arg2)               \
    }

#define STK_CHK_ENTER(n, closure)               \
537
    TICK_BUMP(STK_CHK_ctr);                     \
538
    if (Sp - (n) < SpLim) {                     \
539 540 541 542 543 544 545 546
        jump __stg_gc_enter_1(closure);         \
    }

// A funky heap check used by AutoApply.cmm

#define HP_CHK_NP_ASSIGN_SP0(size,f)                    \
    HEAP_CHECK(size, Sp(0) = f; jump __stg_gc_enter_1 [R1];)

547 548 549 550 551 552
/* -----------------------------------------------------------------------------
   Closure headers
   -------------------------------------------------------------------------- */

/*
 * This is really ugly, since we don't do the rest of StgHeader this
553
 * way.  The problem is that values from DerivedConstants.h cannot be
554 555 556 557 558 559 560 561 562
 * dependent on the way (SMP, PROF etc.).  For SIZEOF_StgHeader we get
 * the value from GHC, but it seems like too much trouble to do that
 * for StgThunkHeader.
 */
#define SIZEOF_StgThunkHeader SIZEOF_StgHeader+SIZEOF_StgSMPThunkHeader

#define StgThunk_payload(__ptr__,__ix__) \
    W_[__ptr__+SIZEOF_StgThunkHeader+ WDS(__ix__)]

563 564 565 566
/* -----------------------------------------------------------------------------
   Closures
   -------------------------------------------------------------------------- */

567
/* The offset of the payload of an array */
siddhanathan's avatar
siddhanathan committed
568
#define BYTE_ARR_CTS(arr)  ((arr) + SIZEOF_StgArrBytes)
569

570
/* The number of words allocated in an array payload */
siddhanathan's avatar
siddhanathan committed
571
#define BYTE_ARR_WDS(arr) ROUNDUP_BYTES_TO_WDS(StgArrBytes_bytes(arr))
572

573
/* Getting/setting the info pointer of a closure */
574 575 576
#define SET_INFO(p,info) StgHeader_info(p) = info
#define GET_INFO(p) StgHeader_info(p)

577
/* Determine the size of an ordinary closure from its info table */
578 579 580
#define sizeW_fromITBL(itbl) \
  SIZEOF_StgHeader + WDS(%INFO_PTRS(itbl)) + WDS(%INFO_NPTRS(itbl))

581
/* NB. duplicated from InfoTables.h! */
582 583 584
#define BITMAP_SIZE(bitmap) ((bitmap) & BITMAP_SIZE_MASK)
#define BITMAP_BITS(bitmap) ((bitmap) >> BITMAP_BITS_SHIFT)

585
/* Debugging macros */
Ian Lynagh's avatar
Ian Lynagh committed
586 587 588 589 590 591
#define LOOKS_LIKE_INFO_PTR(p)                                  \
   ((p) != NULL &&                                              \
    LOOKS_LIKE_INFO_PTR_NOT_NULL(p))

#define LOOKS_LIKE_INFO_PTR_NOT_NULL(p)                         \
   ( (TO_W_(%INFO_TYPE(%STD_INFO(p))) != INVALID_OBJECT) &&     \
592 593
     (TO_W_(%INFO_TYPE(%STD_INFO(p))) <  N_CLOSURE_TYPES))

Simon Marlow's avatar
Simon Marlow committed
594
#define LOOKS_LIKE_CLOSURE_PTR(p) (LOOKS_LIKE_INFO_PTR(GET_INFO(UNTAG(p))))
595

596 597 598 599 600
/*
 * The layout of the StgFunInfoExtra part of an info table changes
 * depending on TABLES_NEXT_TO_CODE.  So we define field access
 * macros which use the appropriate version here:
 */
Ben Gamari's avatar
Ben Gamari committed
601
#if defined(TABLES_NEXT_TO_CODE)
602 603 604 605
/*
 * when TABLES_NEXT_TO_CODE, slow_apply is stored as an offset
 * instead of the normal pointer.
 */
606

607
#define StgFunInfoExtra_slow_apply(fun_info)    \
608 609
        (TO_W_(StgFunInfoExtraRev_slow_apply_offset(fun_info))    \
               + (fun_info) + SIZEOF_StgFunInfoExtraRev + SIZEOF_StgInfoTable)
610

611 612 613 614 615 616 617 618 619 620
#define StgFunInfoExtra_fun_type(i)   StgFunInfoExtraRev_fun_type(i)
#define StgFunInfoExtra_arity(i)      StgFunInfoExtraRev_arity(i)
#define StgFunInfoExtra_bitmap(i)     StgFunInfoExtraRev_bitmap(i)
#else
#define StgFunInfoExtra_slow_apply(i) StgFunInfoExtraFwd_slow_apply(i)
#define StgFunInfoExtra_fun_type(i)   StgFunInfoExtraFwd_fun_type(i)
#define StgFunInfoExtra_arity(i)      StgFunInfoExtraFwd_arity(i)
#define StgFunInfoExtra_bitmap(i)     StgFunInfoExtraFwd_bitmap(i)
#endif

pumpkin's avatar
pumpkin committed
621 622 623 624
#define mutArrCardMask ((1 << MUT_ARR_PTRS_CARD_BITS) - 1)
#define mutArrPtrCardDown(i) ((i) >> MUT_ARR_PTRS_CARD_BITS)
#define mutArrPtrCardUp(i)   (((i) + mutArrCardMask) >> MUT_ARR_PTRS_CARD_BITS)
#define mutArrPtrsCardWords(n) ROUNDUP_BYTES_TO_WDS(mutArrPtrCardUp(n))
625

626
#if defined(PROFILING) || (!defined(THREADED_RTS) && defined(DEBUG))
627
#define OVERWRITING_CLOSURE_SIZE(c, size) foreign "C" overwritingClosureSize(c "ptr", size)
628
#define OVERWRITING_CLOSURE(c) foreign "C" overwritingClosure(c "ptr")
629
#define OVERWRITING_CLOSURE_OFS(c,n) foreign "C" overwritingClosureOfs(c "ptr", n)
630
#else
631
#define OVERWRITING_CLOSURE_SIZE(c, size) /* nothing */
632
#define OVERWRITING_CLOSURE(c) /* nothing */
633
#define OVERWRITING_CLOSURE_OFS(c,n) /* nothing */
634 635
#endif

636 637 638 639 640 641 642 643
// Memory barriers.
// For discussion of how these are used to fence heap object
// accesses see Note [Heap memory barriers] in SMP.h.
#if defined(THREADED_RTS)
#define prim_read_barrier prim %read_barrier()
#else
#define prim_read_barrier /* nothing */
#endif
Ben Gamari's avatar
Ben Gamari committed
644
#if defined(THREADED_RTS)
645 646 647 648 649
#define prim_write_barrier prim %write_barrier()
#else
#define prim_write_barrier /* nothing */
#endif

650
/* -----------------------------------------------------------------------------
651
   Ticky macros
652 653
   -------------------------------------------------------------------------- */

Ben Gamari's avatar
Ben Gamari committed
654
#if defined(TICKY_TICKY)
655 656 657 658 659 660 661
#define TICK_BUMP_BY(ctr,n) CLong[ctr] = CLong[ctr] + n
#else
#define TICK_BUMP_BY(ctr,n) /* nothing */
#endif

#define TICK_BUMP(ctr)      TICK_BUMP_BY(ctr,1)

662 663 664 665 666 667 668 669 670 671 672 673 674 675 676 677 678 679 680 681 682 683 684 685 686 687 688 689 690 691 692 693 694 695 696 697 698 699 700 701
#define TICK_ENT_DYN_IND()              TICK_BUMP(ENT_DYN_IND_ctr)
#define TICK_ENT_DYN_THK()              TICK_BUMP(ENT_DYN_THK_ctr)
#define TICK_ENT_VIA_NODE()             TICK_BUMP(ENT_VIA_NODE_ctr)
#define TICK_ENT_STATIC_IND()           TICK_BUMP(ENT_STATIC_IND_ctr)
#define TICK_ENT_PERM_IND()             TICK_BUMP(ENT_PERM_IND_ctr)
#define TICK_ENT_PAP()                  TICK_BUMP(ENT_PAP_ctr)
#define TICK_ENT_AP()                   TICK_BUMP(ENT_AP_ctr)
#define TICK_ENT_AP_STACK()             TICK_BUMP(ENT_AP_STACK_ctr)
#define TICK_ENT_BH()                   TICK_BUMP(ENT_BH_ctr)
#define TICK_ENT_LNE()                  TICK_BUMP(ENT_LNE_ctr)
#define TICK_UNKNOWN_CALL()             TICK_BUMP(UNKNOWN_CALL_ctr)
#define TICK_UPDF_PUSHED()              TICK_BUMP(UPDF_PUSHED_ctr)
#define TICK_CATCHF_PUSHED()            TICK_BUMP(CATCHF_PUSHED_ctr)
#define TICK_UPDF_OMITTED()             TICK_BUMP(UPDF_OMITTED_ctr)
#define TICK_UPD_NEW_IND()              TICK_BUMP(UPD_NEW_IND_ctr)
#define TICK_UPD_NEW_PERM_IND()         TICK_BUMP(UPD_NEW_PERM_IND_ctr)
#define TICK_UPD_OLD_IND()              TICK_BUMP(UPD_OLD_IND_ctr)
#define TICK_UPD_OLD_PERM_IND()         TICK_BUMP(UPD_OLD_PERM_IND_ctr)

#define TICK_SLOW_CALL_FUN_TOO_FEW()    TICK_BUMP(SLOW_CALL_FUN_TOO_FEW_ctr)
#define TICK_SLOW_CALL_FUN_CORRECT()    TICK_BUMP(SLOW_CALL_FUN_CORRECT_ctr)
#define TICK_SLOW_CALL_FUN_TOO_MANY()   TICK_BUMP(SLOW_CALL_FUN_TOO_MANY_ctr)
#define TICK_SLOW_CALL_PAP_TOO_FEW()    TICK_BUMP(SLOW_CALL_PAP_TOO_FEW_ctr)
#define TICK_SLOW_CALL_PAP_CORRECT()    TICK_BUMP(SLOW_CALL_PAP_CORRECT_ctr)
#define TICK_SLOW_CALL_PAP_TOO_MANY()   TICK_BUMP(SLOW_CALL_PAP_TOO_MANY_ctr)

#define TICK_SLOW_CALL_fast_v16()       TICK_BUMP(SLOW_CALL_fast_v16_ctr)
#define TICK_SLOW_CALL_fast_v()         TICK_BUMP(SLOW_CALL_fast_v_ctr)
#define TICK_SLOW_CALL_fast_p()         TICK_BUMP(SLOW_CALL_fast_p_ctr)
#define TICK_SLOW_CALL_fast_pv()        TICK_BUMP(SLOW_CALL_fast_pv_ctr)
#define TICK_SLOW_CALL_fast_pp()        TICK_BUMP(SLOW_CALL_fast_pp_ctr)
#define TICK_SLOW_CALL_fast_ppv()       TICK_BUMP(SLOW_CALL_fast_ppv_ctr)
#define TICK_SLOW_CALL_fast_ppp()       TICK_BUMP(SLOW_CALL_fast_ppp_ctr)
#define TICK_SLOW_CALL_fast_pppv()      TICK_BUMP(SLOW_CALL_fast_pppv_ctr)
#define TICK_SLOW_CALL_fast_pppp()      TICK_BUMP(SLOW_CALL_fast_pppp_ctr)
#define TICK_SLOW_CALL_fast_ppppp()     TICK_BUMP(SLOW_CALL_fast_ppppp_ctr)
#define TICK_SLOW_CALL_fast_pppppp()    TICK_BUMP(SLOW_CALL_fast_pppppp_ctr)
#define TICK_VERY_SLOW_CALL()           TICK_BUMP(VERY_SLOW_CALL_ctr)

/* NOTE: TICK_HISTO_BY and TICK_HISTO
702
   currently have no effect.
703
   The old code for it didn't typecheck and I
704 705 706
   just commented it out to get ticky to work.
   - krc 1/2007 */

707 708 709 710
#define TICK_HISTO_BY(histo,n,i) /* nothing */

#define TICK_HISTO(histo,n) TICK_HISTO_BY(histo,n,1)

711
/* An unboxed tuple with n components. */
712 713
#define TICK_RET_UNBOXED_TUP(n)                 \
  TICK_BUMP(RET_UNBOXED_TUP_ctr++);             \
714 715
  TICK_HISTO(RET_UNBOXED_TUP,n)

716 717 718 719
/*
 * A slow call with n arguments.  In the unevald case, this call has
 * already been counted once, so don't count it again.
 */
720 721
#define TICK_SLOW_CALL(n)                       \
  TICK_BUMP(SLOW_CALL_ctr);                     \
722 723
  TICK_HISTO(SLOW_CALL,n)

724 725 726 727
/*
 * This slow call was found to be to an unevaluated function; undo the
 * ticks we did in TICK_SLOW_CALL.
 */
728 729 730
#define TICK_SLOW_CALL_UNEVALD(n)               \
  TICK_BUMP(SLOW_CALL_UNEVALD_ctr);             \
  TICK_BUMP_BY(SLOW_CALL_ctr,-1);               \
731 732
  TICK_HISTO_BY(SLOW_CALL,n,-1);

733
/* Updating a closure with a new CON */
734 735
#define TICK_UPD_CON_IN_NEW(n)                  \
  TICK_BUMP(UPD_CON_IN_NEW_ctr);                \
736 737
  TICK_HISTO(UPD_CON_IN_NEW,n)

738 739
#define TICK_ALLOC_HEAP_NOCTR(bytes)            \
    TICK_BUMP(ALLOC_RTS_ctr);                   \
nfrisby's avatar
nfrisby committed
740
    TICK_BUMP_BY(ALLOC_RTS_tot,bytes)
741

742 743 744 745 746 747 748 749 750 751 752 753 754
/* -----------------------------------------------------------------------------
   Saving and restoring STG registers

   STG registers must be saved around a C call, just in case the STG
   register is mapped to a caller-saves machine register.  Normally we
   don't need to worry about this the code generator has already
   loaded any live STG registers into variables for us, but in
   hand-written low-level Cmm code where we don't know which registers
   are live, we might have to save them all.
   -------------------------------------------------------------------------- */

#define SAVE_STGREGS                            \
    W_ r1, r2, r3,  r4,  r5,  r6,  r7,  r8;     \
755 756
    F_ f1, f2, f3, f4, f5, f6;                  \
    D_ d1, d2, d3, d4, d5, d6;                  \
757 758 759 760 761 762 763 764 765 766 767 768 769 770 771
    L_ l1;                                      \
                                                \
    r1 = R1;                                    \
    r2 = R2;                                    \
    r3 = R3;                                    \
    r4 = R4;                                    \
    r5 = R5;                                    \
    r6 = R6;                                    \
    r7 = R7;                                    \
    r8 = R8;                                    \
                                                \
    f1 = F1;                                    \
    f2 = F2;                                    \
    f3 = F3;                                    \
    f4 = F4;                                    \
772 773
    f5 = F5;                                    \
    f6 = F6;                                    \
774 775 776
                                                \
    d1 = D1;                                    \
    d2 = D2;                                    \
777 778 779 780
    d3 = D3;                                    \
    d4 = D4;                                    \
    d5 = D5;                                    \
    d6 = D6;                                    \
781 782 783 784 785 786 787 788 789 790 791 792 793 794 795 796 797 798
                                                \
    l1 = L1;


#define RESTORE_STGREGS                         \
    R1 = r1;                                    \
    R2 = r2;                                    \
    R3 = r3;                                    \
    R4 = r4;                                    \
    R5 = r5;                                    \
    R6 = r6;                                    \
    R7 = r7;                                    \
    R8 = r8;                                    \
                                                \
    F1 = f1;                                    \
    F2 = f2;                                    \
    F3 = f3;                                    \
    F4 = f4;                                    \
799 800
    F5 = f5;                                    \
    F6 = f6;                                    \
801 802 803
                                                \
    D1 = d1;                                    \
    D2 = d2;                                    \
804 805 806 807
    D3 = d3;                                    \
    D4 = d4;                                    \
    D5 = d5;                                    \
    D6 = d6;                                    \
808 809 810
                                                \
    L1 = l1;

811 812 813 814
/* -----------------------------------------------------------------------------
   Misc junk
   -------------------------------------------------------------------------- */

tharris@microsoft.com's avatar
tharris@microsoft.com committed
815 816
#define NO_TREC                   stg_NO_TREC_closure
#define END_TSO_QUEUE             stg_END_TSO_QUEUE_closure
Ben Gamari's avatar
Ben Gamari committed
817
#define STM_AWOKEN                stg_STM_AWOKEN_closure
818

819
#define recordMutableCap(p, gen)                                        \
820 821 822 823 824 825 826 827 828 829 830 831 832 833
  W_ __bd;                                                              \
  W_ mut_list;                                                          \
  mut_list = Capability_mut_lists(MyCapability()) + WDS(gen);           \
 __bd = W_[mut_list];                                                   \
  if (bdescr_free(__bd) >= bdescr_start(__bd) + BLOCK_SIZE) {           \
      W_ __new_bd;                                                      \
      ("ptr" __new_bd) = foreign "C" allocBlock_lock();                 \
      bdescr_link(__new_bd) = __bd;                                     \
      __bd = __new_bd;                                                  \
      W_[mut_list] = __bd;                                              \
  }                                                                     \
  W_ free;                                                              \
  free = bdescr_free(__bd);                                             \
  W_[free] = p;                                                         \
834 835
  bdescr_free(__bd) = free + WDS(1);

836
#define recordMutable(p)                                        \
837
      P_ __p;                                                   \
838 839 840 841 842
      W_ __bd;                                                  \
      W_ __gen;                                                 \
      __p = p;                                                  \
      __bd = Bdescr(__p);                                       \
      __gen = TO_W_(bdescr_gen_no(__bd));                       \
843
      if (__gen > 0) { recordMutableCap(__p, __gen); }
844

845 846 847 848
/* -----------------------------------------------------------------------------
   Update remembered set write barrier
   -------------------------------------------------------------------------- */

849 850 851 852
/* -----------------------------------------------------------------------------
   Arrays
   -------------------------------------------------------------------------- */

853 854 855 856 857 858 859 860 861 862 863 864 865 866 867 868 869 870 871 872
/* Complete function body for the clone family of (mutable) array ops.
   Defined as a macro to avoid function call overhead or code
   duplication. */
#define cloneArray(info, src, offset, n)                       \
    W_ words, size;                                            \
    gcptr dst, dst_p, src_p;                                   \
                                                               \
    again: MAYBE_GC(again);                                    \
                                                               \
    size = n + mutArrPtrsCardWords(n);                         \
    words = BYTES_TO_WDS(SIZEOF_StgMutArrPtrs) + size;         \
    ("ptr" dst) = ccall allocate(MyCapability() "ptr", words); \
    TICK_ALLOC_PRIM(SIZEOF_StgMutArrPtrs, WDS(size), 0);       \
                                                               \
    SET_HDR(dst, info, CCCS);                                  \
    StgMutArrPtrs_ptrs(dst) = n;                               \
    StgMutArrPtrs_size(dst) = size;                            \
                                                               \
    dst_p = dst + SIZEOF_StgMutArrPtrs;                        \
    src_p = src + SIZEOF_StgMutArrPtrs + WDS(offset);          \
Ben Gamari's avatar
Ben Gamari committed
873
    prim %memcpy(dst_p, src_p, n * SIZEOF_W, SIZEOF_W);        \
874 875 876
                                                               \
    return (dst);

877 878 879 880 881 882 883 884 885 886 887
#define copyArray(src, src_off, dst, dst_off, n)                  \
  W_ dst_elems_p, dst_p, src_p, dst_cards_p, bytes;               \
                                                                  \
    if ((n) != 0) {                                               \
        SET_HDR(dst, stg_MUT_ARR_PTRS_DIRTY_info, CCCS);          \
                                                                  \
        dst_elems_p = (dst) + SIZEOF_StgMutArrPtrs;               \
        dst_p = dst_elems_p + WDS(dst_off);                       \
        src_p = (src) + SIZEOF_StgMutArrPtrs + WDS(src_off);      \
        bytes = WDS(n);                                           \
                                                                  \
888
        prim %memcpy(dst_p, src_p, bytes, SIZEOF_W);              \
889 890 891 892 893 894 895 896 897 898 899 900 901 902 903 904 905 906 907
                                                                  \
        dst_cards_p = dst_elems_p + WDS(StgMutArrPtrs_ptrs(dst)); \
        setCards(dst_cards_p, dst_off, n);                        \
    }                                                             \
                                                                  \
    return ();

#define copyMutableArray(src, src_off, dst, dst_off, n)           \
  W_ dst_elems_p, dst_p, src_p, dst_cards_p, bytes;               \
                                                                  \
    if ((n) != 0) {                                               \
        SET_HDR(dst, stg_MUT_ARR_PTRS_DIRTY_info, CCCS);          \
                                                                  \
        dst_elems_p = (dst) + SIZEOF_StgMutArrPtrs;               \
        dst_p = dst_elems_p + WDS(dst_off);                       \
        src_p = (src) + SIZEOF_StgMutArrPtrs + WDS(src_off);      \
        bytes = WDS(n);                                           \
                                                                  \
        if ((src) == (dst)) {                                     \
908
            prim %memmove(dst_p, src_p, bytes, SIZEOF_W);         \
909
        } else {                                                  \
910
            prim %memcpy(dst_p, src_p, bytes, SIZEOF_W);          \
911 912 913 914 915 916 917 918 919 920 921 922 923 924 925 926 927 928 929
        }                                                         \
                                                                  \
        dst_cards_p = dst_elems_p + WDS(StgMutArrPtrs_ptrs(dst)); \
        setCards(dst_cards_p, dst_off, n);                        \
    }                                                             \
                                                                  \
    return ();

/*
 * Set the cards in the cards table pointed to by dst_cards_p for an
 * update to n elements, starting at element dst_off.
 */
#define setCards(dst_cards_p, dst_off, n)                      \
    W_ __start_card, __end_card, __cards;                      \
    __start_card = mutArrPtrCardDown(dst_off);                 \
    __end_card = mutArrPtrCardDown((dst_off) + (n) - 1);       \
    __cards = __end_card - __start_card + 1;                   \
    prim %memset((dst_cards_p) + __start_card, 1, __cards, 1);

930 931 932 933 934 935 936 937 938 939 940 941 942 943 944 945 946 947
/* Complete function body for the clone family of small (mutable)
   array ops. Defined as a macro to avoid function call overhead or
   code duplication. */
#define cloneSmallArray(info, src, offset, n)                  \
    W_ words, size;                                            \
    gcptr dst, dst_p, src_p;                                   \
                                                               \
    again: MAYBE_GC(again);                                    \
                                                               \
    words = BYTES_TO_WDS(SIZEOF_StgSmallMutArrPtrs) + n;       \
    ("ptr" dst) = ccall allocate(MyCapability() "ptr", words); \
    TICK_ALLOC_PRIM(SIZEOF_StgSmallMutArrPtrs, WDS(n), 0);     \
                                                               \
    SET_HDR(dst, info, CCCS);                                  \
    StgSmallMutArrPtrs_ptrs(dst) = n;                          \
                                                               \
    dst_p = dst + SIZEOF_StgSmallMutArrPtrs;                   \
    src_p = src + SIZEOF_StgSmallMutArrPtrs + WDS(offset);     \
Ben Gamari's avatar
Ben Gamari committed
948
    prim %memcpy(dst_p, src_p, n * SIZEOF_W, SIZEOF_W);        \
949 950
                                                               \
    return (dst);
951 952


953 954 955 956 957
//
// Nonmoving write barrier helpers
//
// See Note [Update remembered set] in NonMovingMark.c.

958
#if defined(THREADED_RTS)
959
#define IF_NONMOVING_WRITE_BARRIER_ENABLED                     \
960 961 962
    if (W_[nonmoving_write_barrier_enabled] != 0) (likely: False)
#else
// A similar measure is also taken in rts/NonMoving.h, but that isn't visible from C--
963
#define IF_NONMOVING_WRITE_BARRIER_ENABLED                     \
964 965 966 967 968 969
    if (0)
#define nonmoving_write_barrier_enabled 0
#endif

// A useful helper for pushing a pointer to the update remembered set.
#define updateRemembSetPushPtr(p)                                    \
970
    IF_NONMOVING_WRITE_BARRIER_ENABLED {                             \
971 972
      ccall updateRemembSetPushClosure_(BaseReg "ptr", p "ptr");     \
    }