ghc/rts/StgMiscClosures.hc

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