Cmm.h 27.5 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 28 29 30
 * already have a macro, edit that file (it's pretty self-explanatory).
 *
 * -------------------------------------------------------------------------- */

#ifndef CMM_H
#define CMM_H

31 32 33 34 35
/*
 * 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:
 */
36 37 38 39 40 41 42 43 44 45 46 47 48 49 50 51 52 53 54 55 56 57 58 59
#define CMINUSMINUS 1

#include "ghcconfig.h"

/* -----------------------------------------------------------------------------
   Types 

   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)
     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
   
  --------------------------------------------------------------------------- */

#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 76
 * The RTS must sometimes UNTAG a pointer before dereferencing it.
 * See the wiki page Commentary/Rts/HaskellExecution/PointerTagging 
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

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

#define SIZEOF_StgDouble 8
#define SIZEOF_StgWord64 8

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

112 113
#define ccall foreign "C"

114 115 116 117 118 119 120
#define NULL (0::W_)

#define STRING(name,str)			\
  section "rodata" {				\
	name : bits8[] str;			\
  }						\

Simon Marlow's avatar
Simon Marlow committed
121 122 123 124 125 126 127 128 129 130 131 132
#ifdef TABLES_NEXT_TO_CODE
#define RET_LBL(f) f##_info
#else
#define RET_LBL(f) f##_ret
#endif

#ifdef TABLES_NEXT_TO_CODE
#define ENTRY_LBL(f) f##_info
#else
#define ENTRY_LBL(f) f##_entry
#endif

133 134 135 136 137 138 139 140 141 142 143 144 145 146
/* -----------------------------------------------------------------------------
   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
147
#define W_SHIFT 3
148 149
#endif

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

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

160
/* TO_W_(n) converts n to W_ type from a smaller type */
161 162 163 164 165 166 167 168
#if SIZEOF_W == 4
#define TO_W_(x) %sx32(x)
#define HALF_W_(x) %lobits16(x)
#elif SIZEOF_W == 8
#define TO_W_(x) %sx64(x)
#define HALF_W_(x) %lobits32(x)
#endif

169 170 171 172 173 174
#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
175 176 177 178 179 180
#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

181 182 183 184 185 186 187
/* -----------------------------------------------------------------------------
   Heap/stack access, and adjusting the heap/stack pointers.
   -------------------------------------------------------------------------- */

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

188
#define Sp_adj(n) Sp = Sp + WDS(n)  /* pronounced "spadge" */
189 190 191 192 193 194 195 196 197 198 199
#define Hp_adj(n) Hp = Hp + WDS(n)

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

#ifdef DEBUG
#define ASSERT(predicate)			\
	if (predicate) {			\
	    /*null*/;				\
	} else {				\
200
	    foreign "C" _assertFail(NULL, __LINE__) never returns; \
201 202 203 204 205 206 207 208 209 210 211
        }
#else
#define ASSERT(p) /* nothing */
#endif

#ifdef DEBUG
#define DEBUG_ONLY(s) s
#else
#define DEBUG_ONLY(s) /* nothing */
#endif

212 213 214 215 216 217 218 219 220
/*
 * The IF_DEBUG macro is useful for debug messages that depend on one
 * of the RTS debug options.  For example:
 * 
 *   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.
 */
221
#ifdef DEBUG
Simon Marlow's avatar
Simon Marlow committed
222
#define IF_DEBUG(c,s)  if (RtsFlags_DebugFlags_##c(RtsFlags) != 0::I32) { s; }
223 224 225 226 227 228 229 230 231 232 233 234 235
#else
#define IF_DEBUG(c,s)  /* nothing */
#endif

/* -----------------------------------------------------------------------------
   Entering 

   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
236 237 238 239 240 241 242 243 244

   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.
245 246
   -------------------------------------------------------------------------- */

247 248 249 250 251 252
#ifdef PROFILING

// 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
253 254
#define LOAD_INFO(ret,x)                        \
    info = %INFO_PTR(UNTAG(x));
255

Simon Marlow's avatar
Simon Marlow committed
256
#define UNTAG_IF_PROF(x) UNTAG(x)
257 258 259

#else

260 261 262
#define LOAD_INFO(ret,x)                        \
  if (GETTAG(x) != 0) {                         \
      ret(x);                                   \
263
  }                                             \
264
  info = %INFO_PTR(x);
265

Simon Marlow's avatar
Simon Marlow committed
266
#define UNTAG_IF_PROF(x) (x) /* already untagged */
267 268 269

#endif

270 271 272 273 274 275 276 277 278 279 280 281 282 283
// 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.

#define ENTER(x) ENTER_(return,x)
#define ENTER_R1() ENTER_(RET_R1,R1)

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

#define ENTER_(ret,x)                                   \
284
 again:							\
285
  W_ info;						\
286
  LOAD_INFO(ret,x)                                       \
287
  switch [INVALID_OBJECT .. N_CLOSURE_TYPES]		\
288 289
         (TO_W_( %INFO_TYPE(%STD_INFO(info)) )) {	\
  case							\
290 291 292 293
    IND,						\
    IND_PERM,						\
    IND_STATIC:						\
   {							\
294
      x = StgInd_indirectee(x);                         \
295 296
      goto again;					\
   }							\
297
  case							\
298 299 300 301 302
    FUN,						\
    FUN_1_0,						\
    FUN_0_1,						\
    FUN_2_0,						\
    FUN_1_1,						\
303
    FUN_0_2,						\
Simon Marlow's avatar
Simon Marlow committed
304 305
    FUN_STATIC,                                         \
    BCO,						\
306 307
    PAP:						\
   {							\
308
       ret(x);                                          \
309 310 311
   }							\
  default:						\
   {							\
Simon Marlow's avatar
Simon Marlow committed
312
       x = UNTAG_IF_PROF(x);                            \
313
       jump %ENTRY_CODE(info) (x);                      \
314 315 316
   }							\
  }

Simon Marlow's avatar
Simon Marlow committed
317 318 319 320
// 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.

321 322 323 324
/* -----------------------------------------------------------------------------
   Constants.
   -------------------------------------------------------------------------- */

Simon Marlow's avatar
Simon Marlow committed
325
#include "rts/Constants.h"
326
#include "DerivedConstants.h"
Simon Marlow's avatar
Simon Marlow committed
327 328 329 330
#include "rts/storage/ClosureTypes.h"
#include "rts/storage/FunTypes.h"
#include "rts/storage/SMPClosureOps.h"
#include "rts/OSThreads.h"
331

332 333 334 335
/*
 * Need MachRegs, because some of the RTS code is conditionally
 * compiled based on REG_R1, REG_R2, etc.
 */
336
#include "stg/RtsMachRegs.h"
337

Simon Marlow's avatar
Simon Marlow committed
338
#include "rts/prof/LDV.h"
339 340 341

#undef BLOCK_SIZE
#undef MBLOCK_SIZE
Simon Marlow's avatar
Simon Marlow committed
342
#include "rts/storage/Block.h"  /* For Bdescr() */
343 344


345 346
#define MyCapability()  (BaseReg - OFFSET_Capability_r)

347 348 349 350 351
/* -------------------------------------------------------------------------
   Info tables
   ------------------------------------------------------------------------- */

#if defined(PROFILING)
Simon Marlow's avatar
Simon Marlow committed
352 353
#define PROF_HDR_FIELDS(w_,hdr1,hdr2)          \
  w_ hdr1,                                     \
Simon Marlow's avatar
Simon Marlow committed
354
  w_ hdr2,
355
#else
Simon Marlow's avatar
Simon Marlow committed
356
#define PROF_HDR_FIELDS(w_,hdr1,hdr2) /* nothing */
357 358
#endif

359 360 361 362
/* -------------------------------------------------------------------------
   Allocation and garbage collection
   ------------------------------------------------------------------------- */

363 364 365 366 367 368 369 370 371
/*
 * 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.
 */
372 373
#define ALLOC_PRIM(bytes)                                       \
   HP_CHK_GEN_TICKY(bytes);                                     \
374 375 376
   TICK_ALLOC_PRIM(SIZEOF_StgHeader,bytes-SIZEOF_StgHeader,0);	\
   CCCS_ALLOC(bytes);

377
#define HEAP_CHECK(bytes,failure)                       \
378
    TICK_BUMP(HEAP_CHK_ctr);				\
379 380
    Hp = Hp + (bytes);                                  \
    if (Hp > HpLim) { HpAlloc = (bytes); failure; }     \
381 382 383 384 385 386 387
    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);

388 389 390
#define ALLOC_PRIM_(bytes,fun)                                  \
    ALLOC_PRIM_WITH_CUSTOM_FAILURE(bytes,GC_PRIM(fun));

391 392 393 394 395 396
#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));

397
/* CCS_ALLOC wants the size in words, because ccs->mem_alloc is in words */
398
#define CCCS_ALLOC(__alloc) CCS_ALLOC(BYTES_TO_WDS(__alloc), CCCS)
399

nfrisby's avatar
nfrisby committed
400 401 402
#define HP_CHK_GEN_TICKY(bytes)                 \
   HP_CHK_GEN(bytes);                           \
   TICK_ALLOC_HEAP_NOCTR(bytes);
403

404 405 406
#define HP_CHK_P(bytes, fun, arg)               \
   HEAP_CHECK(bytes, GC_PRIM_P(fun,arg))

nfrisby's avatar
nfrisby committed
407 408 409 410 411
// TODO I'm not seeing where ALLOC_P_TICKY is used; can it be removed?
//         -NSF March 2013
#define ALLOC_P_TICKY(bytes, fun, arg)		\
   HP_CHK_P(bytes);				\
   TICK_ALLOC_HEAP_NOCTR(bytes);
412 413 414 415 416

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

417
// allocate() allocates from the nursery, so we check to see
418
// whether the nursery is nearly empty in any function that uses
419
// allocate() - this includes many of the primops.
420 421 422 423 424 425 426 427 428 429 430 431 432 433 434 435 436 437 438 439 440 441 442 443 444 445 446 447 448 449 450 451 452 453 454 455 456 457 458 459 460 461 462 463 464 465 466 467 468 469 470 471 472
//
// 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)                            \
        R9 = fun;                               \
        jump stg_gc_prim();

#define GC_PRIM_N(fun,arg)                      \
        R9 = fun;                               \
        jump stg_gc_prim_n(arg);

#define GC_PRIM_P(fun,arg)                      \
        R9 = fun;                               \
        jump stg_gc_prim_p(arg);

#define GC_PRIM_PP(fun,arg1,arg2)               \
        R9 = fun;                               \
        jump stg_gc_prim_pp(arg1,arg2);

#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)                      \
473 474
   }

475 476 477 478 479 480 481
#define MAYBE_GC_PP(fun,arg1,arg2)              \
    if (CHECK_GC()) {                           \
        HpAlloc = 0;                            \
        GC_PRIM_PP(fun,arg1,arg2)               \
   }

#define STK_CHK(n, fun)                         \
482
    TICK_BUMP(STK_CHK_ctr); 			\
483
    if (Sp - (n) < SpLim) {                     \
484 485 486 487
        GC_PRIM(fun)                            \
    }

#define STK_CHK_P(n, fun, arg)                  \
488
    if (Sp - (n) < SpLim) {                     \
489 490 491 492
        GC_PRIM_P(fun,arg)                      \
    }

#define STK_CHK_PP(n, fun, arg1, arg2)          \
493
    if (Sp - (n) < SpLim) {                     \
494 495 496 497
        GC_PRIM_PP(fun,arg1,arg2)               \
    }

#define STK_CHK_ENTER(n, closure)               \
498
    if (Sp - (n) < SpLim) {                     \
499 500 501 502 503 504 505 506
        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];)

507 508 509 510 511 512 513 514 515 516 517 518 519 520 521 522
/* -----------------------------------------------------------------------------
   Closure headers
   -------------------------------------------------------------------------- */

/*
 * This is really ugly, since we don't do the rest of StgHeader this
 * way.  The problem is that values from DerivedConstants.h cannot be 
 * 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__)]

523 524 525 526
/* -----------------------------------------------------------------------------
   Closures
   -------------------------------------------------------------------------- */

527
/* The offset of the payload of an array */
528 529
#define BYTE_ARR_CTS(arr)  ((arr) + SIZEOF_StgArrWords)

530 531 532
/* The number of words allocated in an array payload */
#define BYTE_ARR_WDS(arr) ROUNDUP_BYTES_TO_WDS(StgArrWords_bytes(arr))

533
/* Getting/setting the info pointer of a closure */
534 535 536
#define SET_INFO(p,info) StgHeader_info(p) = info
#define GET_INFO(p) StgHeader_info(p)

537
/* Determine the size of an ordinary closure from its info table */
538 539 540
#define sizeW_fromITBL(itbl) \
  SIZEOF_StgHeader + WDS(%INFO_PTRS(itbl)) + WDS(%INFO_NPTRS(itbl))

541
/* NB. duplicated from InfoTables.h! */
542 543 544
#define BITMAP_SIZE(bitmap) ((bitmap) & BITMAP_SIZE_MASK)
#define BITMAP_BITS(bitmap) ((bitmap) >> BITMAP_BITS_SHIFT)

545
/* Debugging macros */
Ian Lynagh's avatar
Ian Lynagh committed
546 547 548 549 550 551
#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) &&     \
552 553
     (TO_W_(%INFO_TYPE(%STD_INFO(p))) <  N_CLOSURE_TYPES))

Simon Marlow's avatar
Simon Marlow committed
554
#define LOOKS_LIKE_CLOSURE_PTR(p) (LOOKS_LIKE_INFO_PTR(GET_INFO(UNTAG(p))))
555

556 557 558 559 560
/*
 * 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:
 */
561
#ifdef TABLES_NEXT_TO_CODE
562 563 564 565
/*
 * when TABLES_NEXT_TO_CODE, slow_apply is stored as an offset
 * instead of the normal pointer.
 */
566 567
        
#define StgFunInfoExtra_slow_apply(fun_info)    \
568 569
        (TO_W_(StgFunInfoExtraRev_slow_apply_offset(fun_info))    \
               + (fun_info) + SIZEOF_StgFunInfoExtraRev + SIZEOF_StgInfoTable)
570

571 572 573 574 575 576 577 578 579 580
#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
581 582 583 584
#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))
585

586 587 588 589 590 591
#if defined(PROFILING) || (!defined(THREADED_RTS) && defined(DEBUG))
#define OVERWRITING_CLOSURE(c) foreign "C" overwritingClosure(c "ptr")
#else
#define OVERWRITING_CLOSURE(c) /* nothing */
#endif

592 593 594 595 596 597
#ifdef THREADED_RTS
#define prim_write_barrier prim %write_barrier()
#else
#define prim_write_barrier /* nothing */
#endif

598 599 600 601 602 603 604 605 606 607 608 609 610 611 612 613 614 615 616 617 618
/* -----------------------------------------------------------------------------
   Ticky macros 
   -------------------------------------------------------------------------- */

#ifdef TICKY_TICKY
#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)

#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)
nfrisby's avatar
nfrisby committed
619
#define TICK_ENT_LNE() 			TICK_BUMP(ENT_LNE_ctr)
620 621 622 623 624 625 626 627 628 629 630 631 632 633 634 635
#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)

nfrisby's avatar
nfrisby committed
636 637 638 639 640 641 642 643 644 645 646 647
#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)
648

649 650 651 652 653 654
/* NOTE: TICK_HISTO_BY and TICK_HISTO 
   currently have no effect.
   The old code for it didn't typecheck and I 
   just commented it out to get ticky to work.
   - krc 1/2007 */

655 656 657 658
#define TICK_HISTO_BY(histo,n,i) /* nothing */

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

659
/* An unboxed tuple with n components. */
660 661 662 663
#define TICK_RET_UNBOXED_TUP(n)			\
  TICK_BUMP(RET_UNBOXED_TUP_ctr++);		\
  TICK_HISTO(RET_UNBOXED_TUP,n)

664 665 666 667
/*
 * A slow call with n arguments.  In the unevald case, this call has
 * already been counted once, so don't count it again.
 */
668 669 670 671
#define TICK_SLOW_CALL(n)			\
  TICK_BUMP(SLOW_CALL_ctr);			\
  TICK_HISTO(SLOW_CALL,n)

672 673 674 675
/*
 * This slow call was found to be to an unevaluated function; undo the
 * ticks we did in TICK_SLOW_CALL.
 */
676 677 678 679 680
#define TICK_SLOW_CALL_UNEVALD(n)		\
  TICK_BUMP(SLOW_CALL_UNEVALD_ctr);		\
  TICK_BUMP_BY(SLOW_CALL_ctr,-1);		\
  TICK_HISTO_BY(SLOW_CALL,n,-1);

681
/* Updating a closure with a new CON */
682 683 684 685
#define TICK_UPD_CON_IN_NEW(n)			\
  TICK_BUMP(UPD_CON_IN_NEW_ctr);		\
  TICK_HISTO(UPD_CON_IN_NEW,n)

nfrisby's avatar
nfrisby committed
686 687 688
#define TICK_ALLOC_HEAP_NOCTR(bytes)		\
    TICK_BUMP(ALLOC_RTS_ctr);			\
    TICK_BUMP_BY(ALLOC_RTS_tot,bytes)
689

690 691 692 693 694 695 696 697 698 699 700 701 702
/* -----------------------------------------------------------------------------
   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;     \
703 704
    F_ f1, f2, f3, f4, f5, f6;                  \
    D_ d1, d2, d3, d4, d5, d6;                  \
705 706 707 708 709 710 711 712 713 714 715 716 717 718 719
    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;                                    \
720 721
    f5 = F5;                                    \
    f6 = F6;                                    \
722 723 724
                                                \
    d1 = D1;                                    \
    d2 = D2;                                    \
725 726 727 728
    d3 = D3;                                    \
    d4 = D4;                                    \
    d5 = D5;                                    \
    d6 = D6;                                    \
729 730 731 732 733 734 735 736 737 738 739 740 741 742 743 744 745 746
                                                \
    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;                                    \
747 748
    F5 = f5;                                    \
    F6 = f6;                                    \
749 750 751
                                                \
    D1 = d1;                                    \
    D2 = d2;                                    \
752 753 754 755
    D3 = d3;                                    \
    D4 = d4;                                    \
    D5 = d5;                                    \
    D6 = d6;                                    \
756 757 758
                                                \
    L1 = l1;

759 760 761 762
/* -----------------------------------------------------------------------------
   Misc junk
   -------------------------------------------------------------------------- */

tharris@microsoft.com's avatar
tharris@microsoft.com committed
763 764
#define NO_TREC                   stg_NO_TREC_closure
#define END_TSO_QUEUE             stg_END_TSO_QUEUE_closure
Ben Gamari's avatar
Ben Gamari committed
765
#define STM_AWOKEN                stg_STM_AWOKEN_closure
tharris@microsoft.com's avatar
tharris@microsoft.com committed
766
#define END_INVARIANT_CHECK_QUEUE stg_END_INVARIANT_CHECK_QUEUE_closure
767

768
#define recordMutableCap(p, gen)                                        \
769 770 771 772 773 774
  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;							\
775
      ("ptr" __new_bd) = foreign "C" allocBlock_lock();			\
776 777 778 779 780 781 782 783 784
      bdescr_link(__new_bd) = __bd;					\
      __bd = __new_bd;							\
      W_[mut_list] = __bd;						\
  }									\
  W_ free;								\
  free = bdescr_free(__bd);						\
  W_[free] = p;								\
  bdescr_free(__bd) = free + WDS(1);

785
#define recordMutable(p)                                        \
786
      P_ __p;                                                   \
787 788 789 790 791
      W_ __bd;                                                  \
      W_ __gen;                                                 \
      __p = p;                                                  \
      __bd = Bdescr(__p);                                       \
      __gen = TO_W_(bdescr_gen_no(__bd));                       \
792
      if (__gen > 0) { recordMutableCap(__p, __gen); }
793

794
#endif /* CMM_H */