ghc/rts/StgMiscClosures.hc

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