--- gforth/prim 2010/04/05 22:17:56 1.246 +++ gforth/prim 2010/05/02 16:21:32 1.249 @@ -229,18 +229,24 @@ fprintf(stderr, "dodoes to %x, push %x\n SET_IP(DOES_CODE1(CFA)); #endif /* !defined(NO_IP) */ -(does-handler) ( -- ) gforth-internal paren_does_handler -""just a slot to have an encoding for the DOESJUMP, -which is no longer used anyway (!! eliminate this)"" - -(doabicode) ( s:... f:... -- s:... f:...) gforth-internal paren_doabicode -""run-time routine for ABI-CODE definitions"" -struct abi_code_ret_t { - Cell *sp; - double * fp; -} ret = ((struct abi_code_ret_t(*)(Cell *, double *))(PFA(CFA)))(sp, fp); -sp = ret.sp; -fp = ret.fp; +(doabicode) ( ... -- ...) gforth-internal paren_doabicode +""run-time routine for @code{ABI-code} definitions"" +abifunc *f = (abifunc *)PFA(CFA); +Float *fp_mem = fp; +sp = (*f)(sp, &fp_mem); +fp = fp_mem; +#ifdef NO_IP +INST_TAIL; +goto *next_code; +#endif /* defined(NO_IP) */ + +(do;abicode) ( ... -- ... ) gforth-internal paren_do_semicolon_abi_code +""run-time routine for @code{;abi-code}-defined words"" +Float *fp_mem = fp; +Address body = (Address)PFA(CFA); +semiabifunc *f = (semiabifunc *)DOES_CODE1(CFA); +sp = (*f)(sp, &fp_mem, body); +fp = fp_mem; #ifdef NO_IP INST_TAIL; goto *next_code; @@ -638,14 +644,6 @@ k ( R:w R:w1 R:w2 R:w3 R:w4 -- w R:w R:w \ digit is high-level: 0/0% -abi-call ( #a_callee s:... f:... -- s:... f:... ) gforth abi_call -struct abi_code_ret_t { - Cell *sp; - double * fp; -} ret = ((struct abi_code_ret_t(*)(Cell *, double *))(a_callee))(sp, fp); -sp = ret.sp; -fp = ret.fp; - \g strings move ( c_from c_to ucount -- ) core @@ -2541,6 +2539,36 @@ a_addr = groups; \+ +\g primitive_centric + +\ primitives for primitive-centric code +\ another one is does-exec + +abi-call ( #a_callee ... -- ... ) gforth-internal abi_call +/* primitive for compiled ABI-CODE words */ +abifunc *f = (abifunc *)a_callee; +Float *fp_mem = fp; +sp = (*f)(sp, &fp_mem); +fp = fp_mem; + +;abi-code-exec ( #a_cfa ... -- ... ) gforth-internal semi_abi_code_exec +/* primitive for performing ;ABI-CODE words */ +Float *fp_mem = fp; +semiabifunc *f = (semiabifunc *)DOES_CODE1(a_cfa); +Address body = (Address)PFA(a_cfa); +sp = (*f)(sp, &fp_mem, body); +fp = fp_mem; + +lit-execute ( #a_addr -- ) new lit_execute +/* for ;code and code words; a static superinstruction would be more general, + but VM_JUMP is currently not supported there */ +#ifndef NO_IP +ip=IP; +#endif +SUPER_END; +VM_JUMP(EXEC1((Xt)a_addr)); + + \g static_super ifdef(`STACK_CACHE_FILE',