X-Git-Url: http://git.megacz.com/?p=ghc-hetmet.git;a=blobdiff_plain;f=rts%2FStgStdThunks.cmm;h=fecbb4c3c0f2a72b6ecf8fea2a363e48bc08442e;hp=342a6eb1648a608065fed24371f102c385386767;hb=842e9d6628a27cf1f420d53f6a5901935dc50c54;hpb=0065d5ab628975892cea1ec7303f968c3338cbe1

diff --git a/rts/StgStdThunks.cmm b/rts/StgStdThunks.cmm
index 342a6eb..fecbb4c 100644
--- a/rts/StgStdThunks.cmm
+++ b/rts/StgStdThunks.cmm
@@ -32,19 +32,30 @@
 #ifdef PROFILING
 #define SAVE_CCCS(fs)  	StgHeader_ccs(Sp-fs) = W_[CCCS]
 #define GET_SAVED_CCCS  W_[CCCS] = StgHeader_ccs(Sp)
-#define RET_BITMAP    3
-#define RET_FRAMESIZE 2
+#define RET_PARAMS      W_ unused1, W_ unused2
 #else
 #define SAVE_CCCS(fs)   /* empty */
 #define GET_SAVED_CCCS  /* empty */
-#define RET_BITMAP    0
-#define RET_FRAMESIZE 0
+#define RET_PARAMS
 #endif
 
+/*
+ * TODO: On return, we can use a more efficient
+ *       untagging (we know the constructor tag).
+ * 
+ * When entering stg_sel_#_upd, we know R1 points to its closure,
+ * so it's untagged.
+ * The payload might be a thunk or a constructor,
+ * so we enter it.
+ *
+ * When returning, we know for sure it is a constructor,
+ * so we untag it before accessing the field.
+ *
+ */
 #define SELECTOR_CODE_UPD(offset) \
-  INFO_TABLE_RET(stg_sel_ret_##offset##_upd, RET_FRAMESIZE, RET_BITMAP, RET_SMALL)	\
+  INFO_TABLE_RET(stg_sel_ret_##offset##_upd, RET_SMALL, RET_PARAMS)	\
   {									\
-      R1 = StgClosure_payload(R1,offset);				\
+      R1 = StgClosure_payload(UNTAG(R1),offset);			\
       GET_SAVED_CCCS;							\
       Sp = Sp + SIZEOF_StgHeader;					\
       ENTER();								\
@@ -60,8 +71,11 @@
       ENTER_CCS_THUNK(R1);						\
       SAVE_CCCS(WITHUPD_FRAME_SIZE);					\
       W_[Sp-WITHUPD_FRAME_SIZE] = stg_sel_ret_##offset##_upd_info;	\
-      R1 = StgThunk_payload(R1,0);					\
       Sp = Sp - WITHUPD_FRAME_SIZE;					\
+      R1 = StgThunk_payload(R1,0);				        \
+      if (GETTAG(R1) != 0) {                                            \
+          jump RET_LBL(stg_sel_ret_##offset##_upd);		        \
+      }                                                                 \
       jump %GET_ENTRY(R1);						\
   }
   /* NOTE: no need to ENTER() here, we know the closure cannot evaluate to a function,
@@ -85,12 +99,12 @@ SELECTOR_CODE_UPD(14)
 SELECTOR_CODE_UPD(15)
 
 #define SELECTOR_CODE_NOUPD(offset) \
-  INFO_TABLE_RET(stg_sel_ret_##offset##_noupd, RET_FRAMESIZE, RET_BITMAP, RET_SMALL)	\
+  INFO_TABLE_RET(stg_sel_ret_##offset##_noupd, RET_SMALL, RET_PARAMS)	\
   {									\
-      R1 = StgClosure_payload(R1,offset);				\
+      R1 = StgClosure_payload(UNTAG(R1),offset);			\
       GET_SAVED_CCCS;							\
       Sp = Sp + SIZEOF_StgHeader;					\
-      jump %GET_ENTRY(R1);						\
+      ENTER();								\
   }									\
 									\
   INFO_TABLE_SELECTOR(stg_sel_##offset##_noupd, offset, THUNK_SELECTOR, "stg_sel_noupd", "stg_sel_noupd")\
@@ -103,8 +117,11 @@ SELECTOR_CODE_UPD(15)
       ENTER_CCS_THUNK(R1);						\
       SAVE_CCCS(NOUPD_FRAME_SIZE);					\
       W_[Sp-NOUPD_FRAME_SIZE] = stg_sel_ret_##offset##_noupd_info;	\
-      R1 = StgThunk_payload(R1,0);					\
       Sp = Sp - NOUPD_FRAME_SIZE;					\
+      R1 = StgThunk_payload(R1,0);					\
+      if (GETTAG(R1) != 0) {                                            \
+          jump RET_LBL(stg_sel_ret_##offset##_noupd);		        \
+      }                                                                 \
       jump %GET_ENTRY(R1);						\
   }
 
@@ -143,7 +160,7 @@ SELECTOR_CODE_NOUPD(15)
  * in the compiler that means stg_ap_1 is generated occasionally (ToDo)
  */
 
-INFO_TABLE(stg_ap_1_upd,1,1,THUNK_1_0,"stg_ap_1_upd_info","stg_ap_1_upd_info")
+INFO_TABLE(stg_ap_1_upd,1,0,THUNK_1_0,"stg_ap_1_upd_info","stg_ap_1_upd_info")
 {
   TICK_ENT_DYN_THK();
   STK_CHK_NP(SIZEOF_StgUpdateFrame+WDS(1));