--- gforth/prim 2009/10/05 15:54:28 1.244 +++ gforth/prim 2010/05/02 16:21:32 1.249 @@ -1,6 +1,6 @@ \ Gforth primitives -\ Copyright (C) 1995,1996,1997,1998,2000,2003,2004,2005,2006,2007,2008 Free Software Foundation, Inc. +\ Copyright (C) 1995,1996,1997,1998,2000,2003,2004,2005,2006,2007,2008,2009 Free Software Foundation, Inc. \ This file is part of Gforth. @@ -229,9 +229,28 @@ 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) ( ... -- ...) 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; +#endif /* defined(NO_IP) */ \F [endif] @@ -2520,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',