Build RTS as dynamic library
[ghc-hetmet.git] / rts / StgMiscClosures.cmm
index fca5bf4..ebf9e92 100644 (file)
@@ -23,15 +23,6 @@ stg_interp_constr_entry
     jump %ENTRY_CODE(Sp(0));
 }
 
-stg_interp_constr1_entry { jump %RET_VEC(Sp(0),0); }
-stg_interp_constr2_entry { jump %RET_VEC(Sp(0),1); }
-stg_interp_constr3_entry { jump %RET_VEC(Sp(0),2); }
-stg_interp_constr4_entry { jump %RET_VEC(Sp(0),3); }
-stg_interp_constr5_entry { jump %RET_VEC(Sp(0),4); }
-stg_interp_constr6_entry { jump %RET_VEC(Sp(0),5); }
-stg_interp_constr7_entry { jump %RET_VEC(Sp(0),6); }
-stg_interp_constr8_entry { jump %RET_VEC(Sp(0),7); }
-
 /* Some info tables to be used when compiled code returns a value to
    the interpreter, i.e. the interpreter pushes one of these onto the
    stack before entering a value.  What the code does is to
@@ -66,17 +57,7 @@ stg_interp_constr8_entry { jump %RET_VEC(Sp(0),7); }
    haven't got a good story about that yet.
 */
 
-INFO_TABLE_RET( stg_ctoi_R1p, 
-               0/*size*/, 0/*bitmap*/,    /* special layout! */
-               RET_BCO,
-               RET_LBL(stg_ctoi_R1p),
-               RET_LBL(stg_ctoi_R1p),
-               RET_LBL(stg_ctoi_R1p),
-               RET_LBL(stg_ctoi_R1p),
-               RET_LBL(stg_ctoi_R1p),
-               RET_LBL(stg_ctoi_R1p),
-               RET_LBL(stg_ctoi_R1p),
-               RET_LBL(stg_ctoi_R1p))
+INFO_TABLE_RET( stg_ctoi_R1p, RET_BCO)
 {
     Sp_adj(-2);
     Sp(1) = R1;
@@ -84,16 +65,10 @@ INFO_TABLE_RET( stg_ctoi_R1p,
     jump stg_yield_to_interpreter;
 }
 
-#if MAX_VECTORED_RTN != 8
-#error MAX_VECTORED_RTN has changed: please modify stg_ctoi_R1p too.
-#endif
-
 /*
  * When the returned value is a pointer, but unlifted, in R1 ... 
  */
-INFO_TABLE_RET( stg_ctoi_R1unpt,
-               0/*size*/, 0/*bitmap*/,    /* special layout! */
-               RET_BCO )
+INFO_TABLE_RET( stg_ctoi_R1unpt, RET_BCO )
 {
     Sp_adj(-2);
     Sp(1) = R1;
@@ -104,9 +79,7 @@ INFO_TABLE_RET( stg_ctoi_R1unpt,
 /*
  * When the returned value is a non-pointer in R1 ...
  */
-INFO_TABLE_RET( stg_ctoi_R1n,
-               0/*size*/, 0/*bitmap*/,    /* special layout! */
-               RET_BCO )
+INFO_TABLE_RET( stg_ctoi_R1n, RET_BCO )
 {
     Sp_adj(-2);
     Sp(1) = R1;
@@ -117,9 +90,7 @@ INFO_TABLE_RET( stg_ctoi_R1n,
 /*
  * When the returned value is in F1
  */
-INFO_TABLE_RET( stg_ctoi_F1,
-               0/*size*/, 0/*bitmap*/,    /* special layout! */
-               RET_BCO )
+INFO_TABLE_RET( stg_ctoi_F1, RET_BCO )
 {
     Sp_adj(-2);
     F_[Sp + WDS(1)] = F1;
@@ -130,9 +101,7 @@ INFO_TABLE_RET( stg_ctoi_F1,
 /*
  * When the returned value is in D1
  */
-INFO_TABLE_RET( stg_ctoi_D1,
-               0/*size*/, 0/*bitmap*/,    /* special layout! */
-               RET_BCO )
+INFO_TABLE_RET( stg_ctoi_D1, RET_BCO )
 {
     Sp_adj(-1) - SIZEOF_DOUBLE;
     D_[Sp + WDS(1)] = D1;
@@ -143,9 +112,7 @@ INFO_TABLE_RET( stg_ctoi_D1,
 /*
  * When the returned value is in L1
  */
-INFO_TABLE_RET( stg_ctoi_L1,
-               0/*size*/, 0/*bitmap*/,    /* special layout! */
-               RET_BCO )
+INFO_TABLE_RET( stg_ctoi_L1, RET_BCO )
 {
     Sp_adj(-1) - 8;
     L_[Sp + WDS(1)] = L1;
@@ -156,9 +123,7 @@ INFO_TABLE_RET( stg_ctoi_L1,
 /*
  * When the returned value is a void
  */
-INFO_TABLE_RET( stg_ctoi_V,
-               0/*size*/, 0/*bitmap*/,    /* special layout! */
-               RET_BCO )
+INFO_TABLE_RET( stg_ctoi_V, RET_BCO )
 {
     Sp_adj(-1);
     Sp(0) = stg_gc_void_info;
@@ -170,9 +135,7 @@ INFO_TABLE_RET( stg_ctoi_V,
  * should apply the BCO on the stack to its arguments, also on the
  * stack.
  */
-INFO_TABLE_RET( stg_apply_interp,
-               0/*size*/, 0/*bitmap*/,    /* special layout! */
-               RET_BCO )
+INFO_TABLE_RET( stg_apply_interp, RET_BCO )
 {
     /* Just in case we end up in here... (we shouldn't) */
     jump stg_yield_to_interpreter;
@@ -194,44 +157,33 @@ INFO_TABLE_FUN( stg_BCO, 4, 0, BCO, "BCO", "BCO", ARG_BCO )
 /* ----------------------------------------------------------------------------
    Info tables for indirections.
 
-   SPECIALISED INDIRECTIONS: we have a specialised indirection for each
-   kind of return (direct, vectored 0-7), so that we can avoid entering
-   the object when we know what kind of return it will do.  The update
-   code (Updates.hc) updates objects with the appropriate kind of
+   SPECIALISED INDIRECTIONS: we have a specialised indirection for direct returns,
+   so that we can avoid entering
+   the object when we know it points directly to a value.  The update
+   code (Updates.cmm) updates objects with the appropriate kind of
    indirection.  We only do this for young-gen indirections.
    ------------------------------------------------------------------------- */
 
 INFO_TABLE(stg_IND,1,0,IND,"IND","IND")
 {
     TICK_ENT_DYN_IND();        /* tick */
-    R1 = StgInd_indirectee(R1);
+    R1 = UNTAG(StgInd_indirectee(R1));
     TICK_ENT_VIA_NODE();
     jump %GET_ENTRY(R1);
 }
 
-#define IND_SPEC(label,ret) \
-INFO_TABLE(label,1,0,IND,"IND","IND") \
-{                                              \
-    TICK_ENT_DYN_IND();        /* tick */              \
-    R1 = StgInd_indirectee(R1);                        \
-    TICK_ENT_VIA_NODE();                       \
-    jump ret;                                  \
+INFO_TABLE(stg_IND_direct,1,0,IND,"IND","IND")
+{
+    TICK_ENT_DYN_IND();        /* tick */
+    R1 = StgInd_indirectee(R1);
+    TICK_ENT_VIA_NODE();
+    jump %ENTRY_CODE(Sp(0));
 }
 
-IND_SPEC(stg_IND_direct, %ENTRY_CODE(Sp(0)))
-IND_SPEC(stg_IND_0, %RET_VEC(Sp(0),0))
-IND_SPEC(stg_IND_1, %RET_VEC(Sp(0),1))
-IND_SPEC(stg_IND_2, %RET_VEC(Sp(0),2))
-IND_SPEC(stg_IND_3, %RET_VEC(Sp(0),3))
-IND_SPEC(stg_IND_4, %RET_VEC(Sp(0),4))
-IND_SPEC(stg_IND_5, %RET_VEC(Sp(0),5))
-IND_SPEC(stg_IND_6, %RET_VEC(Sp(0),6))
-IND_SPEC(stg_IND_7, %RET_VEC(Sp(0),7))
-
 INFO_TABLE(stg_IND_STATIC,1,0,IND_STATIC,"IND_STATIC","IND_STATIC")
 {
     TICK_ENT_STATIC_IND();     /* tick */
-    R1 = StgInd_indirectee(R1);
+    R1 = UNTAG(StgInd_indirectee(R1));
     TICK_ENT_VIA_NODE();
     jump %GET_ENTRY(R1);
 }
@@ -268,7 +220,7 @@ INFO_TABLE(stg_IND_PERM,1,0,IND_PERM,"IND_PERM","IND_PERM")
     StgHeader_info(R1) = stg_IND_info;
 #endif /* TICKY_TICKY */
 
-    R1 = StgInd_indirectee(R1);
+    R1 = UNTAG(StgInd_indirectee(R1));
 
 #if defined(TICKY_TICKY) && !defined(PROFILING)
     TICK_ENT_VIA_NODE();
@@ -281,7 +233,7 @@ INFO_TABLE(stg_IND_PERM,1,0,IND_PERM,"IND_PERM","IND_PERM")
 INFO_TABLE(stg_IND_OLDGEN,1,0,IND_OLDGEN,"IND_OLDGEN","IND_OLDGEN")
 {
     TICK_ENT_STATIC_IND();     /* tick */
-    R1 = StgInd_indirectee(R1);
+    R1 = UNTAG(StgInd_indirectee(R1));
     TICK_ENT_VIA_NODE();
     jump %GET_ENTRY(R1);
 }
@@ -294,7 +246,7 @@ INFO_TABLE(stg_IND_OLDGEN_PERM,1,0,IND_OLDGEN_PERM,"IND_OLDGEN_PERM","IND_OLDGEN
 #if defined(TICKY_TICKY) && !defined(PROFILING)
     /* TICKY_TICKY && !PROFILING means PERM_IND *replaces* an IND, 
        rather than being extra  */
-    TICK_ENT_PERM_IND(R1); /* tick */
+    TICK_ENT_PERM_IND(); /* tick */
 #endif
 
     LDV_ENTER(R1);
@@ -310,7 +262,7 @@ INFO_TABLE(stg_IND_OLDGEN_PERM,1,0,IND_OLDGEN_PERM,"IND_OLDGEN_PERM","IND_OLDGEN
     StgHeader_info(R1) = stg_IND_OLDGEN_info;
 #endif /* TICKY_TICKY */
 
-    R1 = StgInd_indirectee(R1);
+    R1 = UNTAG(StgInd_indirectee(R1));
 
     TICK_ENT_VIA_NODE();
     jump %GET_ENTRY(R1);
@@ -520,8 +472,14 @@ INFO_TABLE(stg_EMPTY_MVAR,3,0,MVAR,"MVAR","MVAR")
 INFO_TABLE(stg_TVAR, 0, 0, TVAR, "TVAR", "TVAR")
 { foreign "C" barf("TVAR object entered!"); }
 
-INFO_TABLE(stg_TVAR_WAIT_QUEUE, 0, 0, TVAR_WAIT_QUEUE, "TVAR_WAIT_QUEUE", "TVAR_WAIT_QUEUE")
-{ foreign "C" barf("TVAR_WAIT_QUEUE object entered!"); }
+INFO_TABLE(stg_TVAR_WATCH_QUEUE, 0, 0, TVAR_WATCH_QUEUE, "TVAR_WATCH_QUEUE", "TVAR_WATCH_QUEUE")
+{ foreign "C" barf("TVAR_WATCH_QUEUE object entered!"); }
+
+INFO_TABLE(stg_ATOMIC_INVARIANT, 0, 0, ATOMIC_INVARIANT, "ATOMIC_INVARIANT", "ATOMIC_INVARIANT")
+{ foreign "C" barf("ATOMIC_INVARIANT object entered!"); }
+
+INFO_TABLE(stg_INVARIANT_CHECK_QUEUE, 0, 0, INVARIANT_CHECK_QUEUE, "INVARIANT_CHECK_QUEUE", "INVARIANT_CHECK_QUEUE")
+{ foreign "C" barf("INVARIANT_CHECK_QUEUE object entered!"); }
 
 INFO_TABLE(stg_TREC_CHUNK, 0, 0, TREC_CHUNK, "TREC_CHUNK", "TREC_CHUNK")
 { foreign "C" barf("TREC_CHUNK object entered!"); }
@@ -529,8 +487,11 @@ INFO_TABLE(stg_TREC_CHUNK, 0, 0, TREC_CHUNK, "TREC_CHUNK", "TREC_CHUNK")
 INFO_TABLE(stg_TREC_HEADER, 0, 0, TREC_HEADER, "TREC_HEADER", "TREC_HEADER")
 { foreign "C" barf("TREC_HEADER object entered!"); }
 
-INFO_TABLE_CONSTR(stg_END_STM_WAIT_QUEUE,0,0,0,CONSTR_NOCAF_STATIC,"END_STM_WAIT_QUEUE","END_STM_WAIT_QUEUE")
-{ foreign "C" barf("END_STM_WAIT_QUEUE object entered!"); }
+INFO_TABLE_CONSTR(stg_END_STM_WATCH_QUEUE,0,0,0,CONSTR_NOCAF_STATIC,"END_STM_WATCH_QUEUE","END_STM_WATCH_QUEUE")
+{ foreign "C" barf("END_STM_WATCH_QUEUE object entered!"); }
+
+INFO_TABLE_CONSTR(stg_END_INVARIANT_CHECK_QUEUE,0,0,0,CONSTR_NOCAF_STATIC,"END_INVARIANT_CHECK_QUEUE","END_INVARIANT_CHECK_QUEUE")
+{ foreign "C" barf("END_INVARIANT_CHECK_QUEUE object entered!"); }
 
 INFO_TABLE_CONSTR(stg_END_STM_CHUNK_LIST,0,0,0,CONSTR_NOCAF_STATIC,"END_STM_CHUNK_LIST","END_STM_CHUNK_LIST")
 { foreign "C" barf("END_STM_CHUNK_LIST object entered!"); }
@@ -538,7 +499,9 @@ 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!"); }
 
-CLOSURE(stg_END_STM_WAIT_QUEUE_closure,stg_END_STM_WAIT_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_STM_CHUNK_LIST_closure,stg_END_STM_CHUNK_LIST);
 
@@ -629,7 +592,7 @@ CLOSURE(stg_dummy_ret_closure,stg_dummy_ret);
    replace them with references to the static objects.
    ------------------------------------------------------------------------- */
 
-#if defined(ENABLE_WIN32_DLL_SUPPORT)
+#if defined(__PIC__) && defined(mingw32_TARGET_OS)
 /*
  * When sticking the RTS in a DLL, we delay populating the
  * Charlike and Intlike tables until load-time, which is only