ghc/rts/StgMiscClosures.hc

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