ghc/rts/StgMiscClosures.hc

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