← Back to branch summary

~ubuntu-branches/ubuntu/precise/ghc/precise

« back to all changes in this revision

Viewing changes to includes/Cmm.h

  • Committer: Bazaar Package Importer
  • Author(s): Joachim Breitner
  • Date: 2011-01-17 12:49:24 UTC
  • Revision ID: james.westby@ubuntu.com-20110117124924-do1pym1jlf5o636m
Tags: upstream-7.0.1
Import upstream version 7.0.1

Show diffs side-by-side

added added

removed removed

Lines of Context:
includes/Cmm.h
 
1
/* -----------------------------------------------------------------------------
 
2
 *
 
3
 * (c) The University of Glasgow 2004
 
4
 *
 
5
 * This file is included at the top of all .cmm source files (and
 
6
 * *only* .cmm files).  It defines a collection of useful macros for
 
7
 * making .cmm code a bit less error-prone to write, and a bit easier
 
8
 * on the eye for the reader.
 
9
 *
 
10
 * For the syntax of .cmm files, see the parser in ghc/compiler/cmm/CmmParse.y.
 
11
 *
 
12
 * If you're used to the old HC file syntax, here's a quick cheat sheet
 
13
 * for converting HC code:
 
14
 *
 
15
 *       - Remove FB_/FE_
 
16
 *       - Remove all type casts
 
17
 *       - Remove '&'
 
18
 *       - STGFUN(foo) { ... }  ==>  foo { ... }
 
19
 *       - FN_(foo) { ... }  ==>  foo { ... }
 
20
 *       - JMP_(e)  ==> jump e;
 
21
 *       - Remove EXTFUN(foo)
 
22
 *       - Sp[n]  ==>  Sp(n)
 
23
 *       - Hp[n]  ==>  Hp(n)
 
24
 *       - Sp += n  ==> Sp_adj(n)
 
25
 *       - Hp += n  ==> Hp_adj(n)
 
26
 *       - R1.i   ==>  R1   (similarly for R1.w, R1.cl etc.)
 
27
 *       - You need to explicitly dereference variables; eg. 
 
28
 *             alloc_blocks   ==>  CInt[alloc_blocks]
 
29
 *       - convert all word offsets into byte offsets:
 
30
 *              - e ==> WDS(e)
 
31
 *       - sizeofW(StgFoo)  ==>  SIZEOF_StgFoo
 
32
 *       - ENTRY_CODE(e)  ==>  %ENTRY_CODE(e)
 
33
 *       - get_itbl(c)  ==>  %GET_STD_INFO(c)
 
34
 *       - Change liveness masks in STK_CHK_GEN, HP_CHK_GEN:
 
35
 *              R1_PTR | R2_PTR  ==>  R1_PTR & R2_PTR
 
36
 *              (NOTE: | becomes &)
 
37
 *       - Declarations like 'StgPtr p;' become just 'W_ p;'
 
38
 *       - e->payload[n] ==> PAYLOAD(e,n)
 
39
 *       - Be very careful with comparisons: the infix versions (>, >=, etc.)
 
40
 *         are unsigned, so use %lt(a,b) to get signed less-than for example.
 
41
 *
 
42
 * Accessing fields of structures defined in the RTS header files is
 
43
 * done via automatically-generated macros in DerivedConstants.h.  For
 
44
 * example, where previously we used
 
45
 *
 
46
 *          CurrentTSO->what_next = x
 
47
 *
 
48
 * in C-- we now use
 
49
 *
 
50
 *          StgTSO_what_next(CurrentTSO) = x
 
51
 *
 
52
 * where the StgTSO_what_next() macro is automatically generated by
 
53
 * mkDerivedConstnants.c.  If you need to access a field that doesn't
 
54
 * already have a macro, edit that file (it's pretty self-explanatory).
 
55
 *
 
56
 * -------------------------------------------------------------------------- */
 
57
 
 
58
#ifndef CMM_H
 
59
#define CMM_H
 
60
 
 
61
/*
 
62
 * In files that are included into both C and C-- (and perhaps
 
63
 * Haskell) sources, we sometimes need to conditionally compile bits
 
64
 * depending on the language.  CMINUSMINUS==1 in .cmm sources:
 
65
 */
 
66
#define CMINUSMINUS 1
 
67
 
 
68
#include "ghcconfig.h"
 
69
 
 
70
/* -----------------------------------------------------------------------------
 
71
   Types 
 
72
 
 
73
   The following synonyms for C-- types are declared here:
 
74
 
 
75
     I8, I16, I32, I64    MachRep-style names for convenience
 
76
 
 
77
     W_                   is shorthand for the word type (== StgWord)
 
78
     F_                   shorthand for float  (F_ == StgFloat == C's float)
 
79
     D_                   shorthand for double (D_ == StgDouble == C's double)
 
80
 
 
81
     CInt                 has the same size as an int in C on this platform
 
82
     CLong                has the same size as a long in C on this platform
 
83
   
 
84
  --------------------------------------------------------------------------- */
 
85
 
 
86
#define I8  bits8
 
87
#define I16 bits16
 
88
#define I32 bits32
 
89
#define I64 bits64
 
90
#define P_  gcptr
 
91
 
 
92
#if SIZEOF_VOID_P == 4
 
93
#define W_ bits32
 
94
/* Maybe it's better to include MachDeps.h */
 
95
#define TAG_BITS                2
 
96
#elif SIZEOF_VOID_P == 8
 
97
#define W_ bits64
 
98
/* Maybe it's better to include MachDeps.h */
 
99
#define TAG_BITS                3
 
100
#else
 
101
#error Unknown word size
 
102
#endif
 
103
 
 
104
/*
 
105
 * The RTS must sometimes UNTAG a pointer before dereferencing it.
 
106
 * See the wiki page Commentary/Rts/HaskellExecution/PointerTagging 
 
107
 */
 
108
#define TAG_MASK ((1 << TAG_BITS) - 1)
 
109
#define UNTAG(p) (p & ~TAG_MASK)
 
110
#define GETTAG(p) (p & TAG_MASK)
 
111
 
 
112
#if SIZEOF_INT == 4
 
113
#define CInt bits32
 
114
#elif SIZEOF_INT == 8
 
115
#define CInt bits64
 
116
#else
 
117
#error Unknown int size
 
118
#endif
 
119
 
 
120
#if SIZEOF_LONG == 4
 
121
#define CLong bits32
 
122
#elif SIZEOF_LONG == 8
 
123
#define CLong bits64
 
124
#else
 
125
#error Unknown long size
 
126
#endif
 
127
 
 
128
#define F_ float32
 
129
#define D_ float64
 
130
#define L_ bits64
 
131
 
 
132
#define SIZEOF_StgDouble 8
 
133
#define SIZEOF_StgWord64 8
 
134
 
 
135
/* -----------------------------------------------------------------------------
 
136
   Misc useful stuff
 
137
   -------------------------------------------------------------------------- */
 
138
 
 
139
#define NULL (0::W_)
 
140
 
 
141
#define STRING(name,str)                        \
 
142
  section "rodata" {                            \
 
143
        name : bits8[] str;                     \
 
144
  }                                             \
 
145
 
 
146
#ifdef TABLES_NEXT_TO_CODE
 
147
#define RET_LBL(f) f##_info
 
148
#else
 
149
#define RET_LBL(f) f##_ret
 
150
#endif
 
151
 
 
152
#ifdef TABLES_NEXT_TO_CODE
 
153
#define ENTRY_LBL(f) f##_info
 
154
#else
 
155
#define ENTRY_LBL(f) f##_entry
 
156
#endif
 
157
 
 
158
/* -----------------------------------------------------------------------------
 
159
   Byte/word macros
 
160
 
 
161
   Everything in C-- is in byte offsets (well, most things).  We use
 
162
   some macros to allow us to express offsets in words and to try to
 
163
   avoid byte/word confusion.
 
164
   -------------------------------------------------------------------------- */
 
165
 
 
166
#define SIZEOF_W  SIZEOF_VOID_P
 
167
#define W_MASK    (SIZEOF_W-1)
 
168
 
 
169
#if SIZEOF_W == 4
 
170
#define W_SHIFT 2
 
171
#elif SIZEOF_W == 8
 
172
#define W_SHIFT 3
 
173
#endif
 
174
 
 
175
/* Converting quantities of words to bytes */
 
176
#define WDS(n) ((n)*SIZEOF_W)
 
177
 
 
178
/*
 
179
 * Converting quantities of bytes to words
 
180
 * NB. these work on *unsigned* values only
 
181
 */
 
182
#define BYTES_TO_WDS(n) ((n) / SIZEOF_W)
 
183
#define ROUNDUP_BYTES_TO_WDS(n) (((n) + SIZEOF_W - 1) / SIZEOF_W)
 
184
 
 
185
/* TO_W_(n) converts n to W_ type from a smaller type */
 
186
#if SIZEOF_W == 4
 
187
#define TO_W_(x) %sx32(x)
 
188
#define HALF_W_(x) %lobits16(x)
 
189
#elif SIZEOF_W == 8
 
190
#define TO_W_(x) %sx64(x)
 
191
#define HALF_W_(x) %lobits32(x)
 
192
#endif
 
193
 
 
194
#if SIZEOF_INT == 4 && SIZEOF_W == 8
 
195
#define W_TO_INT(x) %lobits32(x)
 
196
#elif SIZEOF_INT == SIZEOF_W
 
197
#define W_TO_INT(x) (x)
 
198
#endif
 
199
 
 
200
/* -----------------------------------------------------------------------------
 
201
   Heap/stack access, and adjusting the heap/stack pointers.
 
202
   -------------------------------------------------------------------------- */
 
203
 
 
204
#define Sp(n)  W_[Sp + WDS(n)]
 
205
#define Hp(n)  W_[Hp + WDS(n)]
 
206
 
 
207
#define Sp_adj(n) Sp = Sp + WDS(n)
 
208
#define Hp_adj(n) Hp = Hp + WDS(n)
 
209
 
 
210
/* -----------------------------------------------------------------------------
 
211
   Assertions and Debuggery
 
212
   -------------------------------------------------------------------------- */
 
213
 
 
214
#ifdef DEBUG
 
215
#define ASSERT(predicate)                       \
 
216
        if (predicate) {                        \
 
217
            /*null*/;                           \
 
218
        } else {                                \
 
219
            foreign "C" _assertFail(NULL, __LINE__); \
 
220
        }
 
221
#else
 
222
#define ASSERT(p) /* nothing */
 
223
#endif
 
224
 
 
225
#ifdef DEBUG
 
226
#define DEBUG_ONLY(s) s
 
227
#else
 
228
#define DEBUG_ONLY(s) /* nothing */
 
229
#endif
 
230
 
 
231
/*
 
232
 * The IF_DEBUG macro is useful for debug messages that depend on one
 
233
 * of the RTS debug options.  For example:
 
234
 * 
 
235
 *   IF_DEBUG(RtsFlags_DebugFlags_apply,
 
236
 *      foreign "C" fprintf(stderr, stg_ap_0_ret_str));
 
237
 *
 
238
 * Note the syntax is slightly different to the C version of this macro.
 
239
 */
 
240
#ifdef DEBUG
 
241
#define IF_DEBUG(c,s)  if (RtsFlags_DebugFlags_##c(RtsFlags) != 0::I32) { s; }
 
242
#else
 
243
#define IF_DEBUG(c,s)  /* nothing */
 
244
#endif
 
245
 
 
246
/* -----------------------------------------------------------------------------
 
247
   Entering 
 
248
 
 
249
   It isn't safe to "enter" every closure.  Functions in particular
 
250
   have no entry code as such; their entry point contains the code to
 
251
   apply the function.
 
252
 
 
253
   ToDo: range should end in N_CLOSURE_TYPES-1, not N_CLOSURE_TYPES,
 
254
   but switch doesn't allow us to use exprs there yet.
 
255
 
 
256
   If R1 points to a tagged object it points either to
 
257
   * A constructor.
 
258
   * A function with arity <= TAG_MASK.
 
259
   In both cases the right thing to do is to return.
 
260
   Note: it is rather lucky that we can use the tag bits to do this
 
261
         for both objects. Maybe it points to a brittle design?
 
262
 
 
263
   Indirections can contain tagged pointers, so their tag is checked.
 
264
   -------------------------------------------------------------------------- */
 
265
 
 
266
#ifdef PROFILING
 
267
 
 
268
// When profiling, we cannot shortcut ENTER() by checking the tag,
 
269
// because LDV profiling relies on entering closures to mark them as
 
270
// "used".
 
271
 
 
272
#define LOAD_INFO \
 
273
    info = %INFO_PTR(UNTAG(P1));
 
274
 
 
275
#define UNTAG_R1 \
 
276
    P1 = UNTAG(P1);
 
277
 
 
278
#else
 
279
 
 
280
#define LOAD_INFO                               \
 
281
  if (GETTAG(P1) != 0) {                        \
 
282
      jump %ENTRY_CODE(Sp(0));                  \
 
283
  }                                             \
 
284
  info = %INFO_PTR(P1);
 
285
 
 
286
#define UNTAG_R1 /* nothing */
 
287
 
 
288
#endif
 
289
 
 
290
#define ENTER()                                         \
 
291
 again:                                                 \
 
292
  W_ info;                                              \
 
293
  LOAD_INFO                                             \
 
294
  switch [INVALID_OBJECT .. N_CLOSURE_TYPES]            \
 
295
         (TO_W_( %INFO_TYPE(%STD_INFO(info)) )) {       \
 
296
  case                                                  \
 
297
    IND,                                                \
 
298
    IND_PERM,                                           \
 
299
    IND_STATIC:                                         \
 
300
   {                                                    \
 
301
      P1 = StgInd_indirectee(P1);                       \
 
302
      goto again;                                       \
 
303
   }                                                    \
 
304
  case                                                  \
 
305
    FUN,                                                \
 
306
    FUN_1_0,                                            \
 
307
    FUN_0_1,                                            \
 
308
    FUN_2_0,                                            \
 
309
    FUN_1_1,                                            \
 
310
    FUN_0_2,                                            \
 
311
    FUN_STATIC,                                         \
 
312
    BCO,                                                \
 
313
    PAP:                                                \
 
314
   {                                                    \
 
315
      jump %ENTRY_CODE(Sp(0));                          \
 
316
   }                                                    \
 
317
  default:                                              \
 
318
   {                                                    \
 
319
      UNTAG_R1                                          \
 
320
      jump %ENTRY_CODE(info);                           \
 
321
   }                                                    \
 
322
  }
 
323
 
 
324
// The FUN cases almost never happen: a pointer to a non-static FUN
 
325
// should always be tagged.  This unfortunately isn't true for the
 
326
// interpreter right now, which leaves untagged FUNs on the stack.
 
327
 
 
328
/* -----------------------------------------------------------------------------
 
329
   Constants.
 
330
   -------------------------------------------------------------------------- */
 
331
 
 
332
#include "rts/Constants.h"
 
333
#include "DerivedConstants.h"
 
334
#include "rts/storage/ClosureTypes.h"
 
335
#include "rts/storage/FunTypes.h"
 
336
#include "rts/storage/SMPClosureOps.h"
 
337
#include "rts/OSThreads.h"
 
338
 
 
339
/*
 
340
 * Need MachRegs, because some of the RTS code is conditionally
 
341
 * compiled based on REG_R1, REG_R2, etc.
 
342
 */
 
343
#define STOLEN_X86_REGS 4
 
344
#include "stg/MachRegs.h"
 
345
 
 
346
#include "rts/storage/Liveness.h"
 
347
#include "rts/prof/LDV.h"
 
348
 
 
349
#undef BLOCK_SIZE
 
350
#undef MBLOCK_SIZE
 
351
#include "rts/storage/Block.h"  /* For Bdescr() */
 
352
 
 
353
 
 
354
#define MyCapability()  (BaseReg - OFFSET_Capability_r)
 
355
 
 
356
/* -------------------------------------------------------------------------
 
357
   Allocation and garbage collection
 
358
   ------------------------------------------------------------------------- */
 
359
 
 
360
/*
 
361
 * ALLOC_PRIM is for allocating memory on the heap for a primitive
 
362
 * object.  It is used all over PrimOps.cmm.
 
363
 *
 
364
 * We make the simplifying assumption that the "admin" part of a
 
365
 * primitive closure is just the header when calculating sizes for
 
366
 * ticky-ticky.  It's not clear whether eg. the size field of an array
 
367
 * should be counted as "admin", or the various fields of a BCO.
 
368
 */
 
369
#define ALLOC_PRIM(bytes,liveness,reentry)                      \
 
370
   HP_CHK_GEN_TICKY(bytes,liveness,reentry);                    \
 
371
   TICK_ALLOC_PRIM(SIZEOF_StgHeader,bytes-SIZEOF_StgHeader,0);  \
 
372
   CCCS_ALLOC(bytes);
 
373
 
 
374
/* CCS_ALLOC wants the size in words, because ccs->mem_alloc is in words */
 
375
#define CCCS_ALLOC(__alloc) CCS_ALLOC(BYTES_TO_WDS(__alloc), W_[CCCS])
 
376
 
 
377
#define HP_CHK_GEN_TICKY(alloc,liveness,reentry)        \
 
378
   HP_CHK_GEN(alloc,liveness,reentry);                  \
 
379
   TICK_ALLOC_HEAP_NOCTR(alloc);
 
380
 
 
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
        R9  = liveness;                                 \
 
388
        R10 = reentry;                                  \
 
389
        HpAlloc = 0;                                    \
 
390
        jump stg_gc_gen_hp;                             \
 
391
   }
 
392
 
 
393
/* -----------------------------------------------------------------------------
 
394
   Closure headers
 
395
   -------------------------------------------------------------------------- */
 
396
 
 
397
/*
 
398
 * This is really ugly, since we don't do the rest of StgHeader this
 
399
 * way.  The problem is that values from DerivedConstants.h cannot be 
 
400
 * dependent on the way (SMP, PROF etc.).  For SIZEOF_StgHeader we get
 
401
 * the value from GHC, but it seems like too much trouble to do that
 
402
 * for StgThunkHeader.
 
403
 */
 
404
#define SIZEOF_StgThunkHeader SIZEOF_StgHeader+SIZEOF_StgSMPThunkHeader
 
405
 
 
406
#define StgThunk_payload(__ptr__,__ix__) \
 
407
    W_[__ptr__+SIZEOF_StgThunkHeader+ WDS(__ix__)]
 
408
 
 
409
/* -----------------------------------------------------------------------------
 
410
   Closures
 
411
   -------------------------------------------------------------------------- */
 
412
 
 
413
/* The offset of the payload of an array */
 
414
#define BYTE_ARR_CTS(arr)  ((arr) + SIZEOF_StgArrWords)
 
415
 
 
416
/* The number of words allocated in an array payload */
 
417
#define BYTE_ARR_WDS(arr) ROUNDUP_BYTES_TO_WDS(StgArrWords_bytes(arr))
 
418
 
 
419
/* Getting/setting the info pointer of a closure */
 
420
#define SET_INFO(p,info) StgHeader_info(p) = info
 
421
#define GET_INFO(p) StgHeader_info(p)
 
422
 
 
423
/* Determine the size of an ordinary closure from its info table */
 
424
#define sizeW_fromITBL(itbl) \
 
425
  SIZEOF_StgHeader + WDS(%INFO_PTRS(itbl)) + WDS(%INFO_NPTRS(itbl))
 
426
 
 
427
/* NB. duplicated from InfoTables.h! */
 
428
#define BITMAP_SIZE(bitmap) ((bitmap) & BITMAP_SIZE_MASK)
 
429
#define BITMAP_BITS(bitmap) ((bitmap) >> BITMAP_BITS_SHIFT)
 
430
 
 
431
/* Debugging macros */
 
432
#define LOOKS_LIKE_INFO_PTR(p)                                  \
 
433
   ((p) != NULL &&                                              \
 
434
    LOOKS_LIKE_INFO_PTR_NOT_NULL(p))
 
435
 
 
436
#define LOOKS_LIKE_INFO_PTR_NOT_NULL(p)                         \
 
437
   ( (TO_W_(%INFO_TYPE(%STD_INFO(p))) != INVALID_OBJECT) &&     \
 
438
     (TO_W_(%INFO_TYPE(%STD_INFO(p))) <  N_CLOSURE_TYPES))
 
439
 
 
440
#define LOOKS_LIKE_CLOSURE_PTR(p) (LOOKS_LIKE_INFO_PTR(GET_INFO(UNTAG(p))))
 
441
 
 
442
/*
 
443
 * The layout of the StgFunInfoExtra part of an info table changes
 
444
 * depending on TABLES_NEXT_TO_CODE.  So we define field access
 
445
 * macros which use the appropriate version here:
 
446
 */
 
447
#ifdef TABLES_NEXT_TO_CODE
 
448
/*
 
449
 * when TABLES_NEXT_TO_CODE, slow_apply is stored as an offset
 
450
 * instead of the normal pointer.
 
451
 */
 
452
        
 
453
#define StgFunInfoExtra_slow_apply(fun_info)    \
 
454
        (TO_W_(StgFunInfoExtraRev_slow_apply_offset(fun_info))    \
 
455
               + (fun_info) + SIZEOF_StgFunInfoExtraRev + SIZEOF_StgInfoTable)
 
456
 
 
457
#define StgFunInfoExtra_fun_type(i)   StgFunInfoExtraRev_fun_type(i)
 
458
#define StgFunInfoExtra_arity(i)      StgFunInfoExtraRev_arity(i)
 
459
#define StgFunInfoExtra_bitmap(i)     StgFunInfoExtraRev_bitmap(i)
 
460
#else
 
461
#define StgFunInfoExtra_slow_apply(i) StgFunInfoExtraFwd_slow_apply(i)
 
462
#define StgFunInfoExtra_fun_type(i)   StgFunInfoExtraFwd_fun_type(i)
 
463
#define StgFunInfoExtra_arity(i)      StgFunInfoExtraFwd_arity(i)
 
464
#define StgFunInfoExtra_bitmap(i)     StgFunInfoExtraFwd_bitmap(i)
 
465
#endif
 
466
 
 
467
#define mutArrPtrsCardWords(n) \
 
468
    ROUNDUP_BYTES_TO_WDS(((n) + (1 << MUT_ARR_PTRS_CARD_BITS) - 1) >> MUT_ARR_PTRS_CARD_BITS)
 
469
 
 
470
/* -----------------------------------------------------------------------------
 
471
   Voluntary Yields/Blocks
 
472
 
 
473
   We only have a generic version of this at the moment - if it turns
 
474
   out to be slowing us down we can make specialised ones.
 
475
   -------------------------------------------------------------------------- */
 
476
 
 
477
#define YIELD(liveness,reentry)                 \
 
478
   R9  = liveness;                              \
 
479
   R10 = reentry;                               \
 
480
   jump stg_gen_yield;
 
481
 
 
482
#define BLOCK(liveness,reentry)                 \
 
483
   R9  = liveness;                              \
 
484
   R10 = reentry;                               \
 
485
   jump stg_gen_block;
 
486
 
 
487
/* -----------------------------------------------------------------------------
 
488
   Ticky macros 
 
489
   -------------------------------------------------------------------------- */
 
490
 
 
491
#ifdef TICKY_TICKY
 
492
#define TICK_BUMP_BY(ctr,n) CLong[ctr] = CLong[ctr] + n
 
493
#else
 
494
#define TICK_BUMP_BY(ctr,n) /* nothing */
 
495
#endif
 
496
 
 
497
#define TICK_BUMP(ctr)      TICK_BUMP_BY(ctr,1)
 
498
 
 
499
#define TICK_ENT_DYN_IND()              TICK_BUMP(ENT_DYN_IND_ctr)
 
500
#define TICK_ENT_DYN_THK()              TICK_BUMP(ENT_DYN_THK_ctr)
 
501
#define TICK_ENT_VIA_NODE()             TICK_BUMP(ENT_VIA_NODE_ctr)
 
502
#define TICK_ENT_STATIC_IND()           TICK_BUMP(ENT_STATIC_IND_ctr)
 
503
#define TICK_ENT_PERM_IND()             TICK_BUMP(ENT_PERM_IND_ctr)
 
504
#define TICK_ENT_PAP()                  TICK_BUMP(ENT_PAP_ctr)
 
505
#define TICK_ENT_AP()                   TICK_BUMP(ENT_AP_ctr)
 
506
#define TICK_ENT_AP_STACK()             TICK_BUMP(ENT_AP_STACK_ctr)
 
507
#define TICK_ENT_BH()                   TICK_BUMP(ENT_BH_ctr)
 
508
#define TICK_UNKNOWN_CALL()             TICK_BUMP(UNKNOWN_CALL_ctr)
 
509
#define TICK_UPDF_PUSHED()              TICK_BUMP(UPDF_PUSHED_ctr)
 
510
#define TICK_CATCHF_PUSHED()            TICK_BUMP(CATCHF_PUSHED_ctr)
 
511
#define TICK_UPDF_OMITTED()             TICK_BUMP(UPDF_OMITTED_ctr)
 
512
#define TICK_UPD_NEW_IND()              TICK_BUMP(UPD_NEW_IND_ctr)
 
513
#define TICK_UPD_NEW_PERM_IND()         TICK_BUMP(UPD_NEW_PERM_IND_ctr)
 
514
#define TICK_UPD_OLD_IND()              TICK_BUMP(UPD_OLD_IND_ctr)
 
515
#define TICK_UPD_OLD_PERM_IND()         TICK_BUMP(UPD_OLD_PERM_IND_ctr)
 
516
  
 
517
#define TICK_SLOW_CALL_FUN_TOO_FEW()    TICK_BUMP(SLOW_CALL_FUN_TOO_FEW_ctr)
 
518
#define TICK_SLOW_CALL_FUN_CORRECT()    TICK_BUMP(SLOW_CALL_FUN_CORRECT_ctr)
 
519
#define TICK_SLOW_CALL_FUN_TOO_MANY()   TICK_BUMP(SLOW_CALL_FUN_TOO_MANY_ctr)
 
520
#define TICK_SLOW_CALL_PAP_TOO_FEW()    TICK_BUMP(SLOW_CALL_PAP_TOO_FEW_ctr)
 
521
#define TICK_SLOW_CALL_PAP_CORRECT()    TICK_BUMP(SLOW_CALL_PAP_CORRECT_ctr)
 
522
#define TICK_SLOW_CALL_PAP_TOO_MANY()   TICK_BUMP(SLOW_CALL_PAP_TOO_MANY_ctr)
 
523
 
 
524
#define TICK_SLOW_CALL_v()              TICK_BUMP(SLOW_CALL_v_ctr)
 
525
#define TICK_SLOW_CALL_p()              TICK_BUMP(SLOW_CALL_p_ctr)
 
526
#define TICK_SLOW_CALL_pv()             TICK_BUMP(SLOW_CALL_pv_ctr)
 
527
#define TICK_SLOW_CALL_pp()             TICK_BUMP(SLOW_CALL_pp_ctr)
 
528
#define TICK_SLOW_CALL_ppp()            TICK_BUMP(SLOW_CALL_ppp_ctr)
 
529
#define TICK_SLOW_CALL_pppp()           TICK_BUMP(SLOW_CALL_pppp_ctr)
 
530
#define TICK_SLOW_CALL_ppppp()          TICK_BUMP(SLOW_CALL_ppppp_ctr)
 
531
#define TICK_SLOW_CALL_pppppp()         TICK_BUMP(SLOW_CALL_pppppp_ctr)
 
532
 
 
533
/* NOTE: TICK_HISTO_BY and TICK_HISTO 
 
534
   currently have no effect.
 
535
   The old code for it didn't typecheck and I 
 
536
   just commented it out to get ticky to work.
 
537
   - krc 1/2007 */
 
538
 
 
539
#define TICK_HISTO_BY(histo,n,i) /* nothing */
 
540
 
 
541
#define TICK_HISTO(histo,n) TICK_HISTO_BY(histo,n,1)
 
542
 
 
543
/* An unboxed tuple with n components. */
 
544
#define TICK_RET_UNBOXED_TUP(n)                 \
 
545
  TICK_BUMP(RET_UNBOXED_TUP_ctr++);             \
 
546
  TICK_HISTO(RET_UNBOXED_TUP,n)
 
547
 
 
548
/*
 
549
 * A slow call with n arguments.  In the unevald case, this call has
 
550
 * already been counted once, so don't count it again.
 
551
 */
 
552
#define TICK_SLOW_CALL(n)                       \
 
553
  TICK_BUMP(SLOW_CALL_ctr);                     \
 
554
  TICK_HISTO(SLOW_CALL,n)
 
555
 
 
556
/*
 
557
 * This slow call was found to be to an unevaluated function; undo the
 
558
 * ticks we did in TICK_SLOW_CALL.
 
559
 */
 
560
#define TICK_SLOW_CALL_UNEVALD(n)               \
 
561
  TICK_BUMP(SLOW_CALL_UNEVALD_ctr);             \
 
562
  TICK_BUMP_BY(SLOW_CALL_ctr,-1);               \
 
563
  TICK_HISTO_BY(SLOW_CALL,n,-1);
 
564
 
 
565
/* Updating a closure with a new CON */
 
566
#define TICK_UPD_CON_IN_NEW(n)                  \
 
567
  TICK_BUMP(UPD_CON_IN_NEW_ctr);                \
 
568
  TICK_HISTO(UPD_CON_IN_NEW,n)
 
569
 
 
570
#define TICK_ALLOC_HEAP_NOCTR(n)                \
 
571
    TICK_BUMP(ALLOC_HEAP_ctr);                  \
 
572
    TICK_BUMP_BY(ALLOC_HEAP_tot,n)
 
573
 
 
574
/* -----------------------------------------------------------------------------
 
575
   Misc junk
 
576
   -------------------------------------------------------------------------- */
 
577
 
 
578
#define NO_TREC                   stg_NO_TREC_closure
 
579
#define END_TSO_QUEUE             stg_END_TSO_QUEUE_closure
 
580
#define END_INVARIANT_CHECK_QUEUE stg_END_INVARIANT_CHECK_QUEUE_closure
 
581
 
 
582
#define recordMutableCap(p, gen, regs)                                  \
 
583
  W_ __bd;                                                              \
 
584
  W_ mut_list;                                                          \
 
585
  mut_list = Capability_mut_lists(MyCapability()) + WDS(gen);           \
 
586
 __bd = W_[mut_list];                                                   \
 
587
  if (bdescr_free(__bd) >= bdescr_start(__bd) + BLOCK_SIZE) {           \
 
588
      W_ __new_bd;                                                      \
 
589
      ("ptr" __new_bd) = foreign "C" allocBlock_lock() [regs];          \
 
590
      bdescr_link(__new_bd) = __bd;                                     \
 
591
      __bd = __new_bd;                                                  \
 
592
      W_[mut_list] = __bd;                                              \
 
593
  }                                                                     \
 
594
  W_ free;                                                              \
 
595
  free = bdescr_free(__bd);                                             \
 
596
  W_[free] = p;                                                         \
 
597
  bdescr_free(__bd) = free + WDS(1);
 
598
 
 
599
#define recordMutable(p, regs)                                  \
 
600
      P_ __p;                                                   \
 
601
      W_ __bd;                                                  \
 
602
      W_ __gen;                                                 \
 
603
      __p = p;                                                  \
 
604
      __bd = Bdescr(__p);                                       \
 
605
      __gen = TO_W_(bdescr_gen_no(__bd));                       \
 
606
      if (__gen > 0) { recordMutableCap(__p, __gen, regs); }
 
607
 
 
608
#endif /* CMM_H */