Implement unboxed sum primitive type
[ghc.git] / rts / StgMiscClosures.cmm
index e546dd5..70d219a 100644 (file)
@@ -32,8 +32,8 @@ INFO_TABLE_RET (stg_stack_underflow_frame, UNDERFLOW_FRAME,
     SAVE_STGREGS
 
     SAVE_THREAD_STATE();
-    ("ptr" ret_off) = foreign "C" threadStackUnderflow(MyCapability(),
-                                                       CurrentTSO);
+    (ret_off) = foreign "C" threadStackUnderflow(MyCapability() "ptr",
+                                                 CurrentTSO);
     LOAD_THREAD_STATE();
 
     RESTORE_STGREGS
@@ -47,6 +47,7 @@ INFO_TABLE_RET (stg_stack_underflow_frame, UNDERFLOW_FRAME,
 
 INFO_TABLE_RET (stg_restore_cccs, RET_SMALL, W_ info_ptr, W_ cccs)
 {
+    unwind Sp = Sp + WDS(2);
 #if defined(PROFILING)
     CCCS = Sp(1);
 #endif
@@ -199,6 +200,8 @@ INFO_TABLE_FUN( stg_BCO, 4, 0, BCO, "BCO", "BCO", ARG_BCO )
 {
   /* entering a BCO means "apply it", same as a function */
   Sp_adj(-2);
+  // Skip the stack check; the interpreter will do one before using
+  // the stack anyway.
   Sp(1) = R1;
   Sp(0) = stg_apply_interp_info;
   jump stg_yield_to_interpreter [];
@@ -255,45 +258,6 @@ INFO_TABLE(stg_IND_STATIC,1,0,IND_STATIC,"IND_STATIC","IND_STATIC")
     jump %GET_ENTRY(R1) [R1];
 }
 
-INFO_TABLE(stg_IND_PERM,1,0,IND_PERM,"IND_PERM","IND_PERM")
-    /* explicit stack */
-{
-    /* Don't add INDs to granularity cost */
-
-    /* Don't: TICK_ENT_STATIC_IND(Node); for ticky-ticky; this ind is
-       here only to help profiling */
-
-#if defined(TICKY_TICKY) && !defined(PROFILING)
-    /* TICKY_TICKY && !PROFILING means PERM_IND *replaces* an IND, rather than
-       being extra  */
-    TICK_ENT_PERM_IND();
-#endif
-
-    LDV_ENTER(R1);
-
-    /* For ticky-ticky, change the perm_ind to a normal ind on first
-     * entry, so the number of ent_perm_inds is the number of *thunks*
-     * entered again, not the number of subsequent entries.
-     *
-     * Since this screws up cost centres, we die if profiling and
-     * ticky_ticky are on at the same time.  KSW 1999-01.
-     */
-#ifdef TICKY_TICKY
-#  ifdef PROFILING
-#    error Profiling and ticky-ticky do not mix at present!
-#  endif  /* PROFILING */
-    StgHeader_info(R1) = stg_IND_info;
-#endif /* TICKY_TICKY */
-
-    R1 = UNTAG(StgInd_indirectee(R1));
-
-#if defined(TICKY_TICKY) && !defined(PROFILING)
-    TICK_ENT_VIA_NODE();
-#endif
-
-    jump %GET_ENTRY(R1) [R1];
-}
-
 /* ----------------------------------------------------------------------------
    Black holes.
 
@@ -352,17 +316,12 @@ retry:
     }
 }
 
-INFO_TABLE(__stg_EAGER_BLACKHOLE,1,0,BLACKHOLE,"BLACKHOLE","BLACKHOLE")
-    (P_ node)
-{
-    jump ENTRY_LBL(stg_BLACKHOLE) (node);
-}
-
 // CAF_BLACKHOLE is allocated when entering a CAF.  The reason it is
 // distinct from BLACKHOLE is so that we can tell the difference
 // between an update frame on the stack that points to a CAF under
 // evaluation, and one that points to a closure that is under
-// evaluation by another thread (a BLACKHOLE).  See threadPaused().
+// evaluation by another thread (a BLACKHOLE).  see Note [suspend
+// duplicate work] in ThreadPaused.c
 //
 INFO_TABLE(stg_CAF_BLACKHOLE,1,0,BLACKHOLE,"BLACKHOLE","BLACKHOLE")
     (P_ node)
@@ -370,6 +329,13 @@ INFO_TABLE(stg_CAF_BLACKHOLE,1,0,BLACKHOLE,"BLACKHOLE","BLACKHOLE")
     jump ENTRY_LBL(stg_BLACKHOLE) (node);
 }
 
+// EAGER_BLACKHOLE exists for the same reason as CAF_BLACKHOLE (see above).
+INFO_TABLE(__stg_EAGER_BLACKHOLE,1,0,BLACKHOLE,"BLACKHOLE","BLACKHOLE")
+    (P_ node)
+{
+    jump ENTRY_LBL(stg_BLACKHOLE) (node);
+}
+
 INFO_TABLE(stg_BLOCKING_QUEUE_CLEAN,4,0,BLOCKING_QUEUE,"BLOCKING_QUEUE","BLOCKING_QUEUE")
 { foreign "C" barf("BLOCKING_QUEUE_CLEAN object entered!") never returns; }
 
@@ -418,6 +384,9 @@ INFO_TABLE(stg_TSO, 0,0,TSO, "TSO", "TSO")
 INFO_TABLE(stg_STACK, 0,0, STACK, "STACK", "STACK")
 { foreign "C" barf("STACK object entered!") never returns; }
 
+INFO_TABLE(stg_RUBBISH_ENTRY, 0, 0, THUNK, "RUBBISH_ENTRY", "RUBBISH_ENTRY")
+{ foreign "C" barf("RUBBISH object entered!") never returns; }
+
 /* ----------------------------------------------------------------------------
    Weak pointers
 
@@ -457,7 +426,7 @@ INFO_TABLE_CONSTR(stg_C_FINALIZER_LIST,1,4,0,CONSTR,"C_FINALIZER_LIST","C_FINALI
 INFO_TABLE_CONSTR(stg_NO_FINALIZER,0,0,0,CONSTR_NOCAF_STATIC,"NO_FINALIZER","NO_FINALIZER")
 { foreign "C" barf("NO_FINALIZER object entered!") never returns; }
 
-CLOSURE(stg_NO_FINALIZER);
+CLOSURE(stg_NO_FINALIZER_closure,stg_NO_FINALIZER);
 
 /* ----------------------------------------------------------------------------
    Stable Names are unlifted too.
@@ -516,13 +485,13 @@ INFO_TABLE_CONSTR(stg_END_STM_CHUNK_LIST,0,0,0,CONSTR_NOCAF_STATIC,"END_STM_CHUN
 INFO_TABLE_CONSTR(stg_NO_TREC,0,0,0,CONSTR_NOCAF_STATIC,"NO_TREC","NO_TREC")
 { foreign "C" barf("NO_TREC object entered!") never returns; }
 
-CLOSURE(stg_END_STM_WATCH_QUEUE);
+CLOSURE(stg_END_STM_WATCH_QUEUE_closure,stg_END_STM_WATCH_QUEUE);
 
-CLOSURE(stg_END_INVARIANT_CHECK_QUEUE);
+CLOSURE(stg_END_INVARIANT_CHECK_QUEUE_closure,stg_END_INVARIANT_CHECK_QUEUE);
 
-CLOSURE(stg_END_STM_CHUNK_LIST);
+CLOSURE(stg_END_STM_CHUNK_LIST_closure,stg_END_STM_CHUNK_LIST);
 
-CLOSURE(stg_NO_TREC);
+CLOSURE(stg_NO_TREC_closure,stg_NO_TREC);
 
 /* ----------------------------------------------------------------------------
    Messages
@@ -553,7 +522,7 @@ INFO_TABLE_CONSTR(stg_MSG_NULL,1,0,0,PRIM,"MSG_NULL","MSG_NULL")
 INFO_TABLE_CONSTR(stg_END_TSO_QUEUE,0,0,0,CONSTR_NOCAF_STATIC,"END_TSO_QUEUE","END_TSO_QUEUE")
 { foreign "C" barf("END_TSO_QUEUE object entered!") never returns; }
 
-CLOSURE(stg_END_TSO_QUEUE);
+CLOSURE(stg_END_TSO_QUEUE_closure,stg_END_TSO_QUEUE);
 
 /* ----------------------------------------------------------------------------
    GCD_CAF
@@ -572,7 +541,7 @@ INFO_TABLE_CONSTR(stg_GCD_CAF,0,0,0,CONSTR_NOCAF_STATIC,"GCD_CAF","GCD_CAF")
 INFO_TABLE_CONSTR(stg_STM_AWOKEN,0,0,0,CONSTR_NOCAF_STATIC,"STM_AWOKEN","STM_AWOKEN")
 { foreign "C" barf("STM_AWOKEN object entered!") never returns; }
 
-CLOSURE(stg_STM_AWOKEN);
+CLOSURE(stg_STM_AWOKEN_closure,stg_STM_AWOKEN);
 
 /* ----------------------------------------------------------------------------
    Arrays
@@ -638,7 +607,7 @@ INFO_TABLE( stg_dummy_ret, 0, 0, CONSTR_NOCAF_STATIC, "DUMMY_RET", "DUMMY_RET")
 {
     return ();
 }
-CLOSURE(stg_dummy_ret);
+CLOSURE(stg_dummy_ret_closure,stg_dummy_ret);
 
 /* ----------------------------------------------------------------------------
    MVAR_TSO_QUEUE
@@ -648,6 +617,18 @@ INFO_TABLE_CONSTR(stg_MVAR_TSO_QUEUE,2,0,0,PRIM,"MVAR_TSO_QUEUE","MVAR_TSO_QUEUE
 { foreign "C" barf("MVAR_TSO_QUEUE object entered!") never returns; }
 
 /* ----------------------------------------------------------------------------
+   COMPACT_NFDATA (a blob of data in NF with no outgoing pointers)
+
+   Just return immediately because the structure is in NF already
+   ------------------------------------------------------------------------- */
+
+INFO_TABLE( stg_COMPACT_NFDATA, 0, 0, COMPACT_NFDATA, "COMPACT_NFDATA", "COMPACT_NFDATA")
+    ()
+{
+    return ();
+}
+
+/* ----------------------------------------------------------------------------
    CHARLIKE and INTLIKE closures.
 
    These are static representations of Chars and small Ints, so that
@@ -673,8 +654,8 @@ INFO_TABLE_CONSTR(stg_MVAR_TSO_QUEUE,2,0,0,PRIM,"MVAR_TSO_QUEUE","MVAR_TSO_QUEUE
 #endif
 
 
-#define CHARLIKE_HDR(n)  ANONYMOUS_CLOSURE(Char_hash_static_info, n)
-#define INTLIKE_HDR(n)   ANONYMOUS_CLOSURE(Int_hash_static_info, n)
+#define CHARLIKE_HDR(n)  CLOSURE(Char_hash_static_info, n)
+#define INTLIKE_HDR(n)   CLOSURE(Int_hash_static_info, n)
 
 /* put these in the *data* section, since the garbage collector relies
  * on the fact that static closures live in the data section.
@@ -682,7 +663,7 @@ INFO_TABLE_CONSTR(stg_MVAR_TSO_QUEUE,2,0,0,PRIM,"MVAR_TSO_QUEUE","MVAR_TSO_QUEUE
 
 #if !(defined(COMPILING_WINDOWS_DLL))
 section "data" {
- stg_CHARLIKE_static_closure:
+ stg_CHARLIKE_closure:
     CHARLIKE_HDR(0)
     CHARLIKE_HDR(1)
     CHARLIKE_HDR(2)
@@ -942,7 +923,7 @@ section "data" {
 }
 
 section "data" {
- stg_INTLIKE_static_closure:
+ stg_INTLIKE_closure:
     INTLIKE_HDR(-16) /* MIN_INTLIKE == -16 */
     INTLIKE_HDR(-15)
     INTLIKE_HDR(-14)