+/* 9 bits of return code for constructors created by the interpreter. */
+FN_(stg_interp_constr_entry)
+{
+ /* R1 points at the constructor */
+ FB_
+ /* STGCALL2(fprintf,stderr,"stg_interp_constr_entry (direct return)!\n"); */
+ /* Pointless, since SET_TAG doesn't do anything */
+ SET_TAG( GET_TAG(GET_INFO(R1.cl)));
+ JMP_(ENTRY_CODE((P_)(*Sp)));
+ FE_
+}
+
+FN_(stg_interp_constr1_entry) { FB_ JMP_(RET_VEC((P_)(*Sp),0)); FE_ }
+FN_(stg_interp_constr2_entry) { FB_ JMP_(RET_VEC((P_)(*Sp),1)); FE_ }
+FN_(stg_interp_constr3_entry) { FB_ JMP_(RET_VEC((P_)(*Sp),2)); FE_ }
+FN_(stg_interp_constr4_entry) { FB_ JMP_(RET_VEC((P_)(*Sp),3)); FE_ }
+FN_(stg_interp_constr5_entry) { FB_ JMP_(RET_VEC((P_)(*Sp),4)); FE_ }
+FN_(stg_interp_constr6_entry) { FB_ JMP_(RET_VEC((P_)(*Sp),5)); FE_ }
+FN_(stg_interp_constr7_entry) { FB_ JMP_(RET_VEC((P_)(*Sp),6)); FE_ }
+FN_(stg_interp_constr8_entry) { FB_ JMP_(RET_VEC((P_)(*Sp),7)); FE_ }
+
+/* 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
+ impedance-match the compiled return convention (in R1p/R1n/F1/D1 etc) to
+ the interpreter's convention (returned value is on top of stack),
+ and then cause the scheduler to enter the interpreter.
+
+ On entry, the stack (growing down) looks like this:
+
+ ptr to BCO holding return continuation
+ ptr to one of these info tables.
+
+ The info table code, both direct and vectored, must:
+ * push R1/F1/D1 on the stack, and its tag if necessary
+ * push the BCO (so it's now on the stack twice)
+ * Yield, ie, go to the scheduler.
+
+ Scheduler examines the t.o.s, discovers it is a BCO, and proceeds
+ directly to the bytecode interpreter. That pops the top element
+ (the BCO, containing the return continuation), and interprets it.
+ Net result: return continuation gets interpreted, with the
+ following stack:
+
+ ptr to this BCO
+ ptr to the info table just jumped thru
+ return value
+
+ which is just what we want -- the "standard" return layout for the
+ interpreter. Hurrah!
+
+ Don't ask me how unboxed tuple returns are supposed to work. We
+ haven't got a good story about that yet.
+*/
+
+// When the returned value is a pointer in R1...
+#define STG_CtoI_RET_R1p_Template(label) \
+ IF_(label) \
+ { \
+ FB_ \
+ Sp -= 2; \
+ Sp[1] = R1.w; \
+ Sp[0] = (W_)&stg_enter_info; \
+ JMP_(stg_yield_to_interpreter); \
+ FE_ \
+ }
+
+STG_CtoI_RET_R1p_Template(stg_ctoi_ret_R1p_ret);
+STG_CtoI_RET_R1p_Template(stg_ctoi_ret_R1p_0_ret);
+STG_CtoI_RET_R1p_Template(stg_ctoi_ret_R1p_1_ret);
+STG_CtoI_RET_R1p_Template(stg_ctoi_ret_R1p_2_ret);
+STG_CtoI_RET_R1p_Template(stg_ctoi_ret_R1p_3_ret);
+STG_CtoI_RET_R1p_Template(stg_ctoi_ret_R1p_4_ret);
+STG_CtoI_RET_R1p_Template(stg_ctoi_ret_R1p_5_ret);
+STG_CtoI_RET_R1p_Template(stg_ctoi_ret_R1p_6_ret);
+STG_CtoI_RET_R1p_Template(stg_ctoi_ret_R1p_7_ret);
+
+VEC_POLY_INFO_TABLE( stg_ctoi_ret_R1p, 0/* special layout */,
+ 0/*srt*/, 0/*srt_off*/, 0/*srt_bitmap*/,
+ RET_BCO,, EF_);
+
+// When the returned value is a pointer, but unlifted, in R1 ...
+INFO_TABLE_RET( stg_ctoi_ret_R1unpt_info, stg_ctoi_ret_R1unpt_entry,
+ 0/* special layout */,
+ 0/*srt*/, 0/*srt_off*/, 0/*srt_bitmap*/, RET_BCO,, IF_, 0, 0);
+IF_(stg_ctoi_ret_R1unpt_entry)
+{
+ FB_
+ Sp -= 2;
+ Sp[1] = R1.w;
+ Sp[0] = (W_)&stg_gc_unpt_r1_info;
+ JMP_(stg_yield_to_interpreter);
+ FE_
+}
+
+// When the returned value is a non-pointer in R1 ...
+INFO_TABLE_RET( stg_ctoi_ret_R1n_info, stg_ctoi_ret_R1n_entry,
+ 0/* special layout */,
+ 0/*srt*/, 0/*srt_off*/, 0/*srt_bitmap*/, RET_BCO,, IF_, 0, 0);
+IF_(stg_ctoi_ret_R1n_entry)
+{
+ FB_
+ Sp -= 2;
+ Sp[1] = R1.w;
+ Sp[0] = (W_)&stg_gc_unbx_r1_info;
+ JMP_(stg_yield_to_interpreter);
+ FE_
+}
+
+
+// When the returned value is in F1 ...
+INFO_TABLE_RET( stg_ctoi_ret_F1_info, stg_ctoi_ret_F1_entry,
+ 0/* special layout */,
+ 0/*srt*/, 0/*srt_off*/, 0/*srt_bitmap*/, RET_BCO,, IF_, 0, 0);
+IF_(stg_ctoi_ret_F1_entry)
+{
+ FB_
+ Sp -= 2;
+ ASSIGN_FLT(Sp+1, F1);
+ Sp[0] = (W_)&stg_gc_f1_info;
+ JMP_(stg_yield_to_interpreter);
+ FE_
+}
+
+// When the returned value is in D1 ...
+INFO_TABLE_RET( stg_ctoi_ret_D1_info, stg_ctoi_ret_D1_entry,
+ 0/* special layout */,
+ 0/*srt*/, 0/*srt_off*/, 0/*srt_bitmap*/, RET_BCO,, IF_, 0, 0);
+IF_(stg_ctoi_ret_D1_entry)
+{
+ FB_
+ Sp -= 1 + sizeofW(StgDouble);
+ ASSIGN_DBL(Sp+1, D1);
+ Sp[0] = (W_)&stg_gc_d1_info;
+ JMP_(stg_yield_to_interpreter);
+ FE_
+}
+
+// When the returned value is in L1 ...
+INFO_TABLE_RET( stg_ctoi_ret_L1_info, stg_ctoi_ret_L1_entry,
+ 0/* special layout */,
+ 0/*srt*/, 0/*srt_off*/, 0/*srt_bitmap*/, RET_BCO,, IF_, 0, 0);
+IF_(stg_ctoi_ret_L1_entry)
+{
+ FB_
+ Sp -= 1 + sizeofW(StgInt64);
+ ASSIGN_Word64(Sp+1, L1);
+ Sp[0] = (W_)&stg_gc_l1_info;
+ JMP_(stg_yield_to_interpreter);
+ FE_
+}
+
+// When the returned value a VoidRep ...
+INFO_TABLE_RET( stg_ctoi_ret_V_info, stg_ctoi_ret_V_entry,
+ 0/* special layout */,
+ 0/*srt*/, 0/*srt_off*/, 0/*srt_bitmap*/, RET_BCO,, IF_, 0, 0);
+IF_(stg_ctoi_ret_V_entry)
+{
+ FB_
+ Sp--;
+ Sp[0] = (W_)&stg_gc_void_info;
+ JMP_(stg_yield_to_interpreter);
+ FE_
+}
+
+// Dummy info table pushed on the top of the stack when the interpreter
+// should apply the BCO on the stack to its arguments, also on the stack.
+INFO_TABLE_RET( stg_apply_interp_info, stg_apply_interp_entry,
+ 0/* special layout */,
+ 0/*srt*/, 0/*srt_off*/, 0/*srt_bitmap*/, RET_BCO,, IF_, 0, 0);
+IF_(stg_apply_interp_entry)
projects / ghc-hetmet.git / blobdiff