--- /dev/null
+/* -----------------------------------------------------------------------------
+ *
+ * (c) The University of Glasgow, 1998-2004
+ *
+ * Canned "Standard Form" Thunks
+ *
+ * This file is written in a subset of C--, extended with various
+ * features specific to GHC. It is compiled by GHC directly. For the
+ * syntax of .cmm files, see the parser in ghc/compiler/cmm/CmmParse.y.
+ *
+ * ---------------------------------------------------------------------------*/
+
+#include "Cmm.h"
+
+/* -----------------------------------------------------------------------------
+ The code for a thunk that simply extracts a field from a
+ single-constructor datatype depends only on the offset of the field
+ to be selected.
+
+ Here we define some canned "selector" thunks that do just that; any
+ selector thunk appearing in a program will refer to one of these
+ instead of being compiled independently.
+
+ The garbage collector spots selector thunks and reduces them if
+ possible, in order to avoid space leaks resulting from lazy pattern
+ matching.
+ -------------------------------------------------------------------------- */
+
+#define WITHUPD_FRAME_SIZE (SIZEOF_StgUpdateFrame + SIZEOF_StgHeader)
+#define NOUPD_FRAME_SIZE (SIZEOF_StgHeader)
+
+#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
+#else
+#define SAVE_CCCS(fs) /* empty */
+#define GET_SAVED_CCCS /* empty */
+#define RET_BITMAP 0
+#define RET_FRAMESIZE 0
+#endif
+
+#define SELECTOR_CODE_UPD(offset) \
+ INFO_TABLE_RET(stg_sel_ret_##offset##_upd, RET_FRAMESIZE, RET_BITMAP, RET_SMALL) \
+ { \
+ R1 = StgClosure_payload(R1,offset); \
+ GET_SAVED_CCCS; \
+ Sp = Sp + SIZEOF_StgHeader; \
+ ENTER(); \
+ } \
+ \
+ INFO_TABLE_SELECTOR(stg_sel_##offset##_upd, offset, THUNK_SELECTOR, "stg_sel_upd", "stg_sel_upd") \
+ { \
+ TICK_ENT_DYN_THK(); \
+ STK_CHK_NP(WITHUPD_FRAME_SIZE); \
+ UPD_BH_UPDATABLE(); \
+ LDV_ENTER(R1); \
+ PUSH_UPD_FRAME(Sp - SIZEOF_StgUpdateFrame, R1); \
+ 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; \
+ jump %GET_ENTRY(R1); \
+ }
+ /* NOTE: no need to ENTER() here, we know the closure cannot evaluate to a function,
+ because we're going to do a field selection on the result. */
+
+SELECTOR_CODE_UPD(0)
+SELECTOR_CODE_UPD(1)
+SELECTOR_CODE_UPD(2)
+SELECTOR_CODE_UPD(3)
+SELECTOR_CODE_UPD(4)
+SELECTOR_CODE_UPD(5)
+SELECTOR_CODE_UPD(6)
+SELECTOR_CODE_UPD(7)
+SELECTOR_CODE_UPD(8)
+SELECTOR_CODE_UPD(9)
+SELECTOR_CODE_UPD(10)
+SELECTOR_CODE_UPD(11)
+SELECTOR_CODE_UPD(12)
+SELECTOR_CODE_UPD(13)
+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) \
+ { \
+ R1 = StgClosure_payload(R1,offset); \
+ GET_SAVED_CCCS; \
+ Sp = Sp + SIZEOF_StgHeader; \
+ jump %GET_ENTRY(R1); \
+ } \
+ \
+ INFO_TABLE_SELECTOR(stg_sel_##offset##_noupd, offset, THUNK_SELECTOR, "stg_sel_noupd", "stg_sel_noupd")\
+ { \
+ TICK_ENT_DYN_THK(); \
+ STK_CHK_NP(NOUPD_FRAME_SIZE); \
+ UPD_BH_SINGLE_ENTRY(); \
+ LDV_ENTER(R1); \
+ TICK_UPDF_OMITTED(); \
+ 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; \
+ jump %GET_ENTRY(R1); \
+ }
+
+SELECTOR_CODE_NOUPD(0)
+SELECTOR_CODE_NOUPD(1)
+SELECTOR_CODE_NOUPD(2)
+SELECTOR_CODE_NOUPD(3)
+SELECTOR_CODE_NOUPD(4)
+SELECTOR_CODE_NOUPD(5)
+SELECTOR_CODE_NOUPD(6)
+SELECTOR_CODE_NOUPD(7)
+SELECTOR_CODE_NOUPD(8)
+SELECTOR_CODE_NOUPD(9)
+SELECTOR_CODE_NOUPD(10)
+SELECTOR_CODE_NOUPD(11)
+SELECTOR_CODE_NOUPD(12)
+SELECTOR_CODE_NOUPD(13)
+SELECTOR_CODE_NOUPD(14)
+SELECTOR_CODE_NOUPD(15)
+
+/* -----------------------------------------------------------------------------
+ Apply thunks
+
+ An apply thunk is a thunk of the form
+
+ let z = [x1...xn] \u x1...xn
+ in ...
+
+ We pre-compile some of these because the code is always the same.
+
+ These have to be independent of the update frame size, so the code
+ works when profiling etc.
+ -------------------------------------------------------------------------- */
+
+/* stg_ap_1_upd_info is a bit redundant, but there appears to be a bug
+ * 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")
+{
+ TICK_ENT_DYN_THK();
+ STK_CHK_NP(SIZEOF_StgUpdateFrame+WDS(1));
+ UPD_BH_UPDATABLE();
+ LDV_ENTER(R1);
+ ENTER_CCS_THUNK(R1);
+ PUSH_UPD_FRAME(Sp-SIZEOF_StgUpdateFrame,R1);
+ R1 = StgThunk_payload(R1,0);
+ Sp = Sp - SIZEOF_StgUpdateFrame;
+ jump stg_ap_0_fast;
+}
+
+INFO_TABLE(stg_ap_2_upd,2,0,THUNK_2_0,"stg_ap_2_upd_info","stg_ap_2_upd_info")
+{
+ TICK_ENT_DYN_THK();
+ STK_CHK_NP(SIZEOF_StgUpdateFrame+WDS(2));
+ UPD_BH_UPDATABLE();
+ LDV_ENTER(R1);
+ ENTER_CCS_THUNK(R1);
+ PUSH_UPD_FRAME(Sp-SIZEOF_StgUpdateFrame,R1);
+ W_[Sp-SIZEOF_StgUpdateFrame-WDS(1)] = StgThunk_payload(R1,1);
+ R1 = StgThunk_payload(R1,0);
+ Sp = Sp - SIZEOF_StgUpdateFrame - WDS(1);
+ Sp_adj(-1); // for stg_ap_*_ret
+ TICK_UNKNOWN_CALL();
+ TICK_SLOW_CALL_p();
+ jump RET_LBL(stg_ap_p);
+}
+
+INFO_TABLE(stg_ap_3_upd,3,0,THUNK,"stg_ap_3_upd_info","stg_ap_3_upd_info")
+{
+ TICK_ENT_DYN_THK();
+ STK_CHK_NP(SIZEOF_StgUpdateFrame+WDS(3));
+ UPD_BH_UPDATABLE();
+ LDV_ENTER(R1);
+ ENTER_CCS_THUNK(R1);
+ PUSH_UPD_FRAME(Sp-SIZEOF_StgUpdateFrame,R1);
+ W_[Sp-SIZEOF_StgUpdateFrame-WDS(1)] = StgThunk_payload(R1,2);
+ W_[Sp-SIZEOF_StgUpdateFrame-WDS(2)] = StgThunk_payload(R1,1);
+ R1 = StgThunk_payload(R1,0);
+ Sp = Sp - SIZEOF_StgUpdateFrame - WDS(2);
+ Sp_adj(-1); // for stg_ap_*_ret
+ TICK_UNKNOWN_CALL();
+ TICK_SLOW_CALL_pp();
+ jump RET_LBL(stg_ap_pp);
+}
+
+INFO_TABLE(stg_ap_4_upd,4,0,THUNK,"stg_ap_4_upd_info","stg_ap_4_upd_info")
+{
+ TICK_ENT_DYN_THK();
+ STK_CHK_NP(SIZEOF_StgUpdateFrame+WDS(4));
+ UPD_BH_UPDATABLE();
+ LDV_ENTER(R1);
+ ENTER_CCS_THUNK(R1);
+ PUSH_UPD_FRAME(Sp-SIZEOF_StgUpdateFrame,R1);
+ W_[Sp-SIZEOF_StgUpdateFrame-WDS(1)] = StgThunk_payload(R1,3);
+ W_[Sp-SIZEOF_StgUpdateFrame-WDS(2)] = StgThunk_payload(R1,2);
+ W_[Sp-SIZEOF_StgUpdateFrame-WDS(3)] = StgThunk_payload(R1,1);
+ R1 = StgThunk_payload(R1,0);
+ Sp = Sp - SIZEOF_StgUpdateFrame - WDS(3);
+ Sp_adj(-1); // for stg_ap_*_ret
+ TICK_UNKNOWN_CALL();
+ TICK_SLOW_CALL_ppp();
+ jump RET_LBL(stg_ap_ppp);
+}
+
+INFO_TABLE(stg_ap_5_upd,5,0,THUNK,"stg_ap_5_upd_info","stg_ap_5_upd_info")
+{
+ TICK_ENT_DYN_THK();
+ STK_CHK_NP(SIZEOF_StgUpdateFrame+WDS(5));
+ UPD_BH_UPDATABLE();
+ LDV_ENTER(R1);
+ ENTER_CCS_THUNK(R1);
+ PUSH_UPD_FRAME(Sp-SIZEOF_StgUpdateFrame,R1);
+ W_[Sp-SIZEOF_StgUpdateFrame-WDS(1)] = StgThunk_payload(R1,4);
+ W_[Sp-SIZEOF_StgUpdateFrame-WDS(2)] = StgThunk_payload(R1,3);
+ W_[Sp-SIZEOF_StgUpdateFrame-WDS(3)] = StgThunk_payload(R1,2);
+ W_[Sp-SIZEOF_StgUpdateFrame-WDS(4)] = StgThunk_payload(R1,1);
+ R1 = StgThunk_payload(R1,0);
+ Sp = Sp - SIZEOF_StgUpdateFrame - WDS(4);
+ Sp_adj(-1); // for stg_ap_*_ret
+ TICK_UNKNOWN_CALL();
+ TICK_SLOW_CALL_pppp();
+ jump RET_LBL(stg_ap_pppp);
+}
+
+INFO_TABLE(stg_ap_6_upd,6,0,THUNK,"stg_ap_6_upd_info","stg_ap_6_upd_info")
+{
+ TICK_ENT_DYN_THK();
+ STK_CHK_NP(SIZEOF_StgUpdateFrame+WDS(6));
+ UPD_BH_UPDATABLE();
+ LDV_ENTER(R1);
+ ENTER_CCS_THUNK(R1);
+ PUSH_UPD_FRAME(Sp-SIZEOF_StgUpdateFrame,R1);
+ W_[Sp-SIZEOF_StgUpdateFrame-WDS(1)] = StgThunk_payload(R1,5);
+ W_[Sp-SIZEOF_StgUpdateFrame-WDS(2)] = StgThunk_payload(R1,4);
+ W_[Sp-SIZEOF_StgUpdateFrame-WDS(3)] = StgThunk_payload(R1,3);
+ W_[Sp-SIZEOF_StgUpdateFrame-WDS(4)] = StgThunk_payload(R1,2);
+ W_[Sp-SIZEOF_StgUpdateFrame-WDS(5)] = StgThunk_payload(R1,1);
+ R1 = StgThunk_payload(R1,0);
+ Sp = Sp - SIZEOF_StgUpdateFrame - WDS(5);
+ Sp_adj(-1); // for stg_ap_*_ret
+ TICK_UNKNOWN_CALL();
+ TICK_SLOW_CALL_ppppp();
+ jump RET_LBL(stg_ap_ppppp);
+}
+
+INFO_TABLE(stg_ap_7_upd,7,0,THUNK,"stg_ap_7_upd_info","stg_ap_7_upd_info")
+{
+ TICK_ENT_DYN_THK();
+ STK_CHK_NP(SIZEOF_StgUpdateFrame+WDS(7));
+ UPD_BH_UPDATABLE();
+ LDV_ENTER(R1);
+ ENTER_CCS_THUNK(R1);
+ PUSH_UPD_FRAME(Sp-SIZEOF_StgUpdateFrame,R1);
+ W_[Sp-SIZEOF_StgUpdateFrame-WDS(1)] = StgThunk_payload(R1,6);
+ W_[Sp-SIZEOF_StgUpdateFrame-WDS(2)] = StgThunk_payload(R1,5);
+ W_[Sp-SIZEOF_StgUpdateFrame-WDS(3)] = StgThunk_payload(R1,4);
+ W_[Sp-SIZEOF_StgUpdateFrame-WDS(4)] = StgThunk_payload(R1,3);
+ W_[Sp-SIZEOF_StgUpdateFrame-WDS(5)] = StgThunk_payload(R1,2);
+ W_[Sp-SIZEOF_StgUpdateFrame-WDS(6)] = StgThunk_payload(R1,1);
+ R1 = StgThunk_payload(R1,0);
+ Sp = Sp - SIZEOF_StgUpdateFrame - WDS(6);
+ Sp_adj(-1); // for stg_ap_*_ret
+ TICK_UNKNOWN_CALL();
+ TICK_SLOW_CALL_pppppp();
+ jump RET_LBL(stg_ap_pppppp);
+}
projects / ghc-hetmet.git / blobdiff