--- gforth/prim 2003/08/20 09:23:45 1.139 +++ gforth/prim 2003/08/23 20:16:09 1.142 @@ -141,12 +141,14 @@ undefine(`index') undefine(`shift') undefine(`symbols') +\F 0 [if] + \ run-time routines for non-primitives. They are defined as \ primitives, because that simplifies things. (docol) ( -- R:a_retaddr ) gforth-internal paren_docol ""run-time routine for colon definitions"" -a_retaddr = (Cell *)ip; +a_retaddr = (Cell *)IP; SET_IP((Xt *)PFA(CFA)); (docon) ( -- w ) gforth-internal paren_docon @@ -163,7 +165,8 @@ a_user = (Cell *)(up+*(Cell *)PFA(CFA)); (dodefer) ( -- ) gforth-internal paren_dodefer ""run-time routine for deferred words"" -SUPER_END; +ip=IP; /* undo any ip updating that may have been performed by NEXT_P0 */ +SUPER_END; /* !! probably unnecessary and may lead to measurement errors */ EXEC(*(Xt *)PFA(CFA)); (dofield) ( n1 -- n2 ) gforth-internal paren_field @@ -172,7 +175,7 @@ n2 = n1 + *(Cell *)PFA(CFA); (dodoes) ( -- a_body R:a_retaddr ) gforth-internal paren_dodoes ""run-time routine for @code{does>}-defined words"" -a_retaddr = (Cell *)ip; +a_retaddr = (Cell *)IP; a_body = PFA(CFA); SET_IP(DOES_CODE1(CFA)); @@ -180,6 +183,8 @@ SET_IP(DOES_CODE1(CFA)); ""just a slot to have an encoding for the DOESJUMP, which is no longer used anyway (!! eliminate this)"" +\F [endif] + \g control noop ( -- ) gforth @@ -2262,6 +2267,14 @@ u3 = 0; # endif #endif +wcall ( u -- ) gforth +IF_fpTOS(fp[0]=fpTOS); +FP=fp; +sp=(Cell*)(SYSCALL(Cell*(*)(Cell *, void *))u)(sp, &FP); +fp=FP; +IF_spTOS(spTOS=sp[0];) +IF_fpTOS(fpTOS=fp[0]); + \+FFCALL av-start-void ( c_addr -- ) gforth av_start_void @@ -2411,7 +2424,9 @@ va-return-double ( r -- ) gforth va_retu va_return_double(clist, r); return 0; -\- +\+ + +\+OLDCALL define(`uploop', `pushdef(`$1', `$2')_uploop(`$1', `$2', `$3', `$4', `$5')`'popdef(`$1')') @@ -2452,18 +2467,10 @@ fcall(20) \+ \+ -wcall ( u -- ) gforth -IF_fpTOS(fp[0]=fpTOS); -FP=fp; -sp=(Cell*)(SYSCALL(Cell*(*)(Cell *, void *))u)(sp, &FP); -fp=FP; -IF_spTOS(spTOS=sp[0];) -IF_fpTOS(fpTOS=fp[0]); +\g peephole \+peephole -\g peephole - compile-prim1 ( a_prim -- ) gforth compile_prim1 ""compile prim (incl. immargs) at @var{a_prim}"" compile_prim1(a_prim);