ghc/rts/StgMiscClosures.hc

   1 /* -----------------------------------------------------------------------------
   2  * $Id: StgMiscClosures.hc,v 1.48 2000/09/11 11:17:09 sewardj Exp $
   3  *
   4  * (c) The GHC Team, 1998-2000
   5  *
   6  * Entry code for various built-in closure types.
   7  *
   8  * ---------------------------------------------------------------------------*/
   9
  10 #include "Rts.h"
  11 #include "RtsUtils.h"
  12 #include "RtsFlags.h"
  13 #include "StgMiscClosures.h"
  14 #include "HeapStackCheck.h"   /* for stg_gen_yield */
  15 #include "Storage.h"
  16 #include "StoragePriv.h"
  17 #include "Profiling.h"
  18 #include "Prelude.h"
  19 #include "SMP.h"
  20 #if defined(GRAN) || defined(PAR)
  21 # include "GranSimRts.h"      /* for DumpRawGranEvent */
  22 # include "StgRun.h"    /* for StgReturn and register saving */
  23 #endif
  24
  25 #ifdef HAVE_STDIO_H
  26 #include <stdio.h>
  27 #endif
  28
  29 /* ToDo: make the printing of panics more win32-friendly, i.e.,
  30  *       pop up some lovely message boxes (as well).
  31  */
  32 #define DUMP_ERRMSG(msg) STGCALL2(fprintf,stderr,msg)
  33
  34 /*
  35   Template for the entry code of non-enterable closures.
  36 */
  37
  38 #define NON_ENTERABLE_ENTRY_CODE(type)                                  \
  39 STGFUN(type##_entry)                                                    \
  40 {                                                                       \
  41   FB_                                                                   \
  42     DUMP_ERRMSG(#type " object entered!\n");                            \
  43     STGCALL1(shutdownHaskellAndExit, EXIT_FAILURE);                     \
  44     return NULL;                                                        \
  45   FE_                                                                   \
  46 }
  47
  48
  49 /* -----------------------------------------------------------------------------
  50    Support for the metacircular interpreter.
  51    -------------------------------------------------------------------------- */
  52
  53 #ifdef GHCI
  54
  55 /* 9 bits of return code for constructors created by mci_make_constr. */
  56 FN_(mci_constr_entry)
  57 {
  58   /* R1 points at the constructor */
  59   FB_
  60     STGCALL2(fprintf,stderr,"mci_constr_entry (direct return)!\n");
  61     /* Pointless, since SET_TAG doesn't do anything */
  62     SET_TAG( GET_TAG(GET_INFO(R1.cl)));
  63     JMP_(ENTRY_CODE((P_)(*Sp)));
  64   FE_
  65 }
  66
  67 FN_(mci_constr1_entry) { FB_ JMP_(RET_VEC((P_)(*Sp),0)); FE_ }
  68 FN_(mci_constr2_entry) { FB_ JMP_(RET_VEC((P_)(*Sp),1)); FE_ }
  69 FN_(mci_constr3_entry) { FB_ JMP_(RET_VEC((P_)(*Sp),2)); FE_ }
  70 FN_(mci_constr4_entry) { FB_ JMP_(RET_VEC((P_)(*Sp),3)); FE_ }
  71 FN_(mci_constr5_entry) { FB_ JMP_(RET_VEC((P_)(*Sp),4)); FE_ }
  72 FN_(mci_constr6_entry) { FB_ JMP_(RET_VEC((P_)(*Sp),5)); FE_ }
  73 FN_(mci_constr7_entry) { FB_ JMP_(RET_VEC((P_)(*Sp),6)); FE_ }
  74 FN_(mci_constr8_entry) { FB_ JMP_(RET_VEC((P_)(*Sp),7)); FE_ }
  75
  76
  77 /* Since this stuff is ostensibly in some other module, we need
  78    to supply an __init_ function.
  79 */
  80 START_MOD_INIT(__init_MCIzumakezuconstr)
  81 END_MOD_INIT()
  82
  83
  84 INFO_TABLE(mci_make_constr_info,   mci_make_constr_entry,   0,0,FUN_STATIC,,EF_,0,0);
  85 INFO_TABLE(mci_make_constrI_info,  mci_make_constrI_entry,  0,0,FUN_STATIC,,EF_,0,0);
  86 INFO_TABLE(mci_make_constrP_info,  mci_make_constrP_entry,  0,0,FUN_STATIC,,EF_,0,0);
  87 INFO_TABLE(mci_make_constrPP_info, mci_make_constrPP_entry, 0,0,FUN_STATIC,,EF_,0,0);
  88 INFO_TABLE(mci_make_constrPPP_info,mci_make_constrPPP_entry,0,0,FUN_STATIC,,EF_,0,0);
  89
  90 SET_STATIC_HDR(MCIzumakezuconstr_mcizumakezuconstr_closure,
  91                mci_make_constr_info,0,,EI_)
  92    ,{ /* payload */ }
  93 };
  94 SET_STATIC_HDR(MCIzumakezuconstr_mcizumakezuconstrI_closure,
  95                mci_make_constrI_info,0,,EI_)
  96    ,{ /* payload */ }
  97 };
  98 SET_STATIC_HDR(MCIzumakezuconstr_mcizumakezuconstrP_closure,
  99                mci_make_constrP_info,0,,EI_)
 100    ,{ /* payload */ }
 101 };
 102 SET_STATIC_HDR(MCIzumakezuconstr_mcizumakezuconstrPP_closure,
 103                mci_make_constrPP_info,0,,EI_)
 104    ,{ /* payload */ }
 105 };
 106 SET_STATIC_HDR(MCIzumakezuconstr_mcizumakezuconstrPPP_closure,
 107                mci_make_constrPPP_info,0,,EI_)
 108    ,{ /* payload */ }
 109 };
 110
 111
 112 /* Make a constructor with no args. */
 113 STGFUN(mci_make_constr_entry)
 114 {
 115   nat size, np, nw;
 116   StgClosure* con;
 117   StgInfoTable* itbl;
 118   FB_
 119     /* Sp[0 & 1] are tag, Addr#
 120     */
 121     itbl = ((StgInfoTable**)Sp)[1];
 122     np   = INFO_PTR_TO_STRUCT(itbl)->layout.payload.ptrs;
 123     nw   = INFO_PTR_TO_STRUCT(itbl)->layout.payload.nptrs;
 124     size = sizeofW(StgHeader) + stg_max(MIN_NONUPD_SIZE, np+nw);
 125     /* STGCALL5(fprintf,stderr,"np %d  nw %d  size %d\n",np,nw,size); */
 126
 127     /* The total number of words to copy off the stack is np + nw.
 128        That doesn't include tag words, tho.
 129     */
 130     HP_CHK_GEN_TICKY(size, NO_PTRS, mci_make_constr_entry, );
 131     TICK_ALLOC_PRIM(sizeofW(StgHeader), size-sizeofW(StgHeader), 0);
 132     CCS_ALLOC(CCCS,size); /* ccs prof */
 133
 134     con = (StgClosure*)(Hp + 1 - size);
 135     SET_HDR(con, itbl,CCCS);
 136
 137     Sp = Sp +2; /* Zap the Addr# arg */
 138     R1.cl = con;
 139
 140     JMP_(ENTRY_CODE(GET_INFO(R1.cl)));
 141   FE_
 142 }
 143
 144 /* Make a constructor with 1 Int# arg */
 145 STGFUN(mci_make_constrI_entry)
 146 {
 147   nat size, np, nw;
 148   StgClosure* con;
 149   StgInfoTable* itbl;
 150   FB_
 151     /* Sp[0 & 1] are tag, Addr#
 152        Sp[2 & 3] are tag, Int#
 153     */
 154     itbl = ((StgInfoTable**)Sp)[1];
 155     np   = INFO_PTR_TO_STRUCT(itbl)->layout.payload.ptrs;
 156     nw   = INFO_PTR_TO_STRUCT(itbl)->layout.payload.nptrs;
 157     size = sizeofW(StgHeader) + stg_max(MIN_NONUPD_SIZE, np+nw);
 158     /* STGCALL5(fprintf,stderr,"np %d  nw %d  size %d\n",np,nw,size); */
 159
 160     /* The total number of words to copy off the stack is np + nw.
 161        That doesn't include tag words, tho.
 162     */
 163     HP_CHK_GEN_TICKY(size, NO_PTRS, mci_make_constr_entry, );
 164     TICK_ALLOC_PRIM(sizeofW(StgHeader), size-sizeofW(StgHeader), 0);
 165     CCS_ALLOC(CCCS,size); /* ccs prof */
 166
 167     con = (StgClosure*)(Hp + 1 - size);
 168     SET_HDR(con, itbl,CCCS);
 169
 170     con->payload[0] = ((StgClosure**)Sp)[3];
 171     Sp = Sp +1/*word*/ +1/*tag*/;  /* Zap the Int# arg */
 172     Sp = Sp +2; /* Zap the Addr# arg */
 173     R1.cl = con;
 174
 175     JMP_(ENTRY_CODE(GET_INFO(R1.cl)));
 176   FE_
 177 }
 178
 179 STGFUN(mci_make_constrP_entry)
 180 {
 181   FB_
 182   DUMP_ERRMSG("mci_make_constrP_entry: unimplemented!\n");
 183   STGCALL1(shutdownHaskellAndExit, EXIT_FAILURE);
 184   return 0;
 185   FE_
 186 }
 187
 188
 189 /* Make a constructor with 2 pointer args. */
 190 STGFUN(mci_make_constrPP_entry)
 191 {
 192   nat size, np, nw;
 193   StgClosure* con;
 194   StgInfoTable* itbl;
 195   FB_
 196     /* Sp[0 & 1] are tag, Addr#
 197        Sp[2]     first arg
 198        Sp[3]     second arg
 199     */
 200     itbl = ((StgInfoTable**)Sp)[1];
 201     np   = INFO_PTR_TO_STRUCT(itbl)->layout.payload.ptrs;
 202     nw   = INFO_PTR_TO_STRUCT(itbl)->layout.payload.nptrs;
 203     size = sizeofW(StgHeader) + stg_max(MIN_NONUPD_SIZE, np+nw);
 204     /* STGCALL5(fprintf,stderr,"np %d  nw %d  size %d\n",np,nw,size); */
 205
 206     /* The total number of words to copy off the stack is np + nw.
 207        That doesn't include tag words, tho.
 208     */
 209     HP_CHK_GEN_TICKY(size, NO_PTRS, mci_make_constr_entry, );
 210     TICK_ALLOC_PRIM(sizeofW(StgHeader), size-sizeofW(StgHeader), 0);
 211     CCS_ALLOC(CCCS,size); /* ccs prof */
 212
 213     con = (StgClosure*)(Hp + 1 - size);
 214     SET_HDR(con, itbl,CCCS);
 215
 216     con->payload[0] = ((StgClosure**)Sp)[2];
 217     con->payload[1] = ((StgClosure**)Sp)[3];
 218     Sp = Sp +2; /* Zap 2 ptr args */
 219     Sp = Sp +2; /* Zap the Addr# arg */
 220     R1.cl = con;
 221
 222     JMP_(ENTRY_CODE(GET_INFO(R1.cl)));
 223   FE_
 224 }
 225
 226
 227 STGFUN(mci_make_constrPPP_entry)
 228 {
 229   FB_
 230   DUMP_ERRMSG("mci_make_constrPPP_entry: unimplemented!\n");
 231   STGCALL1(shutdownHaskellAndExit, EXIT_FAILURE);
 232   return 0;
 233   FE_
 234 }
 235
 236 #if 0
 237 /* It would be nice if this worked, but it doesn't.  Yet. */
 238 STGFUN(mci_make_constr_entry)
 239 {
 240   nat size, np, nw_heap, nw_really, w;
 241   StgClosure* con;
 242   StgInfoTable* itbl;
 243   W_* r;
 244   FB_
 245     itbl      = ((StgInfoTable**)Sp)[0];
 246 STGCALL3(fprintf,stderr,"mmc: itbl = %d\n",itbl);
 247
 248 STGCALL3(fprintf,stderr,"mmc: sp-4 = %d\n", ((W_*)Sp)[-4] );
 249 STGCALL3(fprintf,stderr,"mmc: sp-3 = %d\n", ((W_*)Sp)[-3] );
 250 STGCALL3(fprintf,stderr,"mmc: sp-2 = %d\n", ((W_*)Sp)[-2] );
 251 STGCALL3(fprintf,stderr,"mmc: sp-1 = %d\n", ((W_*)Sp)[-1] );
 252 STGCALL3(fprintf,stderr,"mmc: sp+0 = %d\n", ((W_*)Sp)[0] );
 253 STGCALL3(fprintf,stderr,"mmc: sp+1 = %d\n", ((W_*)Sp)[1] );
 254 STGCALL3(fprintf,stderr,"mmc: sp+2 = %d\n", ((W_*)Sp)[2] );
 255 STGCALL3(fprintf,stderr,"mmc: sp+3 = %d\n", ((W_*)Sp)[3] );
 256 STGCALL3(fprintf,stderr,"mmc: sp+4 = %d\n", ((W_*)Sp)[4] );
 257     np        = itbl->layout.payload.ptrs;
 258     nw_really = itbl->layout.payload.nptrs;
 259     nw_heap   = stg_max(nw_really, MIN_NONUPD_SIZE-np);
 260     size      = CONSTR_sizeW( np, nw_heap );
 261
 262     /* The total number of words to copy off the stack is np + nw.
 263        That doesn't include tag words, tho.
 264     */
 265     HP_CHK_GEN_TICKY(size, NO_PTRS, mci_make_constr_entry, );
 266     TICK_ALLOC_PRIM(sizeofW(StgHeader), size-sizeofW(StgHeader), 0);
 267     CCS_ALLOC(CCCS,size); /* ccs prof */
 268
 269     con = (StgClosure*)(Hp + 1 - size);
 270     SET_HDR(con, itbl,CCCS);
 271
 272     /* Copy into the closure. */
 273     w = 0;
 274     r = Sp+1;
 275     while (1) {
 276        if (w == np + nw) break;
 277        ASSERT(w < np + nw);
 278        if (IS_ARG_TAG(*r)) {
 279           nat n = *r++;
 280           for (; n > 0; n--)
 281              con->payload[w++] = (StgClosure*)(*r++);
 282        } else {
 283           con->payload[w++] = (StgClosure*)(*r++);
 284        }
 285        ASSERT((P_)r <= (P_)Su);
 286     }
 287
 288     /* Remove all the args we've used. */
 289     Sp = r;
 290
 291     R1.cl = con;
 292     JMP_(ENTRY_CODE(R1.cl));
 293   FE_
 294 }
 295 #endif
 296
 297 #endif /* GHCI */
 298
 299
 300 /* -----------------------------------------------------------------------------
 301    Entry code for an indirection.
 302    -------------------------------------------------------------------------- */
 303
 304 INFO_TABLE(IND_info,IND_entry,1,0,IND,,EF_,0,0);
 305 STGFUN(IND_entry)
 306 {
 307     FB_
 308     TICK_ENT_IND(Node); /* tick */
 309
 310     R1.p = (P_) ((StgInd*)R1.p)->indirectee;
 311     TICK_ENT_VIA_NODE();
 312     JMP_(ENTRY_CODE(*R1.p));
 313     FE_
 314 }
 315
 316 INFO_TABLE(IND_STATIC_info,IND_STATIC_entry,1,0,IND_STATIC,,EF_,0,0);
 317 STGFUN(IND_STATIC_entry)
 318 {
 319     FB_
 320     TICK_ENT_IND(Node); /* tick */
 321     R1.p = (P_) ((StgIndStatic*)R1.p)->indirectee;
 322     TICK_ENT_VIA_NODE();
 323     JMP_(ENTRY_CODE(*R1.p));
 324     FE_
 325 }
 326
 327 INFO_TABLE(IND_PERM_info,IND_PERM_entry,1,1,IND_PERM,,EF_,"IND_PERM","IND_PERM");
 328 STGFUN(IND_PERM_entry)
 329 {
 330     FB_
 331     /* Don't add INDs to granularity cost */
 332     /* Dont: TICK_ENT_IND(Node); for ticky-ticky; this ind is here only to help profiling */
 333
 334 #if defined(TICKY_TICKY) && !defined(PROFILING)
 335     /* TICKY_TICKY && !PROFILING means PERM_IND *replaces* an IND, rather than being extra  */
 336     TICK_ENT_PERM_IND(R1.p); /* tick */
 337 #endif
 338
 339     /* Enter PAP cost centre -- lexical scoping only */
 340     ENTER_CCS_PAP_CL(R1.cl);
 341
 342     /* For ticky-ticky, change the perm_ind to a normal ind on first
 343      * entry, so the number of ent_perm_inds is the number of *thunks*
 344      * entered again, not the number of subsequent entries.
 345      *
 346      * Since this screws up cost centres, we die if profiling and
 347      * ticky_ticky are on at the same time.  KSW 1999-01.
 348      */
 349
 350 #ifdef TICKY_TICKY
 351 #  ifdef PROFILING
 352 #    error Profiling and ticky-ticky do not mix at present!
 353 #  endif  /* PROFILING */
 354     SET_INFO((StgInd*)R1.p,&IND_info);
 355 #endif /* TICKY_TICKY */
 356
 357     R1.p = (P_) ((StgInd*)R1.p)->indirectee;
 358
 359     /* Dont: TICK_ENT_VIA_NODE(); for ticky-ticky; as above */
 360
 361 #if defined(TICKY_TICKY) && !defined(PROFILING)
 362     TICK_ENT_VIA_NODE();
 363 #endif
 364
 365     JMP_(ENTRY_CODE(*R1.p));
 366     FE_
 367 }
 368
 369 INFO_TABLE(IND_OLDGEN_info,IND_OLDGEN_entry,1,1,IND_OLDGEN,,EF_,0,0);
 370 STGFUN(IND_OLDGEN_entry)
 371 {
 372     FB_
 373     TICK_ENT_IND(Node); /* tick */
 374
 375     R1.p = (P_) ((StgInd*)R1.p)->indirectee;
 376     TICK_ENT_VIA_NODE();
 377     JMP_(ENTRY_CODE(*R1.p));
 378     FE_
 379 }
 380
 381 INFO_TABLE(IND_OLDGEN_PERM_info,IND_OLDGEN_PERM_entry,1,1,IND_OLDGEN_PERM,,EF_,0,0);
 382 STGFUN(IND_OLDGEN_PERM_entry)
 383 {
 384     FB_
 385     /* Dont: TICK_ENT_IND(Node); for ticky-ticky; this ind is here only to help profiling */
 386
 387 #if defined(TICKY_TICKY) && !defined(PROFILING)
 388     /* TICKY_TICKY && !PROFILING means PERM_IND *replaces* an IND, rather than being extra  */
 389     TICK_ENT_PERM_IND(R1.p); /* tick */
 390 #endif
 391
 392     /* Enter PAP cost centre -- lexical scoping only */
 393     ENTER_CCS_PAP_CL(R1.cl);
 394
 395     /* see comment in IND_PERM */
 396 #ifdef TICKY_TICKY
 397 #  ifdef PROFILING
 398 #    error Profiling and ticky-ticky do not mix at present!
 399 #  endif  /* PROFILING */
 400     SET_INFO((StgInd*)R1.p,&IND_OLDGEN_info);
 401 #endif /* TICKY_TICKY */
 402
 403     R1.p = (P_) ((StgInd*)R1.p)->indirectee;
 404     TICK_ENT_VIA_NODE();
 405     JMP_(ENTRY_CODE(*R1.p));
 406     FE_
 407 }
 408
 409 /* -----------------------------------------------------------------------------
 410    Entry code for CAFs
 411
 412    This code assumes R1 is in a register for now.
 413    -------------------------------------------------------------------------- */
 414
 415 INFO_TABLE(CAF_UNENTERED_info,CAF_UNENTERED_entry,1,3,CAF_UNENTERED,,EF_,0,0);
 416 STGFUN(CAF_UNENTERED_entry)
 417 {
 418     FB_
 419     /* ToDo: implement directly in GHC */
 420     Sp -= 1;
 421     Sp[0] = R1.w;
 422     JMP_(stg_yield_to_Hugs);
 423     FE_
 424 }
 425
 426 /* 0,4 is entirely bogus; _do not_ rely on this info */
 427 INFO_TABLE(CAF_ENTERED_info,CAF_ENTERED_entry,0,4,CAF_ENTERED,,EF_,0,0);
 428 STGFUN(CAF_ENTERED_entry)
 429 {
 430     FB_
 431     R1.p = (P_) ((StgCAF*)R1.p)->value; /* just a fancy indirection */
 432     TICK_ENT_VIA_NODE();
 433     JMP_(GET_ENTRY(R1.cl));
 434     FE_
 435 }
 436
 437 /* -----------------------------------------------------------------------------
 438    Entry code for a black hole.
 439
 440    Entering a black hole normally causes a cyclic data dependency, but
 441    in the concurrent world, black holes are synchronization points,
 442    and they are turned into blocking queues when there are threads
 443    waiting for the evaluation of the closure to finish.
 444    -------------------------------------------------------------------------- */
 445
 446 /* Note: a BLACKHOLE and BLACKHOLE_BQ must be big enough to be
 447  * overwritten with an indirection/evacuee/catch.  Thus we claim it
 448  * has 1 non-pointer word of payload (in addition to the pointer word
 449  * for the blocking queue in a BQ), which should be big enough for an
 450  * old-generation indirection.
 451  */
 452
 453 INFO_TABLE(BLACKHOLE_info, BLACKHOLE_entry,0,2,BLACKHOLE,,EF_,"BLACKHOLE","BLACKHOLE");
 454 STGFUN(BLACKHOLE_entry)
 455 {
 456   FB_
 457 #if defined(GRAN)
 458     /* Before overwriting TSO_LINK */
 459     STGCALL3(GranSimBlock,CurrentTSO,CurrentProc,(StgClosure *)R1.p /*Node*/);
 460 #endif
 461
 462 #ifdef SMP
 463     {
 464       bdescr *bd = Bdescr(R1.p);
 465       if (bd->back != (bdescr *)BaseReg) {
 466         if (bd->gen->no >= 1 || bd->step->no >= 1) {
 467           CMPXCHG(R1.cl->header.info, &BLACKHOLE_info, &WHITEHOLE_info);
 468         } else {
 469           EXTFUN_RTS(stg_gc_enter_1_hponly);
 470           JMP_(stg_gc_enter_1_hponly);
 471         }
 472       }
 473     }
 474 #endif
 475     TICK_ENT_BH();
 476
 477     /* Put ourselves on the blocking queue for this black hole */
 478 #if defined(GRAN) || defined(PAR)
 479     /* in fact, only difference is the type of the end-of-queue marker! */
 480     CurrentTSO->link = END_BQ_QUEUE;
 481     ((StgBlockingQueue *)R1.p)->blocking_queue = (StgBlockingQueueElement *)CurrentTSO;
 482 #else
 483     CurrentTSO->link = END_TSO_QUEUE;
 484     ((StgBlockingQueue *)R1.p)->blocking_queue = CurrentTSO;
 485 #endif
 486     /* jot down why and on what closure we are blocked */
 487     CurrentTSO->why_blocked = BlockedOnBlackHole;
 488     CurrentTSO->block_info.closure = R1.cl;
 489     /* closure is mutable since something has just been added to its BQ */
 490     recordMutable((StgMutClosure *)R1.cl);
 491     /* Change the BLACKHOLE into a BLACKHOLE_BQ */
 492     ((StgBlockingQueue *)R1.p)->header.info = &BLACKHOLE_BQ_info;
 493
 494     /* PAR: dumping of event now done in blockThread -- HWL */
 495
 496     /* stg_gen_block is too heavyweight, use a specialised one */
 497     BLOCK_NP(1);
 498
 499   FE_
 500 }
 501
 502 INFO_TABLE(BLACKHOLE_BQ_info, BLACKHOLE_BQ_entry,1,1,BLACKHOLE_BQ,,EF_,"BLACKHOLE","BLACKHOLE");
 503 STGFUN(BLACKHOLE_BQ_entry)
 504 {
 505   FB_
 506 #if defined(GRAN)
 507     /* Before overwriting TSO_LINK */
 508     STGCALL3(GranSimBlock,CurrentTSO,CurrentProc,(StgClosure *)R1.p /*Node*/);
 509 #endif
 510
 511 #ifdef SMP
 512     {
 513       bdescr *bd = Bdescr(R1.p);
 514       if (bd->back != (bdescr *)BaseReg) {
 515         if (bd->gen->no >= 1 || bd->step->no >= 1) {
 516           CMPXCHG(R1.cl->header.info, &BLACKHOLE_info, &WHITEHOLE_info);
 517         } else {
 518           EXTFUN_RTS(stg_gc_enter_1_hponly);
 519           JMP_(stg_gc_enter_1_hponly);
 520         }
 521       }
 522     }
 523 #endif
 524
 525     TICK_ENT_BH();
 526
 527     /* Put ourselves on the blocking queue for this black hole */
 528     CurrentTSO->link = ((StgBlockingQueue *)R1.p)->blocking_queue;
 529     ((StgBlockingQueue *)R1.p)->blocking_queue = CurrentTSO;
 530     /* jot down why and on what closure we are blocked */
 531     CurrentTSO->why_blocked = BlockedOnBlackHole;
 532     CurrentTSO->block_info.closure = R1.cl;
 533 #ifdef SMP
 534     ((StgBlockingQueue *)R1.p)->header.info = &BLACKHOLE_BQ_info;
 535 #endif
 536
 537     /* PAR: dumping of event now done in blockThread -- HWL */
 538
 539     /* stg_gen_block is too heavyweight, use a specialised one */
 540     BLOCK_NP(1);
 541   FE_
 542 }
 543
 544 /*
 545    Revertible black holes are needed in the parallel world, to handle
 546    negative acknowledgements of messages containing updatable closures.
 547    The idea is that when the original message is transmitted, the closure
 548    is turned into a revertible black hole...an object which acts like a
 549    black hole when local threads try to enter it, but which can be reverted
 550    back to the original closure if necessary.
 551
 552    It's actually a lot like a blocking queue (BQ) entry, because revertible
 553    black holes are initially set up with an empty blocking queue.
 554 */
 555
 556 #if defined(PAR) || defined(GRAN)
 557
 558 INFO_TABLE(RBH_info, RBH_entry,1,1,RBH,,EF_,0,0);
 559 STGFUN(RBH_entry)
 560 {
 561   FB_
 562 # if defined(GRAN)
 563     /* mainly statistics gathering for GranSim simulation */
 564     STGCALL3(GranSimBlock,CurrentTSO,CurrentProc,(StgClosure *)R1.p /*Node*/);
 565 # endif
 566
 567     /* exactly the same as a BLACKHOLE_BQ_entry -- HWL */
 568     /* Put ourselves on the blocking queue for this black hole */
 569     CurrentTSO->link = ((StgBlockingQueue *)R1.p)->blocking_queue;
 570     ((StgBlockingQueue *)R1.p)->blocking_queue = CurrentTSO;
 571     /* jot down why and on what closure we are blocked */
 572     CurrentTSO->why_blocked = BlockedOnBlackHole;
 573     CurrentTSO->block_info.closure = R1.cl;
 574
 575     /* PAR: dumping of event now done in blockThread -- HWL */
 576
 577     /* stg_gen_block is too heavyweight, use a specialised one */
 578     BLOCK_NP(1);
 579   FE_
 580 }
 581
 582 INFO_TABLE(RBH_Save_0_info, RBH_Save_0_entry,0,2,CONSTR,,EF_,0,0);
 583 NON_ENTERABLE_ENTRY_CODE(RBH_Save_0);
 584
 585 INFO_TABLE(RBH_Save_1_info, RBH_Save_1_entry,1,1,CONSTR,,EF_,0,0);
 586 NON_ENTERABLE_ENTRY_CODE(RBH_Save_1);
 587
 588 INFO_TABLE(RBH_Save_2_info, RBH_Save_2_entry,2,0,CONSTR,,EF_,0,0);
 589 NON_ENTERABLE_ENTRY_CODE(RBH_Save_2);
 590 #endif /* defined(PAR) || defined(GRAN) */
 591
 592 /* identical to BLACKHOLEs except for the infotag */
 593 INFO_TABLE(CAF_BLACKHOLE_info, CAF_BLACKHOLE_entry,0,2,CAF_BLACKHOLE,,EF_,"CAF_BLACKHOLE","CAF_BLACKHOLE");
 594 STGFUN(CAF_BLACKHOLE_entry)
 595 {
 596   FB_
 597 #if defined(GRAN)
 598     /* mainly statistics gathering for GranSim simulation */
 599     STGCALL3(GranSimBlock,CurrentTSO,CurrentProc,(StgClosure *)R1.p /*Node*/);
 600 #endif
 601
 602 #ifdef SMP
 603     {
 604       bdescr *bd = Bdescr(R1.p);
 605       if (bd->back != (bdescr *)BaseReg) {
 606         if (bd->gen->no >= 1 || bd->step->no >= 1) {
 607           CMPXCHG(R1.cl->header.info, &CAF_BLACKHOLE_info, &WHITEHOLE_info);
 608         } else {
 609           EXTFUN_RTS(stg_gc_enter_1_hponly);
 610           JMP_(stg_gc_enter_1_hponly);
 611         }
 612       }
 613     }
 614 #endif
 615
 616     TICK_ENT_BH();
 617
 618     /* Put ourselves on the blocking queue for this black hole */
 619 #if defined(GRAN) || defined(PAR)
 620     /* in fact, only difference is the type of the end-of-queue marker! */
 621     CurrentTSO->link = END_BQ_QUEUE;
 622     ((StgBlockingQueue *)R1.p)->blocking_queue = (StgBlockingQueueElement *)CurrentTSO;
 623 #else
 624     CurrentTSO->link = END_TSO_QUEUE;
 625     ((StgBlockingQueue *)R1.p)->blocking_queue = CurrentTSO;
 626 #endif
 627     /* jot down why and on what closure we are blocked */
 628     CurrentTSO->why_blocked = BlockedOnBlackHole;
 629     CurrentTSO->block_info.closure = R1.cl;
 630     /* closure is mutable since something has just been added to its BQ */
 631     recordMutable((StgMutClosure *)R1.cl);
 632     /* Change the CAF_BLACKHOLE into a BLACKHOLE_BQ */
 633     ((StgBlockingQueue *)R1.p)->header.info = &BLACKHOLE_BQ_info;
 634
 635     /* PAR: dumping of event now done in blockThread -- HWL */
 636
 637     /* stg_gen_block is too heavyweight, use a specialised one */
 638     BLOCK_NP(1);
 639   FE_
 640 }
 641
 642 #ifdef TICKY_TICKY
 643 INFO_TABLE(SE_BLACKHOLE_info, SE_BLACKHOLE_entry,0,2,SE_BLACKHOLE,,EF_,0,0);
 644 STGFUN(SE_BLACKHOLE_entry)
 645 {
 646   FB_
 647     STGCALL3(fprintf,stderr,"SE_BLACKHOLE at %p entered!\n",R1.p);
 648     STGCALL1(shutdownHaskellAndExit,EXIT_FAILURE);
 649   FE_
 650 }
 651
 652 INFO_TABLE(SE_CAF_BLACKHOLE_info, SE_CAF_BLACKHOLE_entry,0,2,SE_CAF_BLACKHOLE,,EF_,0,0);
 653 STGFUN(SE_CAF_BLACKHOLE_entry)
 654 {
 655   FB_
 656     STGCALL3(fprintf,stderr,"SE_CAF_BLACKHOLE at %p entered!\n",R1.p);
 657     STGCALL1(shutdownHaskellAndExit,EXIT_FAILURE);
 658   FE_
 659 }
 660 #endif
 661
 662 #ifdef SMP
 663 INFO_TABLE(WHITEHOLE_info, WHITEHOLE_entry,0,2,CONSTR_NOCAF_STATIC,,EF_,0,0);
 664 STGFUN(WHITEHOLE_entry)
 665 {
 666   FB_
 667      JMP_(GET_ENTRY(R1.cl));
 668   FE_
 669 }
 670 #endif
 671
 672 /* -----------------------------------------------------------------------------
 673    The code for a BCO returns to the scheduler
 674    -------------------------------------------------------------------------- */
 675 INFO_TABLE(BCO_info,BCO_entry,0,0,BCO,,EF_,"BCO","BCO");
 676 EF_(BCO_entry) {
 677   FB_
 678     Sp -= 1;
 679     Sp[0] = R1.w;
 680     JMP_(stg_yield_to_Hugs);
 681   FE_
 682 }
 683
 684 /* -----------------------------------------------------------------------------
 685    Some static info tables for things that don't get entered, and
 686    therefore don't need entry code (i.e. boxed but unpointed objects)
 687    NON_ENTERABLE_ENTRY_CODE now defined at the beginning of the file
 688    -------------------------------------------------------------------------- */
 689
 690 INFO_TABLE(TSO_info, TSO_entry, 0,0,TSO,,EF_,"TSO","TSO");
 691 NON_ENTERABLE_ENTRY_CODE(TSO);
 692
 693 /* -----------------------------------------------------------------------------
 694    Evacuees are left behind by the garbage collector.  Any attempt to enter
 695    one is a real bug.
 696    -------------------------------------------------------------------------- */
 697
 698 INFO_TABLE(EVACUATED_info,EVACUATED_entry,1,0,EVACUATED,,EF_,0,0);
 699 NON_ENTERABLE_ENTRY_CODE(EVACUATED);
 700
 701 /* -----------------------------------------------------------------------------
 702    Weak pointers
 703
 704    Live weak pointers have a special closure type.  Dead ones are just
 705    nullary constructors (although they live on the heap - we overwrite
 706    live weak pointers with dead ones).
 707    -------------------------------------------------------------------------- */
 708
 709 INFO_TABLE(WEAK_info,WEAK_entry,0,4,WEAK,,EF_,"WEAK","WEAK");
 710 NON_ENTERABLE_ENTRY_CODE(WEAK);
 711
 712 INFO_TABLE_CONSTR(DEAD_WEAK_info,DEAD_WEAK_entry,0,1,0,CONSTR,,EF_,"DEAD_WEAK","DEAD_WEAK");
 713 NON_ENTERABLE_ENTRY_CODE(DEAD_WEAK);
 714
 715 /* -----------------------------------------------------------------------------
 716    NO_FINALIZER
 717
 718    This is a static nullary constructor (like []) that we use to mark an empty
 719    finalizer in a weak pointer object.
 720    -------------------------------------------------------------------------- */
 721
 722 INFO_TABLE_CONSTR(NO_FINALIZER_info,NO_FINALIZER_entry,0,0,0,CONSTR_NOCAF_STATIC,,EF_,0,0);
 723 NON_ENTERABLE_ENTRY_CODE(NO_FINALIZER);
 724
 725 SET_STATIC_HDR(NO_FINALIZER_closure,NO_FINALIZER_info,0/*CC*/,,EI_)
 726 , /*payload*/{} };
 727
 728 /* -----------------------------------------------------------------------------
 729    Foreign Objects are unlifted and therefore never entered.
 730    -------------------------------------------------------------------------- */
 731
 732 INFO_TABLE(FOREIGN_info,FOREIGN_entry,0,1,FOREIGN,,EF_,"FOREIGN","FOREIGN");
 733 NON_ENTERABLE_ENTRY_CODE(FOREIGN);
 734
 735 /* -----------------------------------------------------------------------------
 736    Stable Names are unlifted too.
 737    -------------------------------------------------------------------------- */
 738
 739 INFO_TABLE(STABLE_NAME_info,STABLE_NAME_entry,0,1,STABLE_NAME,,EF_,"STABLE_NAME","STABLE_NAME");
 740 NON_ENTERABLE_ENTRY_CODE(STABLE_NAME);
 741
 742 /* -----------------------------------------------------------------------------
 743    MVars
 744
 745    There are two kinds of these: full and empty.  We need an info table
 746    and entry code for each type.
 747    -------------------------------------------------------------------------- */
 748
 749 INFO_TABLE(FULL_MVAR_info,FULL_MVAR_entry,4,0,MVAR,,EF_,"MVAR","MVAR");
 750 NON_ENTERABLE_ENTRY_CODE(FULL_MVAR);
 751
 752 INFO_TABLE(EMPTY_MVAR_info,EMPTY_MVAR_entry,4,0,MVAR,,EF_,"MVAR","MVAR");
 753 NON_ENTERABLE_ENTRY_CODE(EMPTY_MVAR);
 754
 755 /* -----------------------------------------------------------------------------
 756    END_TSO_QUEUE
 757
 758    This is a static nullary constructor (like []) that we use to mark the
 759    end of a linked TSO queue.
 760    -------------------------------------------------------------------------- */
 761
 762 INFO_TABLE_CONSTR(END_TSO_QUEUE_info,END_TSO_QUEUE_entry,0,0,0,CONSTR_NOCAF_STATIC,,EF_,0,0);
 763 NON_ENTERABLE_ENTRY_CODE(END_TSO_QUEUE);
 764
 765 SET_STATIC_HDR(END_TSO_QUEUE_closure,END_TSO_QUEUE_info,0/*CC*/,,EI_)
 766 , /*payload*/{} };
 767
 768 /* -----------------------------------------------------------------------------
 769    Mutable lists
 770
 771    Mutable lists (used by the garbage collector) consist of a chain of
 772    StgMutClosures connected through their mut_link fields, ending in
 773    an END_MUT_LIST closure.
 774    -------------------------------------------------------------------------- */
 775
 776 INFO_TABLE_CONSTR(END_MUT_LIST_info,END_MUT_LIST_entry,0,0,0,CONSTR_NOCAF_STATIC,,EF_,0,0);
 777 NON_ENTERABLE_ENTRY_CODE(END_MUT_LIST);
 778
 779 SET_STATIC_HDR(END_MUT_LIST_closure,END_MUT_LIST_info,0/*CC*/,,EI_)
 780 , /*payload*/{} };
 781
 782 INFO_TABLE(MUT_CONS_info, MUT_CONS_entry, 1, 1, MUT_VAR, , EF_, 0, 0);
 783 NON_ENTERABLE_ENTRY_CODE(MUT_CONS);
 784
 785 /* -----------------------------------------------------------------------------
 786    Exception lists
 787    -------------------------------------------------------------------------- */
 788
 789 INFO_TABLE_CONSTR(END_EXCEPTION_LIST_info,END_EXCEPTION_LIST_entry,0,0,0,CONSTR_NOCAF_STATIC,,EF_,0,0);
 790 NON_ENTERABLE_ENTRY_CODE(END_EXCEPTION_LIST);
 791
 792 SET_STATIC_HDR(END_EXCEPTION_LIST_closure,END_EXCEPTION_LIST_info,0/*CC*/,,EI_)
 793 , /*payload*/{} };
 794
 795 INFO_TABLE(EXCEPTION_CONS_info, EXCEPTION_CONS_entry, 1, 1, CONSTR, , EF_, 0, 0);
 796 NON_ENTERABLE_ENTRY_CODE(EXCEPTION_CONS);
 797
 798 /* -----------------------------------------------------------------------------
 799    Arrays
 800
 801    These come in two basic flavours: arrays of data (StgArrWords) and arrays of
 802    pointers (StgArrPtrs).  They all have a similar layout:
 803
 804         ___________________________
 805         | Info | No. of | data....
 806         |  Ptr | Words  |
 807         ---------------------------
 808
 809    These are *unpointed* objects: i.e. they cannot be entered.
 810
 811    -------------------------------------------------------------------------- */
 812
 813 #define ArrayInfo(type)                                 \
 814 INFO_TABLE(type##_info, type##_entry, 0, 0, type, , EF_,"" # type "","" # type "");
 815
 816 ArrayInfo(ARR_WORDS);
 817 NON_ENTERABLE_ENTRY_CODE(ARR_WORDS);
 818 ArrayInfo(MUT_ARR_PTRS);
 819 NON_ENTERABLE_ENTRY_CODE(MUT_ARR_PTRS);
 820 ArrayInfo(MUT_ARR_PTRS_FROZEN);
 821 NON_ENTERABLE_ENTRY_CODE(MUT_ARR_PTRS_FROZEN);
 822
 823 #undef ArrayInfo
 824
 825 /* -----------------------------------------------------------------------------
 826    Mutable Variables
 827    -------------------------------------------------------------------------- */
 828
 829 INFO_TABLE(MUT_VAR_info, MUT_VAR_entry, 1, 1, MUT_VAR, , EF_, "MUT_VAR", "MUT_VAR");
 830 NON_ENTERABLE_ENTRY_CODE(MUT_VAR);
 831
 832 /* -----------------------------------------------------------------------------
 833    Standard Error Entry.
 834
 835    This is used for filling in vector-table entries that can never happen,
 836    for instance.
 837    -------------------------------------------------------------------------- */
 838 /* No longer used; we use NULL, because a) it never happens, right? and b)
 839    Windows doesn't like DLL entry points being used as static initialisers
 840 STGFUN(stg_error_entry)                                                 \
 841 {                                                                       \
 842   FB_                                                                   \
 843     DUMP_ERRMSG("fatal: stg_error_entry");                              \
 844     STGCALL1(shutdownHaskellAndExit, EXIT_FAILURE);                     \
 845     return NULL;                                                        \
 846   FE_                                                                   \
 847 }
 848 */
 849 /* -----------------------------------------------------------------------------
 850    Dummy return closure
 851
 852    Entering this closure will just return to the address on the top of the
 853    stack.  Useful for getting a thread in a canonical form where we can
 854    just enter the top stack word to start the thread.  (see deleteThread)
 855  * -------------------------------------------------------------------------- */
 856
 857 INFO_TABLE(dummy_ret_info, dummy_ret_entry, 0, 0, CONSTR_NOCAF_STATIC, , EF_, 0, 0);
 858 FN_(dummy_ret_entry)
 859 {
 860   W_ ret_addr;
 861   FB_
 862   ret_addr = Sp[0];
 863   Sp++;
 864   JMP_(ENTRY_CODE(ret_addr));
 865   FE_
 866 }
 867 SET_STATIC_HDR(dummy_ret_closure,dummy_ret_info,CCS_DONT_CARE,,EI_)
 868 , /*payload*/{} };
 869
 870 /* -----------------------------------------------------------------------------
 871     Strict IO application - performing an IO action and entering its result.
 872
 873     rts_evalIO() lets you perform Haskell IO actions from outside of Haskell-land,
 874     returning back to you their result. Want this result to be evaluated to WHNF
 875     by that time, so that we can easily get at the int/char/whatever using the
 876     various get{Ty} functions provided by the RTS API.
 877
 878     forceIO takes care of this, performing the IO action and entering the
 879     results that comes back.
 880
 881  * -------------------------------------------------------------------------- */
 882
 883 #ifdef REG_R1
 884 INFO_TABLE_SRT_BITMAP(forceIO_ret_info,forceIO_ret_entry,0,0,0,0,RET_SMALL,,EF_,0,0);
 885 FN_(forceIO_ret_entry)
 886 {
 887   FB_
 888   Sp++;
 889   Sp -= sizeofW(StgSeqFrame);
 890   PUSH_SEQ_FRAME(Sp);
 891   JMP_(GET_ENTRY(R1.cl));
 892 }
 893 #else
 894 INFO_TABLE_SRT_BITMAP(forceIO_ret_info,forceIO_ret_entry,0,0,0,0,RET_SMALL,,EF_,0,0);
 895 FN_(forceIO_ret_entry)
 896 {
 897   StgClosure *rval;
 898   FB_
 899   rval = (StgClosure *)Sp[0];
 900   Sp += 2;
 901   Sp -= sizeofW(StgSeqFrame);
 902   PUSH_SEQ_FRAME(Sp);
 903   R1.cl = rval;
 904   JMP_(GET_ENTRY(R1.cl));
 905 }
 906 #endif
 907
 908 INFO_TABLE(forceIO_info,forceIO_entry,1,0,FUN_STATIC,,EF_,0,0);
 909 FN_(forceIO_entry)
 910 {
 911   FB_
 912   /* Sp[0] contains the IO action we want to perform */
 913   R1.p  = (P_)Sp[0];
 914   /* Replace it with the return continuation that enters the result. */
 915   Sp[0] = (W_)&forceIO_ret_info;
 916   Sp--;
 917   /* Push the RealWorld# tag and enter */
 918   Sp[0] =(W_)REALWORLD_TAG;
 919   JMP_(GET_ENTRY(R1.cl));
 920   FE_
 921 }
 922 SET_STATIC_HDR(forceIO_closure,forceIO_info,CCS_DONT_CARE,,EI_)
 923 , /*payload*/{} };
 924
 925
 926 /* -----------------------------------------------------------------------------
 927    Standard Infotables (for use in interpreter)
 928    -------------------------------------------------------------------------- */
 929
 930 #ifdef INTERPRETER
 931
 932 STGFUN(Hugs_CONSTR_entry)
 933 {
 934     /* R1 points at the constructor */
 935     JMP_(ENTRY_CODE(((StgPtr*)Sp)[0]));
 936 }
 937
 938 #define RET_BCO_ENTRY_TEMPLATE(label)   \
 939    IFN_(label)                          \
 940    {                                    \
 941       FB_                               \
 942       Sp -= 1;                          \
 943       ((StgPtr*)Sp)[0] = R1.p;          \
 944       JMP_(stg_yield_to_Hugs);          \
 945       FE_                               \
 946    }
 947
 948 RET_BCO_ENTRY_TEMPLATE(ret_bco_entry  );
 949 RET_BCO_ENTRY_TEMPLATE(ret_bco_0_entry);
 950 RET_BCO_ENTRY_TEMPLATE(ret_bco_1_entry);
 951 RET_BCO_ENTRY_TEMPLATE(ret_bco_2_entry);
 952 RET_BCO_ENTRY_TEMPLATE(ret_bco_3_entry);
 953 RET_BCO_ENTRY_TEMPLATE(ret_bco_4_entry);
 954 RET_BCO_ENTRY_TEMPLATE(ret_bco_5_entry);
 955 RET_BCO_ENTRY_TEMPLATE(ret_bco_6_entry);
 956 RET_BCO_ENTRY_TEMPLATE(ret_bco_7_entry);
 957
 958 VEC_POLY_INFO_TABLE(ret_bco,0, NULL/*srt*/, 0/*srt_off*/, 0/*srt_len*/, RET_BCO,, EF_);
 959
 960 #endif /* INTERPRETER */
 961
 962 /* -----------------------------------------------------------------------------
 963    CHARLIKE and INTLIKE closures.
 964
 965    These are static representations of Chars and small Ints, so that
 966    we can remove dynamic Chars and Ints during garbage collection and
 967    replace them with references to the static objects.
 968    -------------------------------------------------------------------------- */
 969
 970 #if defined(INTERPRETER) || defined(ENABLE_WIN32_DLL_SUPPORT)
 971 /*
 972  * When sticking the RTS in a DLL, we delay populating the
 973  * Charlike and Intlike tables until load-time, which is only
 974  * when we've got the real addresses to the C# and I# closures.
 975  *
 976  */
 977 static INFO_TBL_CONST StgInfoTable czh_static_info;
 978 static INFO_TBL_CONST StgInfoTable izh_static_info;
 979 #define Char_hash_static_info czh_static_info
 980 #define Int_hash_static_info izh_static_info
 981 #else
 982 #define Char_hash_static_info PrelBase_Czh_static_info
 983 #define Int_hash_static_info PrelBase_Izh_static_info
 984 #endif
 985
 986 #define CHARLIKE_HDR(n)                                         \
 987         {                                                       \
 988           STATIC_HDR(Char_hash_static_info, /* C# */            \
 989                          CCS_DONT_CARE),                        \
 990           data : n                                              \
 991         }
 992
 993 #define INTLIKE_HDR(n)                                          \
 994         {                                                       \
 995           STATIC_HDR(Int_hash_static_info,  /* I# */            \
 996                          CCS_DONT_CARE),                        \
 997           data : n                                              \
 998         }
 999
1000 /* put these in the *data* section, since the garbage collector relies
1001  * on the fact that static closures live in the data section.
1002  */
1003
1004 /* end the name with _closure, to convince the mangler this is a closure */
1005
1006 StgIntCharlikeClosure CHARLIKE_closure[] = {
1007     CHARLIKE_HDR(0),
1008     CHARLIKE_HDR(1),
1009     CHARLIKE_HDR(2),
1010     CHARLIKE_HDR(3),
1011     CHARLIKE_HDR(4),
1012     CHARLIKE_HDR(5),
1013     CHARLIKE_HDR(6),
1014     CHARLIKE_HDR(7),
1015     CHARLIKE_HDR(8),
1016     CHARLIKE_HDR(9),
1017     CHARLIKE_HDR(10),
1018     CHARLIKE_HDR(11),
1019     CHARLIKE_HDR(12),
1020     CHARLIKE_HDR(13),
1021     CHARLIKE_HDR(14),
1022     CHARLIKE_HDR(15),
1023     CHARLIKE_HDR(16),
1024     CHARLIKE_HDR(17),
1025     CHARLIKE_HDR(18),
1026     CHARLIKE_HDR(19),
1027     CHARLIKE_HDR(20),
1028     CHARLIKE_HDR(21),
1029     CHARLIKE_HDR(22),
1030     CHARLIKE_HDR(23),
1031     CHARLIKE_HDR(24),
1032     CHARLIKE_HDR(25),
1033     CHARLIKE_HDR(26),
1034     CHARLIKE_HDR(27),
1035     CHARLIKE_HDR(28),
1036     CHARLIKE_HDR(29),
1037     CHARLIKE_HDR(30),
1038     CHARLIKE_HDR(31),
1039     CHARLIKE_HDR(32),
1040     CHARLIKE_HDR(33),
1041     CHARLIKE_HDR(34),
1042     CHARLIKE_HDR(35),
1043     CHARLIKE_HDR(36),
1044     CHARLIKE_HDR(37),
1045     CHARLIKE_HDR(38),
1046     CHARLIKE_HDR(39),
1047     CHARLIKE_HDR(40),
1048     CHARLIKE_HDR(41),
1049     CHARLIKE_HDR(42),
1050     CHARLIKE_HDR(43),
1051     CHARLIKE_HDR(44),
1052     CHARLIKE_HDR(45),
1053     CHARLIKE_HDR(46),
1054     CHARLIKE_HDR(47),
1055     CHARLIKE_HDR(48),
1056     CHARLIKE_HDR(49),
1057     CHARLIKE_HDR(50),
1058     CHARLIKE_HDR(51),
1059     CHARLIKE_HDR(52),
1060     CHARLIKE_HDR(53),
1061     CHARLIKE_HDR(54),
1062     CHARLIKE_HDR(55),
1063     CHARLIKE_HDR(56),
1064     CHARLIKE_HDR(57),
1065     CHARLIKE_HDR(58),
1066     CHARLIKE_HDR(59),
1067     CHARLIKE_HDR(60),
1068     CHARLIKE_HDR(61),
1069     CHARLIKE_HDR(62),
1070     CHARLIKE_HDR(63),
1071     CHARLIKE_HDR(64),
1072     CHARLIKE_HDR(65),
1073     CHARLIKE_HDR(66),
1074     CHARLIKE_HDR(67),
1075     CHARLIKE_HDR(68),
1076     CHARLIKE_HDR(69),
1077     CHARLIKE_HDR(70),
1078     CHARLIKE_HDR(71),
1079     CHARLIKE_HDR(72),
1080     CHARLIKE_HDR(73),
1081     CHARLIKE_HDR(74),
1082     CHARLIKE_HDR(75),
1083     CHARLIKE_HDR(76),
1084     CHARLIKE_HDR(77),
1085     CHARLIKE_HDR(78),
1086     CHARLIKE_HDR(79),
1087     CHARLIKE_HDR(80),
1088     CHARLIKE_HDR(81),
1089     CHARLIKE_HDR(82),
1090     CHARLIKE_HDR(83),
1091     CHARLIKE_HDR(84),
1092     CHARLIKE_HDR(85),
1093     CHARLIKE_HDR(86),
1094     CHARLIKE_HDR(87),
1095     CHARLIKE_HDR(88),
1096     CHARLIKE_HDR(89),
1097     CHARLIKE_HDR(90),
1098     CHARLIKE_HDR(91),
1099     CHARLIKE_HDR(92),
1100     CHARLIKE_HDR(93),
1101     CHARLIKE_HDR(94),
1102     CHARLIKE_HDR(95),
1103     CHARLIKE_HDR(96),
1104     CHARLIKE_HDR(97),
1105     CHARLIKE_HDR(98),
1106     CHARLIKE_HDR(99),
1107     CHARLIKE_HDR(100),
1108     CHARLIKE_HDR(101),
1109     CHARLIKE_HDR(102),
1110     CHARLIKE_HDR(103),
1111     CHARLIKE_HDR(104),
1112     CHARLIKE_HDR(105),
1113     CHARLIKE_HDR(106),
1114     CHARLIKE_HDR(107),
1115     CHARLIKE_HDR(108),
1116     CHARLIKE_HDR(109),
1117     CHARLIKE_HDR(110),
1118     CHARLIKE_HDR(111),
1119     CHARLIKE_HDR(112),
1120     CHARLIKE_HDR(113),
1121     CHARLIKE_HDR(114),
1122     CHARLIKE_HDR(115),
1123     CHARLIKE_HDR(116),
1124     CHARLIKE_HDR(117),
1125     CHARLIKE_HDR(118),
1126     CHARLIKE_HDR(119),
1127     CHARLIKE_HDR(120),
1128     CHARLIKE_HDR(121),
1129     CHARLIKE_HDR(122),
1130     CHARLIKE_HDR(123),
1131     CHARLIKE_HDR(124),
1132     CHARLIKE_HDR(125),
1133     CHARLIKE_HDR(126),
1134     CHARLIKE_HDR(127),
1135     CHARLIKE_HDR(128),
1136     CHARLIKE_HDR(129),
1137     CHARLIKE_HDR(130),
1138     CHARLIKE_HDR(131),
1139     CHARLIKE_HDR(132),
1140     CHARLIKE_HDR(133),
1141     CHARLIKE_HDR(134),
1142     CHARLIKE_HDR(135),
1143     CHARLIKE_HDR(136),
1144     CHARLIKE_HDR(137),
1145     CHARLIKE_HDR(138),
1146     CHARLIKE_HDR(139),
1147     CHARLIKE_HDR(140),
1148     CHARLIKE_HDR(141),
1149     CHARLIKE_HDR(142),
1150     CHARLIKE_HDR(143),
1151     CHARLIKE_HDR(144),
1152     CHARLIKE_HDR(145),
1153     CHARLIKE_HDR(146),
1154     CHARLIKE_HDR(147),
1155     CHARLIKE_HDR(148),
1156     CHARLIKE_HDR(149),
1157     CHARLIKE_HDR(150),
1158     CHARLIKE_HDR(151),
1159     CHARLIKE_HDR(152),
1160     CHARLIKE_HDR(153),
1161     CHARLIKE_HDR(154),
1162     CHARLIKE_HDR(155),
1163     CHARLIKE_HDR(156),
1164     CHARLIKE_HDR(157),
1165     CHARLIKE_HDR(158),
1166     CHARLIKE_HDR(159),
1167     CHARLIKE_HDR(160),
1168     CHARLIKE_HDR(161),
1169     CHARLIKE_HDR(162),
1170     CHARLIKE_HDR(163),
1171     CHARLIKE_HDR(164),
1172     CHARLIKE_HDR(165),
1173     CHARLIKE_HDR(166),
1174     CHARLIKE_HDR(167),
1175     CHARLIKE_HDR(168),
1176     CHARLIKE_HDR(169),
1177     CHARLIKE_HDR(170),
1178     CHARLIKE_HDR(171),
1179     CHARLIKE_HDR(172),
1180     CHARLIKE_HDR(173),
1181     CHARLIKE_HDR(174),
1182     CHARLIKE_HDR(175),
1183     CHARLIKE_HDR(176),
1184     CHARLIKE_HDR(177),
1185     CHARLIKE_HDR(178),
1186     CHARLIKE_HDR(179),
1187     CHARLIKE_HDR(180),
1188     CHARLIKE_HDR(181),
1189     CHARLIKE_HDR(182),
1190     CHARLIKE_HDR(183),
1191     CHARLIKE_HDR(184),
1192     CHARLIKE_HDR(185),
1193     CHARLIKE_HDR(186),
1194     CHARLIKE_HDR(187),
1195     CHARLIKE_HDR(188),
1196     CHARLIKE_HDR(189),
1197     CHARLIKE_HDR(190),
1198     CHARLIKE_HDR(191),
1199     CHARLIKE_HDR(192),
1200     CHARLIKE_HDR(193),
1201     CHARLIKE_HDR(194),
1202     CHARLIKE_HDR(195),
1203     CHARLIKE_HDR(196),
1204     CHARLIKE_HDR(197),
1205     CHARLIKE_HDR(198),
1206     CHARLIKE_HDR(199),
1207     CHARLIKE_HDR(200),
1208     CHARLIKE_HDR(201),
1209     CHARLIKE_HDR(202),
1210     CHARLIKE_HDR(203),
1211     CHARLIKE_HDR(204),
1212     CHARLIKE_HDR(205),
1213     CHARLIKE_HDR(206),
1214     CHARLIKE_HDR(207),
1215     CHARLIKE_HDR(208),
1216     CHARLIKE_HDR(209),
1217     CHARLIKE_HDR(210),
1218     CHARLIKE_HDR(211),
1219     CHARLIKE_HDR(212),
1220     CHARLIKE_HDR(213),
1221     CHARLIKE_HDR(214),
1222     CHARLIKE_HDR(215),
1223     CHARLIKE_HDR(216),
1224     CHARLIKE_HDR(217),
1225     CHARLIKE_HDR(218),
1226     CHARLIKE_HDR(219),
1227     CHARLIKE_HDR(220),
1228     CHARLIKE_HDR(221),
1229     CHARLIKE_HDR(222),
1230     CHARLIKE_HDR(223),
1231     CHARLIKE_HDR(224),
1232     CHARLIKE_HDR(225),
1233     CHARLIKE_HDR(226),
1234     CHARLIKE_HDR(227),
1235     CHARLIKE_HDR(228),
1236     CHARLIKE_HDR(229),
1237     CHARLIKE_HDR(230),
1238     CHARLIKE_HDR(231),
1239     CHARLIKE_HDR(232),
1240     CHARLIKE_HDR(233),
1241     CHARLIKE_HDR(234),
1242     CHARLIKE_HDR(235),
1243     CHARLIKE_HDR(236),
1244     CHARLIKE_HDR(237),
1245     CHARLIKE_HDR(238),
1246     CHARLIKE_HDR(239),
1247     CHARLIKE_HDR(240),
1248     CHARLIKE_HDR(241),
1249     CHARLIKE_HDR(242),
1250     CHARLIKE_HDR(243),
1251     CHARLIKE_HDR(244),
1252     CHARLIKE_HDR(245),
1253     CHARLIKE_HDR(246),
1254     CHARLIKE_HDR(247),
1255     CHARLIKE_HDR(248),
1256     CHARLIKE_HDR(249),
1257     CHARLIKE_HDR(250),
1258     CHARLIKE_HDR(251),
1259     CHARLIKE_HDR(252),
1260     CHARLIKE_HDR(253),
1261     CHARLIKE_HDR(254),
1262     CHARLIKE_HDR(255)
1263 };
1264
1265 StgIntCharlikeClosure INTLIKE_closure[] = {
1266     INTLIKE_HDR(-16),   /* MIN_INTLIKE == -16 */
1267     INTLIKE_HDR(-15),
1268     INTLIKE_HDR(-14),
1269     INTLIKE_HDR(-13),
1270     INTLIKE_HDR(-12),
1271     INTLIKE_HDR(-11),
1272     INTLIKE_HDR(-10),
1273     INTLIKE_HDR(-9),
1274     INTLIKE_HDR(-8),
1275     INTLIKE_HDR(-7),
1276     INTLIKE_HDR(-6),
1277     INTLIKE_HDR(-5),
1278     INTLIKE_HDR(-4),
1279     INTLIKE_HDR(-3),
1280     INTLIKE_HDR(-2),
1281     INTLIKE_HDR(-1),
1282     INTLIKE_HDR(0),
1283     INTLIKE_HDR(1),
1284     INTLIKE_HDR(2),
1285     INTLIKE_HDR(3),
1286     INTLIKE_HDR(4),
1287     INTLIKE_HDR(5),
1288     INTLIKE_HDR(6),
1289     INTLIKE_HDR(7),
1290     INTLIKE_HDR(8),
1291     INTLIKE_HDR(9),
1292     INTLIKE_HDR(10),
1293     INTLIKE_HDR(11),
1294     INTLIKE_HDR(12),
1295     INTLIKE_HDR(13),
1296     INTLIKE_HDR(14),
1297     INTLIKE_HDR(15),
1298     INTLIKE_HDR(16)     /* MAX_INTLIKE == 16 */
1299 };