ghc/rts/StgMiscClosures.cmm

   1 /* ----------------------------------------------------------------------------
   2  *
   3  * (c) The GHC Team, 1998-2004
   4  *
   5  * Entry code for various built-in closure types.
   6  *
   7  * This file is written in a subset of C--, extended with various
   8  * features specific to GHC.  It is compiled by GHC directly.  For the
   9  * syntax of .cmm files, see the parser in ghc/compiler/cmm/CmmParse.y.
  10  *
  11  * --------------------------------------------------------------------------*/
  12
  13 #include "Cmm.h"
  14
  15 /* ----------------------------------------------------------------------------
  16    Support for the bytecode interpreter.
  17    ------------------------------------------------------------------------- */
  18
  19 /* 9 bits of return code for constructors created by the interpreter. */
  20 stg_interp_constr_entry
  21 {
  22     /* R1 points at the constructor */
  23     jump %ENTRY_CODE(Sp(0));
  24 }
  25
  26 stg_interp_constr1_entry { jump %RET_VEC(Sp(0),0); }
  27 stg_interp_constr2_entry { jump %RET_VEC(Sp(0),1); }
  28 stg_interp_constr3_entry { jump %RET_VEC(Sp(0),2); }
  29 stg_interp_constr4_entry { jump %RET_VEC(Sp(0),3); }
  30 stg_interp_constr5_entry { jump %RET_VEC(Sp(0),4); }
  31 stg_interp_constr6_entry { jump %RET_VEC(Sp(0),5); }
  32 stg_interp_constr7_entry { jump %RET_VEC(Sp(0),6); }
  33 stg_interp_constr8_entry { jump %RET_VEC(Sp(0),7); }
  34
  35 /* Some info tables to be used when compiled code returns a value to
  36    the interpreter, i.e. the interpreter pushes one of these onto the
  37    stack before entering a value.  What the code does is to
  38    impedance-match the compiled return convention (in R1p/R1n/F1/D1 etc) to
  39    the interpreter's convention (returned value is on top of stack),
  40    and then cause the scheduler to enter the interpreter.
  41
  42    On entry, the stack (growing down) looks like this:
  43
  44       ptr to BCO holding return continuation
  45       ptr to one of these info tables.
  46
  47    The info table code, both direct and vectored, must:
  48       * push R1/F1/D1 on the stack, and its tag if necessary
  49       * push the BCO (so it's now on the stack twice)
  50       * Yield, ie, go to the scheduler.
  51
  52    Scheduler examines the t.o.s, discovers it is a BCO, and proceeds
  53    directly to the bytecode interpreter.  That pops the top element
  54    (the BCO, containing the return continuation), and interprets it.
  55    Net result: return continuation gets interpreted, with the
  56    following stack:
  57
  58       ptr to this BCO
  59       ptr to the info table just jumped thru
  60       return value
  61
  62    which is just what we want -- the "standard" return layout for the
  63    interpreter.  Hurrah!
  64
  65    Don't ask me how unboxed tuple returns are supposed to work.  We
  66    haven't got a good story about that yet.
  67 */
  68
  69 INFO_TABLE_RET( stg_ctoi_R1p,
  70                 0/*size*/, 0/*bitmap*/,    /* special layout! */
  71                 RET_BCO,
  72                 RET_LBL(stg_ctoi_R1p),
  73                 RET_LBL(stg_ctoi_R1p),
  74                 RET_LBL(stg_ctoi_R1p),
  75                 RET_LBL(stg_ctoi_R1p),
  76                 RET_LBL(stg_ctoi_R1p),
  77                 RET_LBL(stg_ctoi_R1p),
  78                 RET_LBL(stg_ctoi_R1p),
  79                 RET_LBL(stg_ctoi_R1p))
  80 {
  81     Sp_adj(-2);
  82     Sp(1) = R1;
  83     Sp(0) = stg_enter_info;
  84     jump stg_yield_to_interpreter;
  85 }
  86
  87 #if MAX_VECTORED_RTN != 8
  88 #error MAX_VECTORED_RTN has changed: please modify stg_ctoi_R1p too.
  89 #endif
  90
  91 /*
  92  * When the returned value is a pointer, but unlifted, in R1 ...
  93  */
  94 INFO_TABLE_RET( stg_ctoi_R1unpt,
  95                 0/*size*/, 0/*bitmap*/,    /* special layout! */
  96                 RET_BCO )
  97 {
  98     Sp_adj(-2);
  99     Sp(1) = R1;
 100     Sp(0) = stg_gc_unpt_r1_info;
 101     jump stg_yield_to_interpreter;
 102 }
 103
 104 /*
 105  * When the returned value is a non-pointer in R1 ...
 106  */
 107 INFO_TABLE_RET( stg_ctoi_R1n,
 108                 0/*size*/, 0/*bitmap*/,    /* special layout! */
 109                 RET_BCO )
 110 {
 111     Sp_adj(-2);
 112     Sp(1) = R1;
 113     Sp(0) = stg_gc_unbx_r1_info;
 114     jump stg_yield_to_interpreter;
 115 }
 116
 117 /*
 118  * When the returned value is in F1
 119  */
 120 INFO_TABLE_RET( stg_ctoi_F1,
 121                 0/*size*/, 0/*bitmap*/,    /* special layout! */
 122                 RET_BCO )
 123 {
 124     Sp_adj(-2);
 125     F_[Sp + WDS(1)] = F1;
 126     Sp(0) = stg_gc_f1_info;
 127     jump stg_yield_to_interpreter;
 128 }
 129
 130 /*
 131  * When the returned value is in D1
 132  */
 133 INFO_TABLE_RET( stg_ctoi_D1,
 134                 0/*size*/, 0/*bitmap*/,    /* special layout! */
 135                 RET_BCO )
 136 {
 137     Sp_adj(-1) - SIZEOF_DOUBLE;
 138     D_[Sp + WDS(1)] = D1;
 139     Sp(0) = stg_gc_d1_info;
 140     jump stg_yield_to_interpreter;
 141 }
 142
 143 /*
 144  * When the returned value is in L1
 145  */
 146 INFO_TABLE_RET( stg_ctoi_L1,
 147                 0/*size*/, 0/*bitmap*/,    /* special layout! */
 148                 RET_BCO )
 149 {
 150     Sp_adj(-1) - 8;
 151     L_[Sp + WDS(1)] = L1;
 152     Sp(0) = stg_gc_l1_info;
 153     jump stg_yield_to_interpreter;
 154 }
 155
 156 /*
 157  * When the returned value is a void
 158  */
 159 INFO_TABLE_RET( stg_ctoi_V,
 160                 0/*size*/, 0/*bitmap*/,    /* special layout! */
 161                 RET_BCO )
 162 {
 163     Sp_adj(-1);
 164     Sp(0) = stg_gc_void_info;
 165     jump stg_yield_to_interpreter;
 166 }
 167
 168 /*
 169  * Dummy info table pushed on the top of the stack when the interpreter
 170  * should apply the BCO on the stack to its arguments, also on the
 171  * stack.
 172  */
 173 INFO_TABLE_RET( stg_apply_interp,
 174                 0/*size*/, 0/*bitmap*/,    /* special layout! */
 175                 RET_BCO )
 176 {
 177     /* Just in case we end up in here... (we shouldn't) */
 178     jump stg_yield_to_interpreter;
 179 }
 180
 181 /* ----------------------------------------------------------------------------
 182    Entry code for a BCO
 183    ------------------------------------------------------------------------- */
 184
 185 INFO_TABLE_FUN( stg_BCO, 4, 0, BCO, "BCO", "BCO", ARG_BCO )
 186 {
 187   /* entering a BCO means "apply it", same as a function */
 188   Sp_adj(-2);
 189   Sp(1) = R1;
 190   Sp(0) = stg_apply_interp_info;
 191   jump stg_yield_to_interpreter;
 192 }
 193
 194 /* ----------------------------------------------------------------------------
 195    Info tables for indirections.
 196
 197    SPECIALISED INDIRECTIONS: we have a specialised indirection for each
 198    kind of return (direct, vectored 0-7), so that we can avoid entering
 199    the object when we know what kind of return it will do.  The update
 200    code (Updates.hc) updates objects with the appropriate kind of
 201    indirection.  We only do this for young-gen indirections.
 202    ------------------------------------------------------------------------- */
 203
 204 INFO_TABLE(stg_IND,1,0,IND,"IND","IND")
 205 {
 206     TICK_ENT_DYN_IND(); /* tick */
 207     R1 = StgInd_indirectee(R1);
 208     TICK_ENT_VIA_NODE();
 209     jump %GET_ENTRY(R1);
 210 }
 211
 212 #define IND_SPEC(label,ret) \
 213 INFO_TABLE(label,1,0,IND,"IND","IND") \
 214 {                                               \
 215     TICK_ENT_DYN_IND(); /* tick */              \
 216     R1 = StgInd_indirectee(R1);                 \
 217     TICK_ENT_VIA_NODE();                        \
 218     jump ret;                                   \
 219 }
 220
 221 IND_SPEC(stg_IND_direct, %ENTRY_CODE(Sp(0)))
 222 IND_SPEC(stg_IND_0, %RET_VEC(Sp(0),0))
 223 IND_SPEC(stg_IND_1, %RET_VEC(Sp(0),1))
 224 IND_SPEC(stg_IND_2, %RET_VEC(Sp(0),2))
 225 IND_SPEC(stg_IND_3, %RET_VEC(Sp(0),3))
 226 IND_SPEC(stg_IND_4, %RET_VEC(Sp(0),4))
 227 IND_SPEC(stg_IND_5, %RET_VEC(Sp(0),5))
 228 IND_SPEC(stg_IND_6, %RET_VEC(Sp(0),6))
 229 IND_SPEC(stg_IND_7, %RET_VEC(Sp(0),7))
 230
 231 INFO_TABLE(stg_IND_STATIC,1,0,IND_STATIC,"IND_STATIC","IND_STATIC")
 232 {
 233     TICK_ENT_STATIC_IND();      /* tick */
 234     R1 = StgInd_indirectee(R1);
 235     TICK_ENT_VIA_NODE();
 236     jump %GET_ENTRY(R1);
 237 }
 238
 239 INFO_TABLE(stg_IND_PERM,1,1,IND_PERM,"IND_PERM","IND_PERM")
 240 {
 241     /* Don't add INDs to granularity cost */
 242
 243     /* Don't: TICK_ENT_STATIC_IND(Node); for ticky-ticky; this ind is
 244        here only to help profiling */
 245
 246 #if defined(TICKY_TICKY) && !defined(PROFILING)
 247     /* TICKY_TICKY && !PROFILING means PERM_IND *replaces* an IND, rather than
 248        being extra  */
 249     TICK_ENT_PERM_IND();
 250 #endif
 251
 252     LDV_ENTER(R1);
 253
 254     /* Enter PAP cost centre */
 255     ENTER_CCS_PAP_CL(R1);
 256
 257     /* For ticky-ticky, change the perm_ind to a normal ind on first
 258      * entry, so the number of ent_perm_inds is the number of *thunks*
 259      * entered again, not the number of subsequent entries.
 260      *
 261      * Since this screws up cost centres, we die if profiling and
 262      * ticky_ticky are on at the same time.  KSW 1999-01.
 263      */
 264 #ifdef TICKY_TICKY
 265 #  ifdef PROFILING
 266 #    error Profiling and ticky-ticky do not mix at present!
 267 #  endif  /* PROFILING */
 268     StgHeader_info(R1) = stg_IND_info;
 269 #endif /* TICKY_TICKY */
 270
 271     R1 = StgInd_indirectee(R1);
 272
 273 #if defined(TICKY_TICKY) && !defined(PROFILING)
 274     TICK_ENT_VIA_NODE();
 275 #endif
 276
 277     jump %GET_ENTRY(R1);
 278 }
 279
 280
 281 INFO_TABLE(stg_IND_OLDGEN,1,1,IND_OLDGEN,"IND_OLDGEN","IND_OLDGEN")
 282 {
 283     TICK_ENT_STATIC_IND();      /* tick */
 284     R1 = StgInd_indirectee(R1);
 285     TICK_ENT_VIA_NODE();
 286     jump %GET_ENTRY(R1);
 287 }
 288
 289 INFO_TABLE(stg_IND_OLDGEN_PERM,1,1,IND_OLDGEN_PERM,"IND_OLDGEN_PERM","IND_OLDGEN_PERM")
 290 {
 291     /* Don't: TICK_ENT_STATIC_IND(Node); for ticky-ticky;
 292        this ind is here only to help profiling */
 293
 294 #if defined(TICKY_TICKY) && !defined(PROFILING)
 295     /* TICKY_TICKY && !PROFILING means PERM_IND *replaces* an IND,
 296        rather than being extra  */
 297     TICK_ENT_PERM_IND(R1); /* tick */
 298 #endif
 299
 300     LDV_ENTER(R1);
 301
 302     /* Enter PAP cost centre -- lexical scoping only */
 303     ENTER_CCS_PAP_CL(R1);
 304
 305     /* see comment in IND_PERM */
 306 #ifdef TICKY_TICKY
 307 #  ifdef PROFILING
 308 #    error Profiling and ticky-ticky do not mix at present!
 309 #  endif  /* PROFILING */
 310     StgHeader_info(R1) = stg_IND_OLDGEN_info;
 311 #endif /* TICKY_TICKY */
 312
 313     R1 = StgInd_indirectee(R1);
 314
 315     TICK_ENT_VIA_NODE();
 316     jump %GET_ENTRY(R1);
 317 }
 318
 319 /* ----------------------------------------------------------------------------
 320    Black holes.
 321
 322    Entering a black hole normally causes a cyclic data dependency, but
 323    in the concurrent world, black holes are synchronization points,
 324    and they are turned into blocking queues when there are threads
 325    waiting for the evaluation of the closure to finish.
 326    ------------------------------------------------------------------------- */
 327
 328 /* Note: a BLACKHOLE and BLACKHOLE_BQ must be big enough to be
 329  * overwritten with an indirection/evacuee/catch.  Thus we claim it
 330  * has 1 non-pointer word of payload (in addition to the pointer word
 331  * for the blocking queue in a BQ), which should be big enough for an
 332  * old-generation indirection.
 333  */
 334 INFO_TABLE(stg_BLACKHOLE,0,2,BLACKHOLE,"BLACKHOLE","BLACKHOLE")
 335 {
 336 #if defined(GRAN)
 337     /* Before overwriting TSO_LINK */
 338     STGCALL3(GranSimBlock,CurrentTSO,CurrentProc,(StgClosure *)R1 /*Node*/);
 339 #endif
 340
 341     TICK_ENT_BH();
 342
 343     /* Actually this is not necessary because R1 is about to be destroyed. */
 344     LDV_ENTER(R1);
 345
 346     /* Put ourselves on the blocking queue for this black hole */
 347     StgTSO_link(CurrentTSO) = stg_END_TSO_QUEUE_closure;
 348     StgBlockingQueue_blocking_queue(R1) = CurrentTSO;
 349
 350     /* jot down why and on what closure we are blocked */
 351     StgTSO_why_blocked(CurrentTSO) = BlockedOnBlackHole::I16;
 352     StgTSO_block_info(CurrentTSO) = R1;
 353
 354     /* Change the BLACKHOLE into a BLACKHOLE_BQ */
 355 #ifdef PROFILING
 356     /* The size remains the same, so we call LDV_recordDead() -
 357         no need to fill slop. */
 358     foreign "C" LDV_recordDead(R1 "ptr", BYTES_TO_WDS(SIZEOF_StgBlockingQueue));
 359 #endif
 360     /*
 361      * Todo: maybe use SET_HDR() and remove LDV_RECORD_CREATE()?
 362      */
 363     StgHeader_info(R1) = stg_BLACKHOLE_BQ_info;
 364 #ifdef PROFILING
 365     foreign "C" LDV_RECORD_CREATE(R1);
 366 #endif
 367
 368     /* closure is mutable since something has just been added to its BQ */
 369     foreign "C" recordMutable(R1 "ptr");
 370
 371     /* PAR: dumping of event now done in blockThread -- HWL */
 372
 373     /* stg_gen_block is too heavyweight, use a specialised one */
 374     jump stg_block_1;
 375 }
 376
 377 INFO_TABLE(stg_BLACKHOLE_BQ,1,1,BLACKHOLE_BQ,"BLACKHOLE_BQ","BLACKHOLE_BQ")
 378 {
 379 #if defined(GRAN)
 380     /* Before overwriting TSO_LINK */
 381     STGCALL3(GranSimBlock,CurrentTSO,CurrentProc,(StgClosure *)R1 /*Node*/);
 382 #endif
 383
 384     TICK_ENT_BH();
 385     LDV_ENTER(R1);
 386
 387     /* Put ourselves on the blocking queue for this black hole */
 388     StgTSO_link(CurrentTSO) = StgBlockingQueue_blocking_queue(R1);
 389     StgBlockingQueue_blocking_queue(R1) = CurrentTSO;
 390
 391     /* jot down why and on what closure we are blocked */
 392     StgTSO_why_blocked(CurrentTSO) = BlockedOnBlackHole::I16;
 393     StgTSO_block_info(CurrentTSO) = R1;
 394
 395     /* PAR: dumping of event now done in blockThread -- HWL */
 396
 397     /* stg_gen_block is too heavyweight, use a specialised one */
 398     jump stg_block_1;
 399 }
 400
 401 /*
 402    Revertible black holes are needed in the parallel world, to handle
 403    negative acknowledgements of messages containing updatable closures.
 404    The idea is that when the original message is transmitted, the closure
 405    is turned into a revertible black hole...an object which acts like a
 406    black hole when local threads try to enter it, but which can be reverted
 407    back to the original closure if necessary.
 408
 409    It's actually a lot like a blocking queue (BQ) entry, because revertible
 410    black holes are initially set up with an empty blocking queue.
 411 */
 412
 413 #if defined(PAR) || defined(GRAN)
 414
 415 INFO_TABLE(stg_RBH,1,1,RBH,"RBH","RBH")
 416 {
 417 # if defined(GRAN)
 418     /* mainly statistics gathering for GranSim simulation */
 419     STGCALL3(GranSimBlock,CurrentTSO,CurrentProc,(StgClosure *)R1 /*Node*/);
 420 # endif
 421
 422     /* exactly the same as a BLACKHOLE_BQ_entry -- HWL */
 423     /* Put ourselves on the blocking queue for this black hole */
 424     TSO_link(CurrentTSO) = StgBlockingQueue_blocking_queue(R1);
 425     StgBlockingQueue_blocking_queue(R1) = CurrentTSO;
 426     /* jot down why and on what closure we are blocked */
 427     TSO_why_blocked(CurrentTSO) = BlockedOnBlackHole::I16;
 428     TSO_block_info(CurrentTSO) = R1;
 429
 430     /* PAR: dumping of event now done in blockThread -- HWL */
 431
 432     /* stg_gen_block is too heavyweight, use a specialised one */
 433     jump stg_block_1;
 434 }
 435
 436 INFO_TABLE(stg_RBH_Save_0,0,2,CONSTR,"RBH_Save_0","RBH_Save_0")
 437 { foreign "C" barf("RBH_Save_0 object entered!"); }
 438
 439 INFO_TABLE(stg_RBH_Save_1,1,1,CONSTR,"RBH_Save_1","RBH_Save_1");
 440 { foreign "C" barf("RBH_Save_1 object entered!"); }
 441
 442 INFO_TABLE(stg_RBH_Save_2,2,0,CONSTR,"RBH_Save_2","RBH_Save_2");
 443 { foreign "C" barf("RBH_Save_2 object entered!"); }
 444
 445 #endif /* defined(PAR) || defined(GRAN) */
 446
 447 /* identical to BLACKHOLEs except for the infotag */
 448 INFO_TABLE(stg_CAF_BLACKHOLE,0,2,CAF_BLACKHOLE,"CAF_BLACKHOLE","CAF_BLACKHOLE")
 449 {
 450 #if defined(GRAN)
 451     /* mainly statistics gathering for GranSim simulation */
 452     STGCALL3(GranSimBlock,CurrentTSO,CurrentProc,(StgClosure *)R1 /*Node*/);
 453 #endif
 454
 455     TICK_ENT_BH();
 456     LDV_ENTER(R1);
 457
 458     /* Put ourselves on the blocking queue for this black hole */
 459     StgTSO_link(CurrentTSO) = stg_END_TSO_QUEUE_closure;
 460     StgBlockingQueue_blocking_queue(R1) = CurrentTSO;
 461
 462     /* jot down why and on what closure we are blocked */
 463     StgTSO_why_blocked(CurrentTSO) = BlockedOnBlackHole::I16;
 464     StgTSO_block_info(CurrentTSO) = R1;
 465
 466     /* Change the CAF_BLACKHOLE into a BLACKHOLE_BQ_STATIC */
 467     StgHeader_info(R1) = stg_BLACKHOLE_BQ_info;
 468
 469     /* closure is mutable since something has just been added to its BQ */
 470     foreign "C" recordMutable(R1 "ptr");
 471
 472     /* PAR: dumping of event now done in blockThread -- HWL */
 473
 474     /* stg_gen_block is too heavyweight, use a specialised one */
 475     jump stg_block_1;
 476 }
 477
 478 #ifdef EAGER_BLACKHOLING
 479 INFO_TABLE(stg_SE_BLACKHOLE_info, stg_SE_BLACKHOLE_entry,0,2,SE_BLACKHOLE,,IF_,"SE_BLACKHOLE","SE_BLACKHOLE");
 480 IF_(stg_SE_BLACKHOLE_entry)
 481 {
 482     STGCALL3(fprintf,stderr,"SE_BLACKHOLE at %p entered!\n",R1);
 483     STGCALL1(shutdownHaskellAndExit,EXIT_FAILURE);
 484 }
 485
 486 INFO_TABLE(stg_SE_CAF_BLACKHOLE_info, SE_CAF_BLACKHOLE_entry,0,2,SE_CAF_BLACKHOLE,,IF_,"CAF_BLACKHOLE","CAF_BLACKHOLE");
 487 IF_(stg_SE_CAF_BLACKHOLE_entry)
 488 {
 489     STGCALL3(fprintf,stderr,"SE_CAF_BLACKHOLE at %p entered!\n",R1);
 490     STGCALL1(shutdownHaskellAndExit,EXIT_FAILURE);
 491 }
 492 #endif
 493
 494 /* ----------------------------------------------------------------------------
 495    Some static info tables for things that don't get entered, and
 496    therefore don't need entry code (i.e. boxed but unpointed objects)
 497    NON_ENTERABLE_ENTRY_CODE now defined at the beginning of the file
 498    ------------------------------------------------------------------------- */
 499
 500 INFO_TABLE(stg_TSO, 0,0,TSO, "TSO", "TSO")
 501 { foreign "C" barf("TSO object entered!"); }
 502
 503 /* ----------------------------------------------------------------------------
 504    Evacuees are left behind by the garbage collector.  Any attempt to enter
 505    one is a real bug.
 506    ------------------------------------------------------------------------- */
 507
 508 INFO_TABLE(stg_EVACUATED,1,0,EVACUATED,"EVACUATED","EVACUATED")
 509 { foreign "C" barf("EVACUATED object entered!"); }
 510
 511 /* ----------------------------------------------------------------------------
 512    Weak pointers
 513
 514    Live weak pointers have a special closure type.  Dead ones are just
 515    nullary constructors (although they live on the heap - we overwrite
 516    live weak pointers with dead ones).
 517    ------------------------------------------------------------------------- */
 518
 519 INFO_TABLE(stg_WEAK,0,4,WEAK,"WEAK","WEAK")
 520 { foreign "C" barf("WEAK object entered!"); }
 521
 522 /*
 523  * It's important when turning an existing WEAK into a DEAD_WEAK
 524  * (which is what finalizeWeak# does) that we don't lose the link
 525  * field and break the linked list of weak pointers.  Hence, we give
 526  * DEAD_WEAK 4 non-pointer fields, the same as WEAK.
 527  */
 528 INFO_TABLE_CONSTR(stg_DEAD_WEAK,0,4,0,CONSTR,"DEAD_WEAK","DEAD_WEAK")
 529 { foreign "C" barf("DEAD_WEAK object entered!"); }
 530
 531 /* ----------------------------------------------------------------------------
 532    NO_FINALIZER
 533
 534    This is a static nullary constructor (like []) that we use to mark an empty
 535    finalizer in a weak pointer object.
 536    ------------------------------------------------------------------------- */
 537
 538 INFO_TABLE_CONSTR(stg_NO_FINALIZER,0,0,0,CONSTR_NOCAF_STATIC,"NO_FINALIZER","NO_FINALIZER")
 539 { foreign "C" barf("NO_FINALIZER object entered!"); }
 540
 541 CLOSURE(stg_NO_FINALIZER_closure,stg_NO_FINALIZER);
 542
 543 /* ----------------------------------------------------------------------------
 544    Foreign Objects are unlifted and therefore never entered.
 545    ------------------------------------------------------------------------- */
 546
 547 INFO_TABLE(stg_FOREIGN,0,1,FOREIGN,"FOREIGN","FOREIGN")
 548 { foreign "C" barf("FOREIGN object entered!"); }
 549
 550 /* ----------------------------------------------------------------------------
 551    Stable Names are unlifted too.
 552    ------------------------------------------------------------------------- */
 553
 554 INFO_TABLE(stg_STABLE_NAME,0,1,STABLE_NAME,"STABLE_NAME","STABLE_NAME")
 555 { foreign "C" barf("STABLE_NAME object entered!"); }
 556
 557 /* ----------------------------------------------------------------------------
 558    MVars
 559
 560    There are two kinds of these: full and empty.  We need an info table
 561    and entry code for each type.
 562    ------------------------------------------------------------------------- */
 563
 564 INFO_TABLE(stg_FULL_MVAR,4,0,MVAR,"MVAR","MVAR")
 565 { foreign "C" barf("FULL_MVAR object entered!"); }
 566
 567 INFO_TABLE(stg_EMPTY_MVAR,4,0,MVAR,"MVAR","MVAR")
 568 { foreign "C" barf("EMPTY_MVAR object entered!"); }
 569
 570 /* -----------------------------------------------------------------------------
 571    STM
 572    -------------------------------------------------------------------------- */
 573
 574 INFO_TABLE(stg_TVAR, 0, 0, TVAR, "TVAR", "TVAR")
 575 { foreign "C" barf("TVAR object entered!"); }
 576
 577 INFO_TABLE(stg_TVAR_WAIT_QUEUE, 0, 0, TVAR_WAIT_QUEUE, "TVAR_WAIT_QUEUE", "TVAR_WAIT_QUEUE")
 578 { foreign "C" barf("TVAR_WAIT_QUEUE object entered!"); }
 579
 580 INFO_TABLE(stg_TREC_CHUNK, 0, 0, TREC_CHUNK, "TREC_CHUNK", "TREC_CHUNK")
 581 { foreign "C" barf("TREC_CHUNK object entered!"); }
 582
 583 INFO_TABLE(stg_TREC_HEADER, 0, 0, TREC_HEADER, "TREC_HEADER", "TREC_HEADER")
 584 { foreign "C" barf("TREC_HEADER object entered!"); }
 585
 586 INFO_TABLE_CONSTR(stg_END_STM_WAIT_QUEUE,0,0,0,CONSTR_NOCAF_STATIC,"END_STM_WAIT_QUEUE","END_STM_WAIT_QUEUE")
 587 { foreign "C" barf("END_STM_WAIT_QUEUE object entered!"); }
 588
 589 INFO_TABLE_CONSTR(stg_END_STM_CHUNK_LIST,0,0,0,CONSTR_NOCAF_STATIC,"END_STM_CHUNK_LIST","END_STM_CHUNK_LIST")
 590 { foreign "C" barf("END_STM_CHUNK_LIST object entered!"); }
 591
 592 INFO_TABLE_CONSTR(stg_NO_TREC,0,0,0,CONSTR_NOCAF_STATIC,"NO_TREC","NO_TREC")
 593 { foreign "C" barf("NO_TREC object entered!"); }
 594
 595 CLOSURE(stg_END_STM_WAIT_QUEUE_closure,stg_END_STM_WAIT_QUEUE);
 596
 597 CLOSURE(stg_END_STM_CHUNK_LIST_closure,stg_END_STM_CHUNK_LIST);
 598
 599 CLOSURE(stg_NO_TREC_closure,stg_NO_TREC);
 600
 601 /* ----------------------------------------------------------------------------
 602    END_TSO_QUEUE
 603
 604    This is a static nullary constructor (like []) that we use to mark the
 605    end of a linked TSO queue.
 606    ------------------------------------------------------------------------- */
 607
 608 INFO_TABLE_CONSTR(stg_END_TSO_QUEUE,0,0,0,CONSTR_NOCAF_STATIC,"END_TSO_QUEUE","END_TSO_QUEUE")
 609 { foreign "C" barf("END_TSO_QUEUE object entered!"); }
 610
 611 CLOSURE(stg_END_TSO_QUEUE_closure,stg_END_TSO_QUEUE);
 612
 613 /* ----------------------------------------------------------------------------
 614    Mutable lists
 615
 616    Mutable lists (used by the garbage collector) consist of a chain of
 617    StgMutClosures connected through their mut_link fields, ending in
 618    an END_MUT_LIST closure.
 619    ------------------------------------------------------------------------- */
 620
 621 INFO_TABLE_CONSTR(stg_END_MUT_LIST,0,0,0,CONSTR_NOCAF_STATIC,"END_MUT_LIST","END_MUT_LIST")
 622 { foreign "C" barf("END_MUT_LIST object entered!"); }
 623
 624 CLOSURE(stg_END_MUT_LIST_closure,stg_END_MUT_LIST);
 625
 626 INFO_TABLE(stg_MUT_CONS, 1, 1, MUT_CONS, "MUT_CONS", "MUT_CONS")
 627 { foreign "C" barf("MUT_CONS object entered!"); }
 628
 629 /* ----------------------------------------------------------------------------
 630    Exception lists
 631    ------------------------------------------------------------------------- */
 632
 633 INFO_TABLE_CONSTR(stg_END_EXCEPTION_LIST,0,0,0,CONSTR_NOCAF_STATIC,"END_EXCEPTION_LIST","END_EXCEPTION_LIST")
 634 { foreign "C" barf("END_EXCEPTION_LIST object entered!"); }
 635
 636 CLOSURE(stg_END_EXCEPTION_LIST_closure,stg_END_EXCEPTION_LIST);
 637
 638 INFO_TABLE(stg_EXCEPTION_CONS,1,1,CONSTR,"EXCEPTION_CONS","EXCEPTION_CONS")
 639 { foreign "C" barf("EXCEPTION_CONS object entered!"); }
 640
 641 /* ----------------------------------------------------------------------------
 642    Arrays
 643
 644    These come in two basic flavours: arrays of data (StgArrWords) and arrays of
 645    pointers (StgArrPtrs).  They all have a similar layout:
 646
 647         ___________________________
 648         | Info | No. of | data....
 649         |  Ptr | Words  |
 650         ---------------------------
 651
 652    These are *unpointed* objects: i.e. they cannot be entered.
 653
 654    ------------------------------------------------------------------------- */
 655
 656 INFO_TABLE(stg_ARR_WORDS, 0, 0, ARR_WORDS, "ARR_WORDS", "ARR_WORDS")
 657 { foreign "C" barf("ARR_WORDS object entered!"); }
 658
 659 INFO_TABLE(stg_MUT_ARR_PTRS, 0, 0, MUT_ARR_PTRS, "MUT_ARR_PTRS", "MUT_ARR_PTRS")
 660 { foreign "C" barf("MUT_ARR_PTRS object entered!"); }
 661
 662 INFO_TABLE(stg_MUT_ARR_PTRS_FROZEN, 0, 0, MUT_ARR_PTRS_FROZEN, "MUT_ARR_PTRS_FROZEN", "MUT_ARR_PTRS_FROZEN")
 663 { foreign "C" barf("MUT_ARR_PTRS_FROZEN object entered!"); }
 664
 665 /* ----------------------------------------------------------------------------
 666    Mutable Variables
 667    ------------------------------------------------------------------------- */
 668
 669 INFO_TABLE(stg_MUT_VAR, 1, 1, MUT_VAR, "MUT_VAR", "MUT_VAR")
 670 { foreign "C" barf("MUT_VAR object entered!"); }
 671
 672 /* ----------------------------------------------------------------------------
 673    Dummy return closure
 674
 675    Entering this closure will just return to the address on the top of the
 676    stack.  Useful for getting a thread in a canonical form where we can
 677    just enter the top stack word to start the thread.  (see deleteThread)
 678  * ------------------------------------------------------------------------- */
 679
 680 INFO_TABLE( stg_dummy_ret, 0, 0, CONSTR_NOCAF_STATIC, "DUMMY_RET", "DUMMY_RET")
 681 {
 682   jump %ENTRY_CODE(Sp(0));
 683 }
 684 CLOSURE(stg_dummy_ret_closure,stg_dummy_ret);
 685
 686 /* ----------------------------------------------------------------------------
 687    CHARLIKE and INTLIKE closures.
 688
 689    These are static representations of Chars and small Ints, so that
 690    we can remove dynamic Chars and Ints during garbage collection and
 691    replace them with references to the static objects.
 692    ------------------------------------------------------------------------- */
 693
 694 #if defined(ENABLE_WIN32_DLL_SUPPORT)
 695 /*
 696  * When sticking the RTS in a DLL, we delay populating the
 697  * Charlike and Intlike tables until load-time, which is only
 698  * when we've got the real addresses to the C# and I# closures.
 699  *
 700  */
 701 static INFO_TBL_CONST StgInfoTable czh_static_info;
 702 static INFO_TBL_CONST StgInfoTable izh_static_info;
 703 #define Char_hash_static_info czh_static_info
 704 #define Int_hash_static_info izh_static_info
 705 #else
 706 #define Char_hash_static_info GHCziBase_Czh_static
 707 #define Int_hash_static_info GHCziBase_Izh_static
 708 #endif
 709
 710
 711 #define CHARLIKE_HDR(n)  CLOSURE(Char_hash_static_info, n)
 712 #define INTLIKE_HDR(n)   CLOSURE(Int_hash_static_info, n)
 713
 714 /* put these in the *data* section, since the garbage collector relies
 715  * on the fact that static closures live in the data section.
 716  */
 717
 718 /* end the name with _closure, to convince the mangler this is a closure */
 719
 720 section "data" {
 721  stg_CHARLIKE_closure:
 722     CHARLIKE_HDR(0)
 723     CHARLIKE_HDR(1)
 724     CHARLIKE_HDR(2)
 725     CHARLIKE_HDR(3)
 726     CHARLIKE_HDR(4)
 727     CHARLIKE_HDR(5)
 728     CHARLIKE_HDR(6)
 729     CHARLIKE_HDR(7)
 730     CHARLIKE_HDR(8)
 731     CHARLIKE_HDR(9)
 732     CHARLIKE_HDR(10)
 733     CHARLIKE_HDR(11)
 734     CHARLIKE_HDR(12)
 735     CHARLIKE_HDR(13)
 736     CHARLIKE_HDR(14)
 737     CHARLIKE_HDR(15)
 738     CHARLIKE_HDR(16)
 739     CHARLIKE_HDR(17)
 740     CHARLIKE_HDR(18)
 741     CHARLIKE_HDR(19)
 742     CHARLIKE_HDR(20)
 743     CHARLIKE_HDR(21)
 744     CHARLIKE_HDR(22)
 745     CHARLIKE_HDR(23)
 746     CHARLIKE_HDR(24)
 747     CHARLIKE_HDR(25)
 748     CHARLIKE_HDR(26)
 749     CHARLIKE_HDR(27)
 750     CHARLIKE_HDR(28)
 751     CHARLIKE_HDR(29)
 752     CHARLIKE_HDR(30)
 753     CHARLIKE_HDR(31)
 754     CHARLIKE_HDR(32)
 755     CHARLIKE_HDR(33)
 756     CHARLIKE_HDR(34)
 757     CHARLIKE_HDR(35)
 758     CHARLIKE_HDR(36)
 759     CHARLIKE_HDR(37)
 760     CHARLIKE_HDR(38)
 761     CHARLIKE_HDR(39)
 762     CHARLIKE_HDR(40)
 763     CHARLIKE_HDR(41)
 764     CHARLIKE_HDR(42)
 765     CHARLIKE_HDR(43)
 766     CHARLIKE_HDR(44)
 767     CHARLIKE_HDR(45)
 768     CHARLIKE_HDR(46)
 769     CHARLIKE_HDR(47)
 770     CHARLIKE_HDR(48)
 771     CHARLIKE_HDR(49)
 772     CHARLIKE_HDR(50)
 773     CHARLIKE_HDR(51)
 774     CHARLIKE_HDR(52)
 775     CHARLIKE_HDR(53)
 776     CHARLIKE_HDR(54)
 777     CHARLIKE_HDR(55)
 778     CHARLIKE_HDR(56)
 779     CHARLIKE_HDR(57)
 780     CHARLIKE_HDR(58)
 781     CHARLIKE_HDR(59)
 782     CHARLIKE_HDR(60)
 783     CHARLIKE_HDR(61)
 784     CHARLIKE_HDR(62)
 785     CHARLIKE_HDR(63)
 786     CHARLIKE_HDR(64)
 787     CHARLIKE_HDR(65)
 788     CHARLIKE_HDR(66)
 789     CHARLIKE_HDR(67)
 790     CHARLIKE_HDR(68)
 791     CHARLIKE_HDR(69)
 792     CHARLIKE_HDR(70)
 793     CHARLIKE_HDR(71)
 794     CHARLIKE_HDR(72)
 795     CHARLIKE_HDR(73)
 796     CHARLIKE_HDR(74)
 797     CHARLIKE_HDR(75)
 798     CHARLIKE_HDR(76)
 799     CHARLIKE_HDR(77)
 800     CHARLIKE_HDR(78)
 801     CHARLIKE_HDR(79)
 802     CHARLIKE_HDR(80)
 803     CHARLIKE_HDR(81)
 804     CHARLIKE_HDR(82)
 805     CHARLIKE_HDR(83)
 806     CHARLIKE_HDR(84)
 807     CHARLIKE_HDR(85)
 808     CHARLIKE_HDR(86)
 809     CHARLIKE_HDR(87)
 810     CHARLIKE_HDR(88)
 811     CHARLIKE_HDR(89)
 812     CHARLIKE_HDR(90)
 813     CHARLIKE_HDR(91)
 814     CHARLIKE_HDR(92)
 815     CHARLIKE_HDR(93)
 816     CHARLIKE_HDR(94)
 817     CHARLIKE_HDR(95)
 818     CHARLIKE_HDR(96)
 819     CHARLIKE_HDR(97)
 820     CHARLIKE_HDR(98)
 821     CHARLIKE_HDR(99)
 822     CHARLIKE_HDR(100)
 823     CHARLIKE_HDR(101)
 824     CHARLIKE_HDR(102)
 825     CHARLIKE_HDR(103)
 826     CHARLIKE_HDR(104)
 827     CHARLIKE_HDR(105)
 828     CHARLIKE_HDR(106)
 829     CHARLIKE_HDR(107)
 830     CHARLIKE_HDR(108)
 831     CHARLIKE_HDR(109)
 832     CHARLIKE_HDR(110)
 833     CHARLIKE_HDR(111)
 834     CHARLIKE_HDR(112)
 835     CHARLIKE_HDR(113)
 836     CHARLIKE_HDR(114)
 837     CHARLIKE_HDR(115)
 838     CHARLIKE_HDR(116)
 839     CHARLIKE_HDR(117)
 840     CHARLIKE_HDR(118)
 841     CHARLIKE_HDR(119)
 842     CHARLIKE_HDR(120)
 843     CHARLIKE_HDR(121)
 844     CHARLIKE_HDR(122)
 845     CHARLIKE_HDR(123)
 846     CHARLIKE_HDR(124)
 847     CHARLIKE_HDR(125)
 848     CHARLIKE_HDR(126)
 849     CHARLIKE_HDR(127)
 850     CHARLIKE_HDR(128)
 851     CHARLIKE_HDR(129)
 852     CHARLIKE_HDR(130)
 853     CHARLIKE_HDR(131)
 854     CHARLIKE_HDR(132)
 855     CHARLIKE_HDR(133)
 856     CHARLIKE_HDR(134)
 857     CHARLIKE_HDR(135)
 858     CHARLIKE_HDR(136)
 859     CHARLIKE_HDR(137)
 860     CHARLIKE_HDR(138)
 861     CHARLIKE_HDR(139)
 862     CHARLIKE_HDR(140)
 863     CHARLIKE_HDR(141)
 864     CHARLIKE_HDR(142)
 865     CHARLIKE_HDR(143)
 866     CHARLIKE_HDR(144)
 867     CHARLIKE_HDR(145)
 868     CHARLIKE_HDR(146)
 869     CHARLIKE_HDR(147)
 870     CHARLIKE_HDR(148)
 871     CHARLIKE_HDR(149)
 872     CHARLIKE_HDR(150)
 873     CHARLIKE_HDR(151)
 874     CHARLIKE_HDR(152)
 875     CHARLIKE_HDR(153)
 876     CHARLIKE_HDR(154)
 877     CHARLIKE_HDR(155)
 878     CHARLIKE_HDR(156)
 879     CHARLIKE_HDR(157)
 880     CHARLIKE_HDR(158)
 881     CHARLIKE_HDR(159)
 882     CHARLIKE_HDR(160)
 883     CHARLIKE_HDR(161)
 884     CHARLIKE_HDR(162)
 885     CHARLIKE_HDR(163)
 886     CHARLIKE_HDR(164)
 887     CHARLIKE_HDR(165)
 888     CHARLIKE_HDR(166)
 889     CHARLIKE_HDR(167)
 890     CHARLIKE_HDR(168)
 891     CHARLIKE_HDR(169)
 892     CHARLIKE_HDR(170)
 893     CHARLIKE_HDR(171)
 894     CHARLIKE_HDR(172)
 895     CHARLIKE_HDR(173)
 896     CHARLIKE_HDR(174)
 897     CHARLIKE_HDR(175)
 898     CHARLIKE_HDR(176)
 899     CHARLIKE_HDR(177)
 900     CHARLIKE_HDR(178)
 901     CHARLIKE_HDR(179)
 902     CHARLIKE_HDR(180)
 903     CHARLIKE_HDR(181)
 904     CHARLIKE_HDR(182)
 905     CHARLIKE_HDR(183)
 906     CHARLIKE_HDR(184)
 907     CHARLIKE_HDR(185)
 908     CHARLIKE_HDR(186)
 909     CHARLIKE_HDR(187)
 910     CHARLIKE_HDR(188)
 911     CHARLIKE_HDR(189)
 912     CHARLIKE_HDR(190)
 913     CHARLIKE_HDR(191)
 914     CHARLIKE_HDR(192)
 915     CHARLIKE_HDR(193)
 916     CHARLIKE_HDR(194)
 917     CHARLIKE_HDR(195)
 918     CHARLIKE_HDR(196)
 919     CHARLIKE_HDR(197)
 920     CHARLIKE_HDR(198)
 921     CHARLIKE_HDR(199)
 922     CHARLIKE_HDR(200)
 923     CHARLIKE_HDR(201)
 924     CHARLIKE_HDR(202)
 925     CHARLIKE_HDR(203)
 926     CHARLIKE_HDR(204)
 927     CHARLIKE_HDR(205)
 928     CHARLIKE_HDR(206)
 929     CHARLIKE_HDR(207)
 930     CHARLIKE_HDR(208)
 931     CHARLIKE_HDR(209)
 932     CHARLIKE_HDR(210)
 933     CHARLIKE_HDR(211)
 934     CHARLIKE_HDR(212)
 935     CHARLIKE_HDR(213)
 936     CHARLIKE_HDR(214)
 937     CHARLIKE_HDR(215)
 938     CHARLIKE_HDR(216)
 939     CHARLIKE_HDR(217)
 940     CHARLIKE_HDR(218)
 941     CHARLIKE_HDR(219)
 942     CHARLIKE_HDR(220)
 943     CHARLIKE_HDR(221)
 944     CHARLIKE_HDR(222)
 945     CHARLIKE_HDR(223)
 946     CHARLIKE_HDR(224)
 947     CHARLIKE_HDR(225)
 948     CHARLIKE_HDR(226)
 949     CHARLIKE_HDR(227)
 950     CHARLIKE_HDR(228)
 951     CHARLIKE_HDR(229)
 952     CHARLIKE_HDR(230)
 953     CHARLIKE_HDR(231)
 954     CHARLIKE_HDR(232)
 955     CHARLIKE_HDR(233)
 956     CHARLIKE_HDR(234)
 957     CHARLIKE_HDR(235)
 958     CHARLIKE_HDR(236)
 959     CHARLIKE_HDR(237)
 960     CHARLIKE_HDR(238)
 961     CHARLIKE_HDR(239)
 962     CHARLIKE_HDR(240)
 963     CHARLIKE_HDR(241)
 964     CHARLIKE_HDR(242)
 965     CHARLIKE_HDR(243)
 966     CHARLIKE_HDR(244)
 967     CHARLIKE_HDR(245)
 968     CHARLIKE_HDR(246)
 969     CHARLIKE_HDR(247)
 970     CHARLIKE_HDR(248)
 971     CHARLIKE_HDR(249)
 972     CHARLIKE_HDR(250)
 973     CHARLIKE_HDR(251)
 974     CHARLIKE_HDR(252)
 975     CHARLIKE_HDR(253)
 976     CHARLIKE_HDR(254)
 977     CHARLIKE_HDR(255)
 978 }
 979
 980 section "data" {
 981  stg_INTLIKE_closure:
 982     INTLIKE_HDR(-16)    /* MIN_INTLIKE == -16 */
 983     INTLIKE_HDR(-15)
 984     INTLIKE_HDR(-14)
 985     INTLIKE_HDR(-13)
 986     INTLIKE_HDR(-12)
 987     INTLIKE_HDR(-11)
 988     INTLIKE_HDR(-10)
 989     INTLIKE_HDR(-9)
 990     INTLIKE_HDR(-8)
 991     INTLIKE_HDR(-7)
 992     INTLIKE_HDR(-6)
 993     INTLIKE_HDR(-5)
 994     INTLIKE_HDR(-4)
 995     INTLIKE_HDR(-3)
 996     INTLIKE_HDR(-2)
 997     INTLIKE_HDR(-1)
 998     INTLIKE_HDR(0)
 999     INTLIKE_HDR(1)
1000     INTLIKE_HDR(2)
1001     INTLIKE_HDR(3)
1002     INTLIKE_HDR(4)
1003     INTLIKE_HDR(5)
1004     INTLIKE_HDR(6)
1005     INTLIKE_HDR(7)
1006     INTLIKE_HDR(8)
1007     INTLIKE_HDR(9)
1008     INTLIKE_HDR(10)
1009     INTLIKE_HDR(11)
1010     INTLIKE_HDR(12)
1011     INTLIKE_HDR(13)
1012     INTLIKE_HDR(14)
1013     INTLIKE_HDR(15)
1014     INTLIKE_HDR(16)     /* MAX_INTLIKE == 16 */
1015 }