diff --git a/includes/stg/MiscClosures.h b/includes/stg/MiscClosures.h index 5ffdd5cd7bdb8f2e401d87c1d35232c9d8ca15f3..94d1e7d97f0171781789e582b737b4a9774d747f 100644 --- a/includes/stg/MiscClosures.h +++ b/includes/stg/MiscClosures.h @@ -87,6 +87,24 @@ RTS_RET(stg_ctoi_D1); RTS_RET(stg_ctoi_L1); RTS_RET(stg_ctoi_V); +RTS_RET(stg_ctoi_t); +RTS_RET(rts_ctoi_t1); +RTS_RET(rts_ctoi_t2); +RTS_RET(rts_ctoi_t3); +RTS_RET(rts_ctoi_t4); +RTS_RET(rts_ctoi_t5); +RTS_RET(rts_ctoi_t6); +RTS_RET(rts_ctoi_t7); +RTS_RET(rts_ctoi_t8); +RTS_RET(rts_ctoi_t9); +RTS_RET(rts_ctoi_t10); +RTS_RET(rts_ctoi_t11); +RTS_RET(rts_ctoi_t12); +RTS_RET(rts_ctoi_t13); +RTS_RET(rts_ctoi_t14); +RTS_RET(rts_ctoi_t15); +RTS_RET(rts_ctoi_t16); + RTS_RET(stg_apply_interp); RTS_ENTRY(stg_IND); @@ -292,6 +310,7 @@ RTS_RET(stg_ret_n); RTS_RET(stg_ret_f); RTS_RET(stg_ret_d); RTS_RET(stg_ret_l); +RTS_RET(stg_ret_t); RTS_FUN_DECL(stg_gc_prim); RTS_FUN_DECL(stg_gc_prim_p); diff --git a/rts/StgMiscClosures.cmm b/rts/StgMiscClosures.cmm index 7a8f20dded18b667fb16527982ad6c3578a2eeb5..9fd06a5899c1fdc381eacb67e99255be0434146f 100644 --- a/rts/StgMiscClosures.cmm +++ b/rts/StgMiscClosures.cmm @@ -195,6 +195,139 @@ INFO_TABLE_RET( stg_ctoi_V, RET_BCO ) jump stg_yield_to_interpreter []; } +#define MK_STG_CTOI_T(N) INFO_TABLE_RET( \ + stg_ctoi_t ## N, RET_BCO ) \ + { Sp_adj(N); jump stg_ctoi_t [*]; } + +MK_STG_CTOI_T(1) +MK_STG_CTOI_T(2) +MK_STG_CTOI_T(3) +MK_STG_CTOI_T(4) +MK_STG_CTOI_T(5) +MK_STG_CTOI_T(6) +MK_STG_CTOI_T(7) +MK_STG_CTOI_T(8) +MK_STG_CTOI_T(9) +MK_STG_CTOI_T(10) +MK_STG_CTOI_T(11) +MK_STG_CTOI_T(12) +MK_STG_CTOI_T(13) +MK_STG_CTOI_T(14) +MK_STG_CTOI_T(15) +MK_STG_CTOI_T(16) + +/* + the tuple_info word describes the register and stack usage of the tuple: + + [ rrrr ffff dddd llll ssss ssss ssss ssss ] + + - r: number of vanilla registers R1..Rn + - f: number of float registers F1..Fn + - d: number of double registers D1..Dn + - l: number of long registers L1..Ln + - s: size of tuple in words on stack? (maybe change later) + + */ + +INFO_TABLE_RET( stg_ctoi_t, RET_BCO ) + /* explicit stack */ +{ + W_ tuple_info; + P_ adjustor; + + tuple_info = Sp(1); /* number of words already on the stack */ + adjustor = Sp(2); /* bytecode object that returns the tuple inside the interpreter */ + + W_ tuple_stack = tuple_info & 0xffff; /* number of words spilled on stack */ + W_ tuple_regs_R = (tuple_info >> 28) & 0xf; + W_ tuple_regs_F = (tuple_info >> 24) & 0xf; + W_ tuple_regs_D = (tuple_info >> 20) & 0xf; + W_ tuple_regs_L = (tuple_info >> 16) & 0xf; + + Sp = Sp - WDS(tuple_stack); + + /* save vanilla registers */ + if(tuple_regs_R >= 6) { Sp_adj(-1); Sp(0) = R6; } + if(tuple_regs_R >= 5) { Sp_adj(-1); Sp(0) = R5; } + if(tuple_regs_R >= 4) { Sp_adj(-1); Sp(0) = R4; } + if(tuple_regs_R >= 3) { Sp_adj(-1); Sp(0) = R3; } + if(tuple_regs_R >= 2) { Sp_adj(-1); Sp(0) = R2; } + if(tuple_regs_R >= 1) { Sp_adj(-1); Sp(0) = R1; } + + /* save float registers */ + if(tuple_regs_F >= 6) { Sp_adj(-1); F_[Sp] = F6; } + if(tuple_regs_F >= 5) { Sp_adj(-1); F_[Sp] = F5; } + if(tuple_regs_F >= 4) { Sp_adj(-1); F_[Sp] = F4; } + if(tuple_regs_F >= 3) { Sp_adj(-1); F_[Sp] = F3; } + if(tuple_regs_F >= 2) { Sp_adj(-1); F_[Sp] = F2; } + if(tuple_regs_F >= 1) { Sp_adj(-1); F_[Sp] = F1; } + + /* save double registers */ + if(tuple_regs_D >= 6) { Sp = Sp - SIZEOF_DOUBLE; D_[Sp] = D6; } + if(tuple_regs_D >= 5) { Sp = Sp - SIZEOF_DOUBLE; D_[Sp] = D5; } + if(tuple_regs_D >= 4) { Sp = Sp - SIZEOF_DOUBLE; D_[Sp] = D4; } + if(tuple_regs_D >= 3) { Sp = Sp - SIZEOF_DOUBLE; D_[Sp] = D3; } + if(tuple_regs_D >= 2) { Sp = Sp - SIZEOF_DOUBLE; D_[Sp] = D2; } + if(tuple_regs_D >= 1) { Sp = Sp - SIZEOF_DOUBLE; D_[Sp] = D1; } + + /* save long registers */ + if(tuple_regs_L >= 1) { Sp = Sp - 8; L_[Sp] = L1; } + + /* jump to the BCO that will finish the return of the tuple */ + Sp_adj(-2); + Sp(1) = adjustor; + Sp(0) = stg_ret_t; + + IF_DEBUG(sanity, + ccall checkStackFrame(Sp "ptr")); + + jump stg_yield_to_interpreter []; +} + +INFO_TABLE_RET( stg_ret_t, RET_BCO ) +{ + W_ tuple_info, i; + tuple_info = Sp(2); + Sp_adj(2); + + /* restore everything in the opposite order of stg_ctoi_t */ + + /* restore long registers */ + i = (tuple_info >> 16) & 0xf; + if(i >= 1) { L1 = L_[Sp]; Sp = Sp + 8; } + + /* restore double registers */ + i = (tuple_info >> 20) & 0xf; + if(i >= 1) { D1 = D_[Sp]; Sp = Sp + SIZEOF_DOUBLE; } + if(i >= 2) { D2 = D_[Sp]; Sp = Sp + SIZEOF_DOUBLE; } + if(i >= 3) { D3 = D_[Sp]; Sp = Sp + SIZEOF_DOUBLE; } + if(i >= 4) { D4 = D_[Sp]; Sp = Sp + SIZEOF_DOUBLE; } + if(i >= 5) { D5 = D_[Sp]; Sp = Sp + SIZEOF_DOUBLE; } + if(i >= 6) { D6 = D_[Sp]; Sp = Sp + SIZEOF_DOUBLE; } + + /* save float registers */ + i = (tuple_info >> 24) & 0xf; + if(i >= 6) { Sp_adj(-1); F_[Sp] = F6; } + if(i >= 5) { Sp_adj(-1); F_[Sp] = F5; } + if(i >= 4) { Sp_adj(-1); F_[Sp] = F4; } + if(i >= 3) { Sp_adj(-1); F_[Sp] = F3; } + if(i >= 2) { Sp_adj(-1); F_[Sp] = F2; } + if(i >= 1) { Sp_adj(-1); F_[Sp] = F1; } + + /* restore general purpose registers */ + i = (tuple_info >> 28) & 0xf; + if(i >= 6) { Sp(0) = R6; Sp_adj(-1); } + if(i >= 5) { Sp(0) = R5; Sp_adj(-1); } + if(i >= 4) { Sp(0) = R4; Sp_adj(-1); } + if(i >= 3) { Sp(0) = R3; Sp_adj(-1); } + if(i >= 2) { Sp(0) = R2; Sp_adj(-1); } + if(i >= 1) { Sp(0) = R1; Sp_adj(-1); } + + /* Sp points to the topmost argument now */ + jump Sp(tuple_info & 0xffff) [*]; +} + + /* * 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