ghc/rts/StgMiscClosures.hc

   1 /* -----------------------------------------------------------------------------
   2  * $Id: StgMiscClosures.hc,v 1.47 2000/08/02 14:13:28 rrt 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 /* No longer used; we use NULL, because a) it never happens, right? and b)
 587    Windows doesn't like DLL entry points being used as static initialisers
 588 STGFUN(stg_error_entry)                                                 \
 589 {                                                                       \
 590   FB_                                                                   \
 591     DUMP_ERRMSG("fatal: stg_error_entry");                              \
 592     STGCALL1(shutdownHaskellAndExit, EXIT_FAILURE);                     \
 593     return NULL;                                                        \
 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 };