ghc/rts/StgMiscClosures.hc

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