Cmm.h 19.7 KB
Newer Older
1
2
3
4
5
6
7
8
9
10
11
12
13
14
15
16
17
18
19
20
21
22
23
24
25
26
27
/* -----------------------------------------------------------------------------
 *
 * (c) The University of Glasgow 2004
 *
 * 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.
 *
 * If you're used to the old HC file syntax, here's a quick cheat sheet
 * for converting HC code:
 *
 *       - Remove FB_/FE_
 *       - Remove all type casts
 *       - Remove '&'
 *       - STGFUN(foo) { ... }  ==>  foo { ... }
 *       - FN_(foo) { ... }  ==>  foo { ... }
 *       - JMP_(e)  ==> jump e;
 *       - Remove EXTFUN(foo)
 *       - Sp[n]  ==>  Sp(n)
 *       - Hp[n]  ==>  Hp(n)
 *       - Sp += n  ==> Sp_adj(n)
 *       - Hp += n  ==> Hp_adj(n)
 *       - R1.i   ==>  R1   (similarly for R1.w, R1.cl etc.)
 *       - You need to explicitly dereference variables; eg. 
28
 *             alloc_blocks   ==>  CInt[alloc_blocks]
29
30
31
32
33
34
35
36
37
38
39
40
41
42
43
44
45
46
47
48
49
50
51
52
53
54
55
56
57
58
59
60
 *       - convert all word offsets into byte offsets:
 *         	- e ==> WDS(e)
 *       - sizeofW(StgFoo)  ==>  SIZEOF_StgFoo
 *       - ENTRY_CODE(e)  ==>  %ENTRY_CODE(e)
 *       - get_itbl(c)  ==>  %GET_STD_INFO(c)
 *       - Change liveness masks in STK_CHK_GEN, HP_CHK_GEN:
 *        	R1_PTR | R2_PTR  ==>  R1_PTR & R2_PTR
 *         	(NOTE: | becomes &)
 *       - Declarations like 'StgPtr p;' become just 'W_ p;'
 *       - e->payload[n] ==> PAYLOAD(e,n)
 *       - Be very careful with comparisons: the infix versions (>, >=, etc.)
 *         are unsigned, so use %lt(a,b) to get signed less-than for example.
 *
 * 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
 * mkDerivedConstnants.c.  If you need to access a field that doesn't
 * already have a macro, edit that file (it's pretty self-explanatory).
 *
 * -------------------------------------------------------------------------- */

#ifndef CMM_H
#define CMM_H

61
62
63
64
65
/*
 * 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:
 */
66
67
68
69
70
71
72
73
74
75
76
77
78
79
80
81
82
83
84
85
86
87
88
89
#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
90
#define P_  gcptr
91
92
93

#if SIZEOF_VOID_P == 4
#define W_ bits32
Simon Marlow's avatar
Simon Marlow committed
94
95
/* Maybe it's better to include MachDeps.h */
#define TAG_BITS                2
96
97
#elif SIZEOF_VOID_P == 8
#define W_ bits64
Simon Marlow's avatar
Simon Marlow committed
98
99
/* Maybe it's better to include MachDeps.h */
#define TAG_BITS                3
100
101
102
103
#else
#error Unknown word size
#endif

Simon Marlow's avatar
Simon Marlow committed
104
/*
Simon Marlow's avatar
Simon Marlow committed
105
106
 * 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
107
108
109
110
111
 */
#define TAG_MASK ((1 << TAG_BITS) - 1)
#define UNTAG(p) (p & ~TAG_MASK)
#define GETTAG(p) (p & TAG_MASK)

112
113
#if SIZEOF_INT == 4
#define CInt bits32
114
#elif SIZEOF_INT == 8
115
116
117
118
119
120
121
#define CInt bits64
#else
#error Unknown int size
#endif

#if SIZEOF_LONG == 4
#define CLong bits32
122
#elif SIZEOF_LONG == 8
123
124
125
126
127
128
129
130
131
132
133
134
135
136
137
138
139
140
141
142
143
144
145
#define CLong bits64
#else
#error Unknown long size
#endif

#define F_ float32
#define D_ float64
#define L_ bits64

#define SIZEOF_StgDouble 8
#define SIZEOF_StgWord64 8

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

#define NULL (0::W_)

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

Simon Marlow's avatar
Simon Marlow committed
146
147
148
149
150
151
152
153
154
155
156
157
#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

158
159
160
161
162
163
164
165
166
167
168
169
170
171
/* -----------------------------------------------------------------------------
   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
172
#define W_SHIFT 3
173
174
#endif

175
/* Converting quantities of words to bytes */
176
177
#define WDS(n) ((n)*SIZEOF_W)

178
179
180
181
/*
 * Converting quantities of bytes to words
 * NB. these work on *unsigned* values only
 */
182
183
184
#define BYTES_TO_WDS(n) ((n) / SIZEOF_W)
#define ROUNDUP_BYTES_TO_WDS(n) (((n) + SIZEOF_W - 1) / SIZEOF_W)

185
/* TO_W_(n) converts n to W_ type from a smaller type */
186
187
188
189
190
191
192
193
#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

194
195
196
197
198
199
#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

200
201
202
203
204
205
206
207
208
209
210
211
212
213
214
215
216
217
218
/* -----------------------------------------------------------------------------
   Heap/stack access, and adjusting the heap/stack pointers.
   -------------------------------------------------------------------------- */

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

#define Sp_adj(n) Sp = Sp + WDS(n)
#define Hp_adj(n) Hp = Hp + WDS(n)

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

#ifdef DEBUG
#define ASSERT(predicate)			\
	if (predicate) {			\
	    /*null*/;				\
	} else {				\
219
	    foreign "C" _assertFail(NULL, __LINE__); \
220
221
222
223
224
225
226
227
228
229
230
        }
#else
#define ASSERT(p) /* nothing */
#endif

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

231
232
233
234
235
236
237
238
239
/*
 * 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.
 */
240
#ifdef DEBUG
Simon Marlow's avatar
Simon Marlow committed
241
#define IF_DEBUG(c,s)  if (RtsFlags_DebugFlags_##c(RtsFlags) != 0::I32) { s; }
242
243
244
245
246
247
248
249
250
251
252
253
254
#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
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
   -------------------------------------------------------------------------- */

266
267
268
269
270
271
272
273
274
275
276
277
278
279
280
281
282
283
284
285
286
287
288
289
#ifdef PROFILING

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

#define LOAD_INFO \
    info = %INFO_PTR(UNTAG(P1));

#define UNTAG_R1 \
    P1 = UNTAG(P1);

#else

#define LOAD_INFO                               \
  if (GETTAG(P1) != 0) {                        \
      jump %ENTRY_CODE(Sp(0));                  \
  }                                             \
  info = %INFO_PTR(P1);

#define UNTAG_R1 /* nothing */

#endif

290
291
#define ENTER()						\
 again:							\
292
  W_ info;						\
293
  LOAD_INFO                                             \
294
  switch [INVALID_OBJECT .. N_CLOSURE_TYPES]		\
295
296
         (TO_W_( %INFO_TYPE(%STD_INFO(info)) )) {	\
  case							\
297
298
299
300
    IND,						\
    IND_PERM,						\
    IND_STATIC:						\
   {							\
301
      P1 = StgInd_indirectee(P1);			\
302
303
      goto again;					\
   }							\
304
  case							\
305
306
307
308
309
    FUN,						\
    FUN_1_0,						\
    FUN_0_1,						\
    FUN_2_0,						\
    FUN_1_1,						\
310
    FUN_0_2,						\
Simon Marlow's avatar
Simon Marlow committed
311
312
    FUN_STATIC,                                         \
    BCO,						\
313
314
315
316
317
318
    PAP:						\
   {							\
      jump %ENTRY_CODE(Sp(0));				\
   }							\
  default:						\
   {							\
319
      UNTAG_R1                                          \
320
      jump %ENTRY_CODE(info);				\
321
322
323
   }							\
  }

Simon Marlow's avatar
Simon Marlow committed
324
325
326
327
// 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.

328
329
330
331
/* -----------------------------------------------------------------------------
   Constants.
   -------------------------------------------------------------------------- */

Simon Marlow's avatar
Simon Marlow committed
332
#include "rts/Constants.h"
333
#include "DerivedConstants.h"
Simon Marlow's avatar
Simon Marlow committed
334
335
336
337
#include "rts/storage/ClosureTypes.h"
#include "rts/storage/FunTypes.h"
#include "rts/storage/SMPClosureOps.h"
#include "rts/OSThreads.h"
338

339
340
341
342
/*
 * Need MachRegs, because some of the RTS code is conditionally
 * compiled based on REG_R1, REG_R2, etc.
 */
343
#define STOLEN_X86_REGS 4
Simon Marlow's avatar
Simon Marlow committed
344
#include "stg/MachRegs.h"
345

Simon Marlow's avatar
Simon Marlow committed
346
347
#include "rts/storage/Liveness.h"
#include "rts/prof/LDV.h"
348
349
350

#undef BLOCK_SIZE
#undef MBLOCK_SIZE
Simon Marlow's avatar
Simon Marlow committed
351
#include "rts/storage/Block.h"  /* For Bdescr() */
352
353


354
355
#define MyCapability()  (BaseReg - OFFSET_Capability_r)

356
357
358
359
/* -------------------------------------------------------------------------
   Allocation and garbage collection
   ------------------------------------------------------------------------- */

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

374
/* CCS_ALLOC wants the size in words, because ccs->mem_alloc is in words */
375
376
377
378
379
380
#define CCCS_ALLOC(__alloc) CCS_ALLOC(BYTES_TO_WDS(__alloc), W_[CCCS])

#define HP_CHK_GEN_TICKY(alloc,liveness,reentry)	\
   HP_CHK_GEN(alloc,liveness,reentry);			\
   TICK_ALLOC_HEAP_NOCTR(alloc);

381
// allocate() allocates from the nursery, so we check to see
382
// whether the nursery is nearly empty in any function that uses
383
// allocate() - this includes many of the primops.
384
#define MAYBE_GC(liveness,reentry)			\
385
    if (bdescr_link(CurrentNursery) == NULL || \
386
        generation_n_new_large_blocks(W_[g0]) >= CInt[alloc_blocks_lim]) {   \
387
388
	R9  = liveness;					\
        R10 = reentry;					\
Simon Marlow's avatar
Simon Marlow committed
389
        HpAlloc = 0;					\
390
391
392
        jump stg_gc_gen_hp;				\
   }

393
394
395
396
397
398
399
400
401
402
403
404
405
406
407
408
/* -----------------------------------------------------------------------------
   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__)]

409
410
411
412
/* -----------------------------------------------------------------------------
   Closures
   -------------------------------------------------------------------------- */

413
/* The offset of the payload of an array */
414
415
#define BYTE_ARR_CTS(arr)  ((arr) + SIZEOF_StgArrWords)

416
/* Getting/setting the info pointer of a closure */
417
418
419
#define SET_INFO(p,info) StgHeader_info(p) = info
#define GET_INFO(p) StgHeader_info(p)

420
/* Determine the size of an ordinary closure from its info table */
421
422
423
#define sizeW_fromITBL(itbl) \
  SIZEOF_StgHeader + WDS(%INFO_PTRS(itbl)) + WDS(%INFO_NPTRS(itbl))

424
/* NB. duplicated from InfoTables.h! */
425
426
427
#define BITMAP_SIZE(bitmap) ((bitmap) & BITMAP_SIZE_MASK)
#define BITMAP_BITS(bitmap) ((bitmap) >> BITMAP_BITS_SHIFT)

428
/* Debugging macros */
Ian Lynagh's avatar
Ian Lynagh committed
429
430
431
432
433
434
#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) &&     \
435
436
     (TO_W_(%INFO_TYPE(%STD_INFO(p))) <  N_CLOSURE_TYPES))

Simon Marlow's avatar
Simon Marlow committed
437
#define LOOKS_LIKE_CLOSURE_PTR(p) (LOOKS_LIKE_INFO_PTR(GET_INFO(UNTAG(p))))
438

439
440
441
442
443
/*
 * 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:
 */
444
#ifdef TABLES_NEXT_TO_CODE
445
446
447
448
/*
 * when TABLES_NEXT_TO_CODE, slow_apply is stored as an offset
 * instead of the normal pointer.
 */
449
450
        
#define StgFunInfoExtra_slow_apply(fun_info)    \
451
452
        (TO_W_(StgFunInfoExtraRev_slow_apply_offset(fun_info))    \
               + (fun_info) + SIZEOF_StgFunInfoExtraRev + SIZEOF_StgInfoTable)
453

454
455
456
457
458
459
460
461
462
463
#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

464
465
466
#define mutArrPtrsCardWords(n) \
    ROUNDUP_BYTES_TO_WDS(((n) + (1 << MUT_ARR_PTRS_CARD_BITS) - 1) >> MUT_ARR_PTRS_CARD_BITS)

467
468
469
470
471
472
473
474
475
476
477
478
479
480
481
482
483
484
485
486
487
488
489
490
491
492
493
494
495
496
497
498
499
500
501
502
503
504
505
506
507
508
509
510
511
512
513
514
515
516
517
518
519
520
521
522
523
524
525
526
527
528
529
/* -----------------------------------------------------------------------------
   Voluntary Yields/Blocks

   We only have a generic version of this at the moment - if it turns
   out to be slowing us down we can make specialised ones.
   -------------------------------------------------------------------------- */

#define YIELD(liveness,reentry)			\
   R9  = liveness;				\
   R10 = reentry;				\
   jump stg_gen_yield;

#define BLOCK(liveness,reentry)			\
   R9  = liveness;				\
   R10 = reentry;				\
   jump stg_gen_block;

/* -----------------------------------------------------------------------------
   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)
#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_v()  		TICK_BUMP(SLOW_CALL_v_ctr)
#define TICK_SLOW_CALL_p()  		TICK_BUMP(SLOW_CALL_p_ctr)
#define TICK_SLOW_CALL_pv()  		TICK_BUMP(SLOW_CALL_pv_ctr)
#define TICK_SLOW_CALL_pp()  		TICK_BUMP(SLOW_CALL_pp_ctr)
#define TICK_SLOW_CALL_ppp()  		TICK_BUMP(SLOW_CALL_ppp_ctr)
#define TICK_SLOW_CALL_pppp()  		TICK_BUMP(SLOW_CALL_pppp_ctr)
#define TICK_SLOW_CALL_ppppp()  	TICK_BUMP(SLOW_CALL_ppppp_ctr)
#define TICK_SLOW_CALL_pppppp()  	TICK_BUMP(SLOW_CALL_pppppp_ctr)

530
531
532
533
534
535
/* 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 */

536
537
538
539
#define TICK_HISTO_BY(histo,n,i) /* nothing */

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

540
/* An unboxed tuple with n components. */
541
542
543
544
#define TICK_RET_UNBOXED_TUP(n)			\
  TICK_BUMP(RET_UNBOXED_TUP_ctr++);		\
  TICK_HISTO(RET_UNBOXED_TUP,n)

545
546
547
548
/*
 * A slow call with n arguments.  In the unevald case, this call has
 * already been counted once, so don't count it again.
 */
549
550
551
552
#define TICK_SLOW_CALL(n)			\
  TICK_BUMP(SLOW_CALL_ctr);			\
  TICK_HISTO(SLOW_CALL,n)

553
554
555
556
/*
 * This slow call was found to be to an unevaluated function; undo the
 * ticks we did in TICK_SLOW_CALL.
 */
557
558
559
560
561
#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);

562
/* Updating a closure with a new CON */
563
564
565
566
567
568
569
570
#define TICK_UPD_CON_IN_NEW(n)			\
  TICK_BUMP(UPD_CON_IN_NEW_ctr);		\
  TICK_HISTO(UPD_CON_IN_NEW,n)

#define TICK_ALLOC_HEAP_NOCTR(n)		\
    TICK_BUMP(ALLOC_HEAP_ctr);			\
    TICK_BUMP_BY(ALLOC_HEAP_tot,n)

571
572
573
574
/* -----------------------------------------------------------------------------
   Misc junk
   -------------------------------------------------------------------------- */

tharris@microsoft.com's avatar
tharris@microsoft.com committed
575
576
577
#define NO_TREC                   stg_NO_TREC_closure
#define END_TSO_QUEUE             stg_END_TSO_QUEUE_closure
#define END_INVARIANT_CHECK_QUEUE stg_END_INVARIANT_CHECK_QUEUE_closure
578
579
580
581
582
583
584
585

#define recordMutableCap(p, gen, regs)					\
  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;							\
586
      ("ptr" __new_bd) = foreign "C" allocBlock_lock() [regs];		\
587
588
589
590
591
592
593
594
595
      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);

596
#define recordMutable(p, regs)                                  \
597
      P_ __p;                                                   \
598
599
600
601
602
603
      W_ __bd;                                                  \
      W_ __gen;                                                 \
      __p = p;                                                  \
      __bd = Bdescr(__p);                                       \
      __gen = TO_W_(bdescr_gen_no(__bd));                       \
      if (__gen > 0) { recordMutableCap(__p, __gen, regs); }
604

605
#endif /* CMM_H */