mkDerivedConstants.c 32.3 KB
Newer Older
1 2
/* --------------------------------------------------------------------------
 *
3
 * (c) The GHC Team, 1992-2012
4
 *
5 6 7 8 9 10
 * mkDerivedConstants.c
 *
 * Basically this is a C program that extracts information from the C
 * declarations in the header files (primarily struct field offsets)
 * and generates a header file that can be #included into non-C source
 * containing this information.
11 12 13
 *
 * ------------------------------------------------------------------------*/

14
#define IN_STG_CODE 0
15

16 17 18 19
/*
 * We need offsets of profiled things... better be careful that this
 * doesn't affect the offsets of anything else.
 */
20

21
#define PROFILING
22
#define THREADED_RTS
23

Ian Lynagh's avatar
Ian Lynagh committed
24
#include "PosixSource.h"
25
#include "Rts.h"
26
#include "Stable.h"
27
#include "Capability.h"
28

29
#include <inttypes.h>
30
#include <stdio.h>
31 32
#include <string.h>

33
enum Mode { Gen_Haskell_Type, Gen_Haskell_Value, Gen_Haskell_Wrappers, Gen_Haskell_Exports, Gen_Header } mode;
34

35
#define str(a,b) #a "_" #b
36

37
#define OFFSET(s_type, field) ((size_t)&(((s_type*)0)->field))
Ian Lynagh's avatar
Ian Lynagh committed
38
#define FIELD_SIZE(s_type, field) ((size_t)sizeof(((s_type*)0)->field))
39 40 41
#define TYPE_SIZE(type) (sizeof(type))

#pragma GCC poison sizeof
42

43 44
#define def_offset(str, offset)                                             \
    switch (mode) {                                                         \
45 46 47 48
    case Gen_Haskell_Type:                                                  \
        printf("    , pc_OFFSET_" str " :: Int\n");                         \
        break;                                                              \
    case Gen_Haskell_Value:                                                 \
49
        printf("    , pc_OFFSET_" str " = %" PRIdPTR "\n", (intptr_t)offset); \
50
        break;                                                              \
51
    case Gen_Haskell_Wrappers:                                              \
52 53
        printf("oFFSET_" str " :: DynFlags -> Int\n");                      \
        printf("oFFSET_" str " dflags = pc_OFFSET_" str " (sPlatformConstants (settings dflags))\n"); \
54 55
        break;                                                              \
    case Gen_Haskell_Exports:                                               \
56
        printf("    oFFSET_" str ",\n");                                    \
57
        break;                                                              \
58
    case Gen_Header:                                                        \
59
        printf("#define OFFSET_" str " %" PRIdPTR "\n", (intptr_t)offset);  \
60 61 62 63 64
        break;                                                              \
    }

#define ctype(type)                                                         \
    switch (mode) {                                                         \
65 66
    case Gen_Haskell_Type:                                                  \
    case Gen_Haskell_Value:                                                 \
67 68
    case Gen_Haskell_Wrappers:                                              \
    case Gen_Haskell_Exports:                                               \
69 70 71 72 73 74 75
        break;                                                              \
    case Gen_Header:                                                        \
        printf("#define SIZEOF_" #type " %" FMT_SizeT "\n",                 \
               (size_t)TYPE_SIZE(type));                                    \
        break;                                                              \
    }

76 77 78 79 80 81
/* Defining REP_x to be b32 etc
   These are both the C-- types used in a load
      e.g.  b32[addr]
   and the names of the CmmTypes in the compiler
      b32 :: CmmType
*/
82
#define field_type_(want_haskell, str, s_type, field)                       \
83
    switch (mode) {                                                         \
84
    case Gen_Haskell_Type:                                                  \
85 86 87 88
        if (want_haskell) {                                                 \
            printf("    , pc_REP_" str " :: Int\n");                        \
            break;                                                          \
        }                                                                   \
89
    case Gen_Haskell_Value:                                                 \
90 91 92 93
        if (want_haskell) {                                                 \
            printf("    , pc_REP_" str " = %" PRIdPTR "\n", (intptr_t)(FIELD_SIZE(s_type, field))); \
            break;                                                          \
        }                                                                   \
94 95
    case Gen_Haskell_Wrappers:                                              \
    case Gen_Haskell_Exports:                                               \
96 97 98 99 100 101 102 103 104
        break;                                                              \
    case Gen_Header:                                                        \
        printf("#define REP_" str " b");                                    \
        printf("%" FMT_SizeT "\n", FIELD_SIZE(s_type, field) * 8);          \
        break;                                                              \
    }

#define field_type_gcptr_(str, s_type, field)                               \
    switch (mode) {                                                         \
105 106
    case Gen_Haskell_Type:                                                  \
    case Gen_Haskell_Value:                                                 \
107 108
    case Gen_Haskell_Wrappers:                                              \
    case Gen_Haskell_Exports:                                               \
109 110 111 112 113
        break;                                                              \
    case Gen_Header:                                                        \
        printf("#define REP_" str " gcptr\n");                              \
        break;                                                              \
    }
114

115 116
#define field_type(want_haskell, s_type, field) \
    field_type_(want_haskell,str(s_type,field),s_type,field);
117 118 119 120 121 122 123

#define field_offset_(str, s_type, field) \
    def_offset(str, OFFSET(s_type,field));

#define field_offset(s_type, field) \
    field_offset_(str(s_type,field),s_type,field);

124
/* An access macro for use in C-- sources. */
125 126
#define struct_field_macro(str)                                             \
    switch (mode) {                                                         \
127 128
    case Gen_Haskell_Type:                                                  \
    case Gen_Haskell_Value:                                                 \
129 130
    case Gen_Haskell_Wrappers:                                              \
    case Gen_Haskell_Exports:                                               \
131 132 133 134 135
        break;                                                              \
    case Gen_Header:                                                        \
        printf("#define " str "(__ptr__)  REP_" str "[__ptr__+OFFSET_" str "]\n"); \
        break;                                                              \
    }
136

137
/* Outputs the byte offset and MachRep for a field */
138 139 140
#define struct_field_helper(want_haskell, s_type, field)    \
    field_offset(s_type, field);                            \
    field_type(want_haskell, s_type, field);                \
141 142
    struct_field_macro(str(s_type,field))

143 144 145 146 147 148
#define struct_field(s_type, field)         \
    struct_field_helper(0, s_type, field)

#define struct_field_h(s_type, field)       \
    struct_field_helper(1, s_type, field)

149 150
#define struct_field_(str, s_type, field)	\
    field_offset_(str, s_type, field);		\
151
    field_type_(0,str, s_type, field);		\
152 153
    struct_field_macro(str)

154 155
#define def_size(str, size)                                                 \
    switch (mode) {                                                         \
156 157 158 159 160 161
    case Gen_Haskell_Type:                                                  \
        printf("    , pc_SIZEOF_" str " :: Int\n");                         \
        break;                                                              \
    case Gen_Haskell_Value:                                                 \
        printf("    , pc_SIZEOF_" str " = %" FMT_SizeT "\n", (size_t)size); \
        break;                                                              \
162
    case Gen_Haskell_Wrappers:                                              \
163 164
        printf("sIZEOF_" str " :: DynFlags -> Int\n");                      \
        printf("sIZEOF_" str " dflags = pc_SIZEOF_" str " (sPlatformConstants (settings dflags))\n"); \
165 166
        break;                                                              \
    case Gen_Haskell_Exports:                                               \
167
        printf("    sIZEOF_" str ",\n");                                    \
168
        break;                                                              \
169 170 171 172 173 174 175
    case Gen_Header:                                                        \
        printf("#define SIZEOF_" str " %" FMT_SizeT "\n", (size_t)size);    \
        break;                                                              \
    }

#define def_closure_size(str, size)                                         \
    switch (mode) {                                                         \
176 177
    case Gen_Haskell_Type:                                                  \
    case Gen_Haskell_Value:                                                 \
178 179
    case Gen_Haskell_Wrappers:                                              \
    case Gen_Haskell_Exports:                                               \
180 181 182 183 184
        break;                                                              \
    case Gen_Header:                                                        \
        printf("#define SIZEOF_" str " (SIZEOF_StgHeader+%" FMT_SizeT ")\n", (size_t)size); \
        break;                                                              \
    }
185 186

#define struct_size(s_type) \
187
    def_size(#s_type, TYPE_SIZE(s_type));
188

189 190 191 192
/*
 * Size of a closure type, minus the header, named SIZEOF_<type>_NoHdr
 * Also, we #define SIZEOF_<type> to be the size of the whole closure for .cmm.
 */
193
#define closure_size(s_type) \
194 195
    def_size(#s_type "_NoHdr", TYPE_SIZE(s_type) - TYPE_SIZE(StgHeader)); \
    def_closure_size(#s_type, TYPE_SIZE(s_type) - TYPE_SIZE(StgHeader));
196

197
#define thunk_size(s_type) \
198
    def_size(#s_type "_NoThunkHdr", TYPE_SIZE(s_type) - TYPE_SIZE(StgThunkHeader)); \
199
    closure_size(s_type)
200

201
/* An access macro for use in C-- sources. */
202 203
#define closure_field_macro(str)                                            \
    switch (mode) {                                                         \
204 205
    case Gen_Haskell_Type:                                                  \
    case Gen_Haskell_Value:                                                 \
206 207
    case Gen_Haskell_Wrappers:                                              \
    case Gen_Haskell_Exports:                                               \
208 209 210 211 212
        break;                                                              \
    case Gen_Header:                                                        \
        printf("#define " str "(__ptr__)  REP_" str "[__ptr__+SIZEOF_StgHeader+OFFSET_" str "]\n"); \
        break;                                                              \
    }
213 214

#define closure_field_offset_(str, s_type,field) \
215
    def_offset(str, OFFSET(s_type,field) - TYPE_SIZE(StgHeader));
216 217

#define closure_field_offset(s_type,field) \
218 219
    closure_field_offset_(str(s_type,field),s_type,field)

220 221
#define closure_payload_macro(str)                                          \
    switch (mode) {                                                         \
222 223
    case Gen_Haskell_Type:                                                  \
    case Gen_Haskell_Value:                                                 \
224 225
    case Gen_Haskell_Wrappers:                                              \
    case Gen_Haskell_Exports:                                               \
226 227 228 229 230
        break;                                                              \
    case Gen_Header:                                                        \
        printf("#define " str "(__ptr__,__ix__)  W_[__ptr__+SIZEOF_StgHeader+OFFSET_" str " + WDS(__ix__)]\n"); \
        break;                                                              \
    }
231 232 233 234 235

#define closure_payload(s_type,field) \
    closure_field_offset_(str(s_type,field),s_type,field); \
    closure_payload_macro(str(s_type,field));

236
/* Byte offset and MachRep for a closure field, minus the header */
237 238
#define closure_field_(str, s_type, field) \
    closure_field_offset_(str,s_type,field) \
239
    field_type_(0, str, s_type, field); \
240 241
    closure_field_macro(str)

242
#define closure_field(s_type, field) \
243
    closure_field_(str(s_type,field),s_type,field)
244

245
/* Byte offset and MachRep for a closure field, minus the header */
246
#define closure_field_gcptr_(str, s_type, field) \
247
    closure_field_offset_(str,s_type,field) \
248
    field_type_gcptr_(str, s_type, field); \
249 250
    closure_field_macro(str)

251 252 253
#define closure_field_gcptr(s_type, field) \
    closure_field_gcptr_(str(s_type,field),s_type,field)

254 255
/* Byte offset for a TSO field, minus the header and variable prof bit. */
#define tso_payload_offset(s_type, field) \
256
    def_offset(str(s_type,field), OFFSET(s_type,field) - TYPE_SIZE(StgHeader) - TYPE_SIZE(StgTSOProfInfo));
257

258
/* Full byte offset for a TSO field, for use from Cmm */
259 260
#define tso_field_offset_macro(str)                                         \
    switch (mode) {                                                         \
261 262
    case Gen_Haskell_Type:                                                  \
    case Gen_Haskell_Value:                                                 \
263 264
    case Gen_Haskell_Wrappers:                                              \
    case Gen_Haskell_Exports:                                               \
265 266 267 268 269
        break;                                                              \
    case Gen_Header:                                                        \
        printf("#define TSO_OFFSET_" str " (SIZEOF_StgHeader+SIZEOF_OPT_StgTSOProfInfo+OFFSET_" str ")\n"); \
        break;                                                              \
    }
270

271 272 273 274
#define tso_field_offset(s_type, field) \
    tso_payload_offset(s_type, field);  	\
    tso_field_offset_macro(str(s_type,field));

275 276
#define tso_field_macro(str)                                                \
    switch (mode) {                                                         \
277 278
    case Gen_Haskell_Type:                                                  \
    case Gen_Haskell_Value:                                                 \
279 280
    case Gen_Haskell_Wrappers:                                              \
    case Gen_Haskell_Exports:                                               \
281 282 283 284 285
        break;                                                              \
    case Gen_Header:                                                        \
    printf("#define " str "(__ptr__)  REP_" str "[__ptr__+TSO_OFFSET_" str "]\n") \
        break;                                                              \
    }
286

287 288 289
#define tso_field(s_type, field)        \
    field_type(0, s_type, field);       \
    tso_field_offset(s_type,field);     \
290
    tso_field_macro(str(s_type,field))
291
  
292 293
#define opt_struct_size(s_type, option)					                    \
    switch (mode) {                                                         \
294 295
    case Gen_Haskell_Type:                                                  \
    case Gen_Haskell_Value:                                                 \
296 297
    case Gen_Haskell_Wrappers:                                              \
    case Gen_Haskell_Exports:                                               \
298 299 300 301 302 303 304 305 306
        break;                                                              \
    case Gen_Header:                                                        \
        printf("#ifdef " #option "\n");					                    \
        printf("#define SIZEOF_OPT_" #s_type " SIZEOF_" #s_type "\n");	    \
        printf("#else\n");							                        \
        printf("#define SIZEOF_OPT_" #s_type " 0\n");			            \
        printf("#endif\n\n");                                               \
        break;                                                              \
    }
307 308 309

#define FUN_OFFSET(sym) (OFFSET(Capability,f.sym) - OFFSET(Capability,r))

310 311 312 313 314 315 316 317 318 319 320 321 322 323 324 325 326 327 328 329 330
void constantBool(char *haskellName, int val) {
    switch (mode) {
    case Gen_Haskell_Type:
        printf("    , pc_%s :: Bool\n", haskellName);
        break;
    case Gen_Haskell_Value:
        printf("    , pc_%s = %s\n", haskellName, val ? "True" : "False");
        break;
    case Gen_Haskell_Wrappers:
        printf("%s :: DynFlags -> Bool\n", haskellName);
        printf("%s dflags = pc_%s (sPlatformConstants (settings dflags))\n",
               haskellName, haskellName);
        break;
    case Gen_Haskell_Exports:
        printf("    %s,\n", haskellName);
        break;
    case Gen_Header:
        break;
    }
}

331 332
void constantIntegralC(char *haskellType, char *cName, char *haskellName,
                       intptr_t val) {
333 334
    switch (mode) {
    case Gen_Haskell_Type:
335
        printf("    , pc_%s :: %s\n", haskellName, haskellType);
336 337
        break;
    case Gen_Haskell_Value:
338
        printf("    , pc_%s = %" PRIdPTR "\n", haskellName, val);
339 340
        break;
    case Gen_Haskell_Wrappers:
341
        printf("%s :: DynFlags -> %s\n", haskellName, haskellType);
342
        printf("%s dflags = pc_%s (sPlatformConstants (settings dflags))\n",
343
               haskellName, haskellName);
344 345
        break;
    case Gen_Haskell_Exports:
346
        printf("    %s,\n", haskellName);
347 348
        break;
    case Gen_Header:
349 350 351
        if (cName != NULL) {
            printf("#define %s %" PRIdPTR "\n", cName, val);
        }
352 353 354
        break;
    }
}
355

356 357 358 359 360 361 362 363 364 365 366 367 368 369 370 371 372 373
void constantIntC(char *cName, char *haskellName, intptr_t val) {
    /* If the value is larger than 2^28 or smaller than -2^28, then fail.
       This test is a bit conservative, but if any constants are roughly
       maxBoun or minBound then we probably need them to be Integer
       rather than Int so that cross-compiling between 32bit and 64bit
       platforms works. */
    if (val > 268435456) {
        printf("Value too large for constantInt: %" PRIdPTR "\n", val);
        exit(1);
    }
    if (val < -268435456) {
        printf("Value too small for constantInt: %" PRIdPTR "\n", val);
        exit(1);
    }

    constantIntegralC("Int", cName, haskellName, val);
}

374
void constantInt(char *name, intptr_t val) {
375 376 377 378 379
    constantIntC(NULL, name, val);
}

void constantInteger(char *name, intptr_t val) {
    constantIntegralC("Integer", NULL, name, val);
380 381
}

382 383 384
int
main(int argc, char *argv[])
{
385 386 387 388
    if (argc == 1) {
        mode = Gen_Header;
    }
    else if (argc == 2) {
389
        if (0 == strcmp("--gen-haskell-type", argv[1])) {
390 391 392 393 394
            mode = Gen_Haskell_Type;
        }
        else if (0 == strcmp("--gen-haskell-value", argv[1])) {
            mode = Gen_Haskell_Value;
        }
395 396 397 398 399 400
        else if (0 == strcmp("--gen-haskell-wrappers", argv[1])) {
            mode = Gen_Haskell_Wrappers;
        }
        else if (0 == strcmp("--gen-haskell-exports", argv[1])) {
            mode = Gen_Haskell_Exports;
        }
401 402 403 404 405 406 407 408 409 410 411
        else {
            printf("Bad args\n");
            exit(1);
        }
    }
    else {
        printf("Bad args\n");
        exit(1);
    }

    switch (mode) {
412 413 414 415 416 417 418 419 420 421
    case Gen_Haskell_Type:
        printf("data PlatformConstants = PlatformConstants {\n");
        /* Now a kludge that allows the real entries to all start with a
           comma, which makes life a little easier */
        printf("    pc_platformConstants :: ()\n");
        break;
    case Gen_Haskell_Value:
        printf("PlatformConstants {\n");
        printf("    pc_platformConstants = ()\n");
        break;
422 423 424
    case Gen_Haskell_Wrappers:
    case Gen_Haskell_Exports:
        break;
425 426 427 428 429
    case Gen_Header:
        printf("/* This file is created automatically.  Do not edit by hand.*/\n\n");

        break;
    }
430

431 432 433 434 435 436 437 438
    // Closure header sizes.
    constantIntC("STD_HDR_SIZE", "sTD_HDR_SIZE",
                 sizeofW(StgHeader) - sizeofW(StgProfHeader));
    /* grrr.. PROFILING is on so we need to subtract sizeofW(StgProfHeader) */
    constantIntC("PROF_HDR_SIZE", "pROF_HDR_SIZE", sizeofW(StgProfHeader));

    // Size of a storage manager block (in bytes).
    constantIntC("BLOCK_SIZE", "bLOCK_SIZE", BLOCK_SIZE);
439 440 441
    if (mode == Gen_Header) {
        constantIntC("MBLOCK_SIZE", "mBLOCK_SIZE", MBLOCK_SIZE);
    }
442 443 444 445 446
    // blocks that fit in an MBlock, leaving space for the block descriptors
    constantIntC("BLOCKS_PER_MBLOCK", "bLOCKS_PER_MBLOCK", BLOCKS_PER_MBLOCK);
    // could be derived, but better to save doing the calculation twice


447 448 449 450 451 452 453 454 455 456 457 458 459 460 461 462 463 464 465 466 467
    field_offset(StgRegTable, rR1);
    field_offset(StgRegTable, rR2);
    field_offset(StgRegTable, rR3);
    field_offset(StgRegTable, rR4);
    field_offset(StgRegTable, rR5);
    field_offset(StgRegTable, rR6);
    field_offset(StgRegTable, rR7);
    field_offset(StgRegTable, rR8);
    field_offset(StgRegTable, rR9);
    field_offset(StgRegTable, rR10);
    field_offset(StgRegTable, rF1);
    field_offset(StgRegTable, rF2);
    field_offset(StgRegTable, rF3);
    field_offset(StgRegTable, rF4);
    field_offset(StgRegTable, rD1);
    field_offset(StgRegTable, rD2);
    field_offset(StgRegTable, rL1);
    field_offset(StgRegTable, rSp);
    field_offset(StgRegTable, rSpLim);
    field_offset(StgRegTable, rHp);
    field_offset(StgRegTable, rHpLim);
468
    field_offset(StgRegTable, rCCCS);
469 470 471
    field_offset(StgRegTable, rCurrentTSO);
    field_offset(StgRegTable, rCurrentNursery);
    field_offset(StgRegTable, rHpAlloc);
472 473 474 475
    if (mode == Gen_Header) {
        struct_field(StgRegTable, rRet);
        struct_field(StgRegTable, rNursery);
    }
476

477
    def_offset("stgEagerBlackholeInfo", FUN_OFFSET(stgEagerBlackholeInfo));
478 479 480 481
    def_offset("stgGCEnter1", FUN_OFFSET(stgGCEnter1));
    def_offset("stgGCFun", FUN_OFFSET(stgGCFun));

    field_offset(Capability, r);
482 483 484 485 486 487 488 489
    if (mode == Gen_Header) {
        field_offset(Capability, lock);
        struct_field(Capability, no);
        struct_field(Capability, mut_lists);
        struct_field(Capability, context_switch);
        struct_field(Capability, interrupt);
        struct_field(Capability, sparks);
    }
490 491 492 493

    struct_field(bdescr, start);
    struct_field(bdescr, free);
    struct_field(bdescr, blocks);
494 495 496
    if (mode == Gen_Header) {
        struct_field(bdescr, gen_no);
        struct_field(bdescr, link);
497

498 499 500
        struct_size(generation);
        struct_field(generation, n_new_large_words);
    }
501

502
    struct_size(CostCentreStack);
503 504 505
    if (mode == Gen_Header) {
        struct_field(CostCentreStack, ccsID);
    }
506 507
    struct_field_h(CostCentreStack, mem_alloc);
    struct_field_h(CostCentreStack, scc_count);
508 509
    if (mode == Gen_Header) {
        struct_field(CostCentreStack, prevStack);
510

511 512
        struct_field(CostCentre, ccID);
        struct_field(CostCentre, link);
513

514 515
        struct_field(StgHeader, info);
    }
516 517 518
    struct_field_("StgHeader_ccs",  StgHeader, prof.ccs);
    struct_field_("StgHeader_ldvw", StgHeader, prof.hp.ldvw);

519 520
    struct_size(StgSMPThunkHeader);

521 522 523
    if (mode == Gen_Header) {
        closure_payload(StgClosure,payload);
    }
524

525
    struct_field_h(StgEntCounter, allocs);
526 527
    struct_field(StgEntCounter, registeredp);
    struct_field(StgEntCounter, link);
528 529
    struct_field(StgEntCounter, entry_count);

530
    closure_size(StgUpdateFrame);
531 532 533 534
    if (mode == Gen_Header) {
        closure_size(StgCatchFrame);
        closure_size(StgStopFrame);
    }
535 536 537

    closure_size(StgMutArrPtrs);
    closure_field(StgMutArrPtrs, ptrs);
538
    closure_field(StgMutArrPtrs, size);
539 540

    closure_size(StgArrWords);
541 542 543 544 545 546 547 548 549 550 551 552 553 554 555 556 557 558
    if (mode == Gen_Header) {
        closure_field(StgArrWords, bytes);
        closure_payload(StgArrWords, payload);

        closure_field(StgTSO, _link);
        closure_field(StgTSO, global_link);
        closure_field(StgTSO, what_next);
        closure_field(StgTSO, why_blocked);
        closure_field(StgTSO, block_info);
        closure_field(StgTSO, blocked_exceptions);
        closure_field(StgTSO, id);
        closure_field(StgTSO, cap);
        closure_field(StgTSO, saved_errno);
        closure_field(StgTSO, trec);
        closure_field(StgTSO, flags);
        closure_field(StgTSO, dirty);
        closure_field(StgTSO, bq);
    }
559
    closure_field_("StgTSO_cccs", StgTSO, prof.cccs);
560 561 562 563
    closure_field(StgTSO, stackobj);

    closure_field(StgStack, sp);
    closure_field_offset(StgStack, stack);
564
    if (mode == Gen_Header) {
565
    closure_field(StgStack, stack_size);
566
        closure_field(StgStack, dirty);
567

568
        struct_size(StgTSOProfInfo);
569

570 571
        opt_struct_size(StgTSOProfInfo,PROFILING);
    }
572 573 574

    closure_field(StgUpdateFrame, updatee);

575 576 577 578 579 580 581 582 583 584 585 586 587 588 589 590 591 592 593 594 595 596 597 598 599 600 601 602 603 604 605 606 607 608 609 610 611 612 613 614 615 616 617 618 619 620 621 622 623 624 625 626 627 628 629 630 631 632 633 634 635 636 637 638 639 640 641 642 643 644 645 646 647 648 649 650 651 652 653 654 655 656 657 658 659 660 661 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
    if (mode == Gen_Header) {
        closure_field(StgCatchFrame, handler);
        closure_field(StgCatchFrame, exceptions_blocked);

        closure_size(StgPAP);
        closure_field(StgPAP, n_args);
        closure_field_gcptr(StgPAP, fun);
        closure_field(StgPAP, arity);
        closure_payload(StgPAP, payload);

        thunk_size(StgAP);
        closure_field(StgAP, n_args);
        closure_field_gcptr(StgAP, fun);
        closure_payload(StgAP, payload);

        thunk_size(StgAP_STACK);
        closure_field(StgAP_STACK, size);
        closure_field_gcptr(StgAP_STACK, fun);
        closure_payload(StgAP_STACK, payload);

        thunk_size(StgSelector);

        closure_field_gcptr(StgInd, indirectee);

        closure_size(StgMutVar);
        closure_field(StgMutVar, var);

        closure_size(StgAtomicallyFrame);
        closure_field(StgAtomicallyFrame, code);
        closure_field(StgAtomicallyFrame, next_invariant_to_check);
        closure_field(StgAtomicallyFrame, result);

        closure_field(StgInvariantCheckQueue, invariant);
        closure_field(StgInvariantCheckQueue, my_execution);
        closure_field(StgInvariantCheckQueue, next_queue_entry);

        closure_field(StgAtomicInvariant, code);

        closure_field(StgTRecHeader, enclosing_trec);

        closure_size(StgCatchSTMFrame);
        closure_field(StgCatchSTMFrame, handler);
        closure_field(StgCatchSTMFrame, code);

        closure_size(StgCatchRetryFrame);
        closure_field(StgCatchRetryFrame, running_alt_code);
        closure_field(StgCatchRetryFrame, first_code);
        closure_field(StgCatchRetryFrame, alt_code);

        closure_field(StgTVarWatchQueue, closure);
        closure_field(StgTVarWatchQueue, next_queue_entry);
        closure_field(StgTVarWatchQueue, prev_queue_entry);

        closure_field(StgTVar, current_value);

        closure_size(StgWeak);
        closure_field(StgWeak,link);
        closure_field(StgWeak,key);
        closure_field(StgWeak,value);
        closure_field(StgWeak,finalizer);
        closure_field(StgWeak,cfinalizer);

        closure_size(StgDeadWeak);
        closure_field(StgDeadWeak,link);

        closure_size(StgMVar);
        closure_field(StgMVar,head);
        closure_field(StgMVar,tail);
        closure_field(StgMVar,value);

        closure_size(StgMVarTSOQueue);
        closure_field(StgMVarTSOQueue, link);
        closure_field(StgMVarTSOQueue, tso);

        closure_size(StgBCO);
        closure_field(StgBCO, instrs);
        closure_field(StgBCO, literals);
        closure_field(StgBCO, ptrs);
        closure_field(StgBCO, arity);
        closure_field(StgBCO, size);
        closure_payload(StgBCO, bitmap);

        closure_size(StgStableName);
        closure_field(StgStableName,sn);

        closure_size(StgBlockingQueue);
        closure_field(StgBlockingQueue, bh);
        closure_field(StgBlockingQueue, owner);
        closure_field(StgBlockingQueue, queue);
        closure_field(StgBlockingQueue, link);

        closure_size(MessageBlackHole);
        closure_field(MessageBlackHole, link);
        closure_field(MessageBlackHole, tso);
        closure_field(MessageBlackHole, bh);

        struct_field_("RtsFlags_ProfFlags_showCCSOnException",
		      RTS_FLAGS, ProfFlags.showCCSOnException);
        struct_field_("RtsFlags_DebugFlags_apply",
		      RTS_FLAGS, DebugFlags.apply);
        struct_field_("RtsFlags_DebugFlags_sanity",
		      RTS_FLAGS, DebugFlags.sanity);
        struct_field_("RtsFlags_DebugFlags_weak",
		      RTS_FLAGS, DebugFlags.weak);
        struct_field_("RtsFlags_GcFlags_initialStkSize",
		      RTS_FLAGS, GcFlags.initialStkSize);
        struct_field_("RtsFlags_MiscFlags_tickInterval",
		      RTS_FLAGS, MiscFlags.tickInterval);

        struct_size(StgFunInfoExtraFwd);
        struct_field(StgFunInfoExtraFwd, slow_apply);
        struct_field(StgFunInfoExtraFwd, fun_type);
        struct_field(StgFunInfoExtraFwd, arity);
        struct_field_("StgFunInfoExtraFwd_bitmap", StgFunInfoExtraFwd, b.bitmap);
    }
690 691

    struct_size(StgFunInfoExtraRev);
692 693 694 695 696
    if (mode == Gen_Header) {
        struct_field(StgFunInfoExtraRev, slow_apply_offset);
        struct_field(StgFunInfoExtraRev, fun_type);
        struct_field(StgFunInfoExtraRev, arity);
        struct_field_("StgFunInfoExtraRev_bitmap", StgFunInfoExtraRev, b.bitmap);
697

698 699
        struct_field(StgLargeBitmap, size);
        field_offset(StgLargeBitmap, bitmap);
700

701 702 703 704
        struct_size(snEntry);
        struct_field(snEntry,sn_obj);
        struct_field(snEntry,addr);
    }
705

706
#ifdef mingw32_HOST_OS
707 708 709 710 711 712 713 714 715
    /* Note that this conditional part only affects the C headers.
       That's important, as it means we get the same PlatformConstants
       type on all platforms. */
    if (mode == Gen_Header) {
        struct_size(StgAsyncIOResult);
        struct_field(StgAsyncIOResult, reqID);
        struct_field(StgAsyncIOResult, len);
        struct_field(StgAsyncIOResult, errCode);
    }
716 717
#endif

718 719 720 721
    // pre-compiled thunk types
    constantInt("mAX_SPEC_SELECTEE_SIZE", MAX_SPEC_SELECTEE_SIZE);
    constantInt("mAX_SPEC_AP_SIZE", MAX_SPEC_AP_SIZE);

722 723 724 725 726 727 728 729 730 731 732 733
    // closure sizes: these do NOT include the header (see below for
    // header sizes)
    constantInt("mIN_PAYLOAD_SIZE", MIN_PAYLOAD_SIZE);

    constantInt("mIN_INTLIKE", MIN_INTLIKE);
    constantInt("mAX_INTLIKE", MAX_INTLIKE);

    constantInt("mIN_CHARLIKE", MIN_CHARLIKE);
    constantInt("mAX_CHARLIKE", MAX_CHARLIKE);

    constantInt("mUT_ARR_PTRS_CARD_BITS", MUT_ARR_PTRS_CARD_BITS);

734 735 736 737 738 739 740 741
    // A section of code-generator-related MAGIC CONSTANTS.
    constantInt("mAX_Vanilla_REG",      MAX_VANILLA_REG);
    constantInt("mAX_Float_REG",        MAX_FLOAT_REG);
    constantInt("mAX_Double_REG",       MAX_DOUBLE_REG);
    constantInt("mAX_Long_REG",         MAX_LONG_REG);
    constantInt("mAX_Real_Vanilla_REG", MAX_REAL_VANILLA_REG);
    constantInt("mAX_Real_Float_REG",   MAX_REAL_FLOAT_REG);
    constantInt("mAX_Real_Double_REG",  MAX_REAL_DOUBLE_REG);
742
    constantInt("mAX_Real_Long_REG",    MAX_REAL_LONG_REG);
743

744 745 746 747 748 749 750 751 752 753
    // This tells the native code generator the size of the spill
    // area is has available.
    constantInt("rESERVED_C_STACK_BYTES", RESERVED_C_STACK_BYTES);
    // The amount of (Haskell) stack to leave free for saving registers when
    // returning to the scheduler.
    constantInt("rESERVED_STACK_WORDS", RESERVED_STACK_WORDS);
    // Continuations that need more than this amount of stack should do their
    // own stack check (see bug #1466).
    constantInt("aP_STACK_SPLIM", AP_STACK_SPLIM);

754 755 756
    // Size of a word, in bytes
    constantInt("wORD_SIZE", SIZEOF_HSWORD);

757 758 759 760 761 762 763 764 765 766 767
    // Size of a double in StgWords.
    constantInt("dOUBLE_SIZE", SIZEOF_DOUBLE);

    // Size of a C int, in bytes. May be smaller than wORD_SIZE.
    constantInt("cINT_SIZE", SIZEOF_INT);
    constantInt("cLONG_SIZE", SIZEOF_LONG);
    constantInt("cLONG_LONG_SIZE", SIZEOF_LONG_LONG);

    // Number of bits to shift a bitfield left by in an info table.
    constantInt("bITMAP_BITS_SHIFT", BITMAP_BITS_SHIFT);

768 769 770
    // Amount of pointer bits used for semi-tagging constructor closures
    constantInt("tAG_BITS", TAG_BITS);

771 772 773 774 775 776 777 778
    constantBool("wORDS_BIGENDIAN",
#ifdef WORDS_BIGENDIAN
                                    1
#else
                                    0
#endif
                                         );

779 780 781 782 783 784 785 786
    constantBool("dYNAMIC_BY_DEFAULT",
#ifdef DYNAMIC_BY_DEFAULT
                                       1
#else
                                       0
#endif
                                         );

787 788 789 790 791
    constantInt("lDV_SHIFT", LDV_SHIFT);
    constantInteger("iLDV_CREATE_MASK",  LDV_CREATE_MASK);
    constantInteger("iLDV_STATE_CREATE", LDV_STATE_CREATE);
    constantInteger("iLDV_STATE_USE",    LDV_STATE_USE);

792 793
    switch (mode) {
    case Gen_Haskell_Type:
794
        printf("  } deriving Read\n");
795 796 797 798
        break;
    case Gen_Haskell_Value:
        printf("  }\n");
        break;
799 800
    case Gen_Haskell_Wrappers:
    case Gen_Haskell_Exports:
801 802 803 804
    case Gen_Header:
        break;
    }

805 806
    return 0;
}