-#if 0
-/* It would be nice if this worked, but it doesn't. Yet. */
-STGFUN(mci_make_constr_entry)
-{
- nat size, np, nw_heap, nw_really, w;
- StgClosure* con;
- StgInfoTable* itbl;
- W_* r;
- FB_
- itbl = ((StgInfoTable**)Sp)[0];
-STGCALL3(fprintf,stderr,"mmc: itbl = %d\n",itbl);
-
-STGCALL3(fprintf,stderr,"mmc: sp-4 = %d\n", ((W_*)Sp)[-4] );
-STGCALL3(fprintf,stderr,"mmc: sp-3 = %d\n", ((W_*)Sp)[-3] );
-STGCALL3(fprintf,stderr,"mmc: sp-2 = %d\n", ((W_*)Sp)[-2] );
-STGCALL3(fprintf,stderr,"mmc: sp-1 = %d\n", ((W_*)Sp)[-1] );
-STGCALL3(fprintf,stderr,"mmc: sp+0 = %d\n", ((W_*)Sp)[0] );
-STGCALL3(fprintf,stderr,"mmc: sp+1 = %d\n", ((W_*)Sp)[1] );
-STGCALL3(fprintf,stderr,"mmc: sp+2 = %d\n", ((W_*)Sp)[2] );
-STGCALL3(fprintf,stderr,"mmc: sp+3 = %d\n", ((W_*)Sp)[3] );
-STGCALL3(fprintf,stderr,"mmc: sp+4 = %d\n", ((W_*)Sp)[4] );
- np = itbl->layout.payload.ptrs;
- nw_really = itbl->layout.payload.nptrs;
- nw_heap = stg_max(nw_really, MIN_NONUPD_SIZE-np);
- size = CONSTR_sizeW( np, nw_heap );
-
- /* The total number of words to copy off the stack is np + nw.
- That doesn't include tag words, tho.
- */
- HP_CHK_GEN_TICKY(size, NO_PTRS, mci_make_constr_entry, );
- TICK_ALLOC_PRIM(sizeofW(StgHeader), size-sizeofW(StgHeader), 0);
- CCS_ALLOC(CCCS,size); /* ccs prof */
-
- con = (StgClosure*)(Hp + 1 - size);
- SET_HDR(con, itbl,CCCS);
-
- /* Copy into the closure. */
- w = 0;
- r = Sp+1;
- while (1) {
- if (w == np + nw) break;
- ASSERT(w < np + nw);
- if (IS_ARG_TAG(*r)) {
- nat n = *r++;
- for (; n > 0; n--)
- con->payload[w++] = (StgClosure*)(*r++);
- } else {
- con->payload[w++] = (StgClosure*)(*r++);
- }
- ASSERT((P_)r <= (P_)Su);
- }
+STG_CtoI_RET_F1_Template(stg_ctoi_ret_F1_entry);
+STG_CtoI_RET_F1_Template(stg_ctoi_ret_F1_0_entry);
+STG_CtoI_RET_F1_Template(stg_ctoi_ret_F1_1_entry);
+STG_CtoI_RET_F1_Template(stg_ctoi_ret_F1_2_entry);
+STG_CtoI_RET_F1_Template(stg_ctoi_ret_F1_3_entry);
+STG_CtoI_RET_F1_Template(stg_ctoi_ret_F1_4_entry);
+STG_CtoI_RET_F1_Template(stg_ctoi_ret_F1_5_entry);
+STG_CtoI_RET_F1_Template(stg_ctoi_ret_F1_6_entry);
+STG_CtoI_RET_F1_Template(stg_ctoi_ret_F1_7_entry);
+
+VEC_POLY_INFO_TABLE(stg_ctoi_ret_F1,0, NULL/*srt*/, 0/*srt_off*/, 0/*srt_len*/, RET_BCO,, EF_);
+
+
+/* When the returned value is in D1 ... */
+#define STG_CtoI_RET_D1_Template(label) \
+ IFN_(label) \
+ { \
+ StgPtr bco; \
+ FB_ \
+ bco = ((StgPtr*)Sp)[1]; \
+ Sp -= sizeofW(StgDouble); \
+ ASSIGN_DBL((W_*)Sp, D1); \
+ Sp -= 1; \
+ ((StgPtr*)Sp)[0] = (StgPtr)sizeofW(StgDouble); \
+ Sp -= 1; \
+ ((StgPtr*)Sp)[0] = bco; \
+ JMP_(stg_yield_to_interpreter); \
+ FE_ \
+ }
+
+STG_CtoI_RET_D1_Template(stg_ctoi_ret_D1_entry);
+STG_CtoI_RET_D1_Template(stg_ctoi_ret_D1_0_entry);
+STG_CtoI_RET_D1_Template(stg_ctoi_ret_D1_1_entry);
+STG_CtoI_RET_D1_Template(stg_ctoi_ret_D1_2_entry);
+STG_CtoI_RET_D1_Template(stg_ctoi_ret_D1_3_entry);
+STG_CtoI_RET_D1_Template(stg_ctoi_ret_D1_4_entry);
+STG_CtoI_RET_D1_Template(stg_ctoi_ret_D1_5_entry);
+STG_CtoI_RET_D1_Template(stg_ctoi_ret_D1_6_entry);
+STG_CtoI_RET_D1_Template(stg_ctoi_ret_D1_7_entry);
+
+VEC_POLY_INFO_TABLE(stg_ctoi_ret_D1,0, NULL/*srt*/, 0/*srt_off*/, 0/*srt_len*/, RET_BCO,, EF_);
+
+
+/* When the returned value a VoidRep ... */
+#define STG_CtoI_RET_V_Template(label) \
+ IFN_(label) \
+ { \
+ StgPtr bco; \
+ FB_ \
+ bco = ((StgPtr*)Sp)[1]; \
+ Sp -= 1; \
+ ((StgPtr*)Sp)[0] = 0; /* VoidRep tag */ \
+ Sp -= 1; \
+ ((StgPtr*)Sp)[0] = bco; \
+ JMP_(stg_yield_to_interpreter); \
+ FE_ \
+ }
+
+STG_CtoI_RET_V_Template(stg_ctoi_ret_V_entry);
+STG_CtoI_RET_V_Template(stg_ctoi_ret_V_0_entry);
+STG_CtoI_RET_V_Template(stg_ctoi_ret_V_1_entry);
+STG_CtoI_RET_V_Template(stg_ctoi_ret_V_2_entry);
+STG_CtoI_RET_V_Template(stg_ctoi_ret_V_3_entry);
+STG_CtoI_RET_V_Template(stg_ctoi_ret_V_4_entry);
+STG_CtoI_RET_V_Template(stg_ctoi_ret_V_5_entry);
+STG_CtoI_RET_V_Template(stg_ctoi_ret_V_6_entry);
+STG_CtoI_RET_V_Template(stg_ctoi_ret_V_7_entry);
+
+VEC_POLY_INFO_TABLE(stg_ctoi_ret_V,0, NULL/*srt*/, 0/*srt_off*/, 0/*srt_len*/, RET_BCO,, EF_);
+
+
+/* The other way round: when the interpreter returns a value to
+ compiled code. The stack looks like this:
+
+ return info table (pushed by compiled code)
+ return value (pushed by interpreter)
projects / ghc-hetmet.git / blobdiff