--- gforth/prim 2002/10/27 09:57:11 1.101 +++ gforth/prim 2002/11/24 13:54:00 1.102 @@ -148,7 +148,9 @@ lit ( #w -- w ) gforth execute ( xt -- ) core ""Perform the semantics represented by the execution token, @i{xt}."" +#ifndef NO_IP ip=IP; +#endif IF_spTOS(spTOS = sp[0]); SUPER_END; EXEC(xt); @@ -156,7 +158,9 @@ EXEC(xt); perform ( a_addr -- ) gforth ""@code{@@ execute}."" /* and pfe */ +#ifndef NO_IP ip=IP; +#endif IF_spTOS(spTOS = sp[0]); SUPER_END; EXEC(*(Xt *)a_addr); @@ -961,7 +965,12 @@ fp = f_addr; ;s ( R:w -- ) gforth semis ""The primitive compiled by @code{EXIT}."" +#ifdef NO_IP +INST_TAIL; +goto *(void *)w; +#else SET_IP((Xt *)w); +#endif \g stack @@ -2408,6 +2417,10 @@ xt = peephole_opt(xt1, xt2, wpeeptable); call ( #a_callee -- R:a_retaddr ) new ""Call callee (a variant of docol with inline argument)."" +#ifdef NO_IP +INST_TAIL; +JUMP(a_callee); +#else #ifdef DEBUG { CFA_TO_NAME((((Cell *)a_callee)-2)); @@ -2417,6 +2430,7 @@ call ( #a_callee -- R:a_retaddr ) new #endif a_retaddr = (Cell *)IP; SET_IP((Xt *)a_callee); +#endif useraddr ( #u -- a_addr ) new a_addr = (Cell *)(up+u); @@ -2430,7 +2444,9 @@ lit@ ( #a_addr -- w ) new lit_fetch w = *a_addr; lit-perform ( #a_addr -- ) new lit_perform +#ifndef NO_IP ip=IP; +#endif SUPER_END; EXEC(*(Xt *)a_addr); @@ -2440,6 +2456,10 @@ lit+ ( n1 #n2 -- n ) new lit_plus n=n1+n2; does-exec ( #a_cfa -- R:nest a_pfa ) new does_exec +#ifdef NO_IP +/* compiled to LIT CALL by compile_prim */ +assert(0); +#else a_pfa = PFA(a_cfa); nest = (Cell)ip; IF_spTOS(spTOS = sp[0]); @@ -2451,35 +2471,60 @@ IF_spTOS(spTOS = sp[0]); } #endif SET_IP(DOES_CODE1(a_cfa)); +#endif abranch-lp+!# ( #a_target #nlocals -- ) gforth abranch_lp_plus_store_number /* this will probably not be used */ lp += nlocals; +#ifdef NO_IP +INST_TAIL; +JUMP(a_target); +#else SET_IP((Xt *)a_target); +#endif \+ abranch ( #a_target -- ) gforth +#ifdef NO_IP +INST_TAIL; +JUMP(a_target); +#else SET_IP((Xt *)a_target); +#endif : r> @ >r ; -\ acondbranch(forthname,stackeffect,restline,code,forthcode) +\ acondbranch(forthname,stackeffect,restline,code1,code2,forthcode) \ this is non-syntactical: code must open a brace that is closed by the macro define(acondbranch, $1 ( `#'a_target $2 ) $3 -$4 SET_IP((Xt *)a_target); +$4 #ifdef NO_IP INST_TAIL; +#endif +$5 #ifdef NO_IP +JUMP(a_target); +#else +SET_IP((Xt *)a_target); +INST_TAIL; NEXT_P2; +#endif } SUPER_CONTINUE; -$5 +$6 \+glocals $1-lp+!`#' ( `#'a_target `#'nlocals $2 ) $3_lp_plus_store_number -$4 lp += nlocals; -SET_IP((Xt *)a_target); +$4 #ifdef NO_IP INST_TAIL; +#endif +$5 lp += nlocals; +#ifdef NO_IP +JUMP(a_target); +#else +SET_IP((Xt *)a_target); +INST_TAIL; NEXT_P2; +#endif } SUPER_CONTINUE; @@ -2487,7 +2532,7 @@ SUPER_CONTINUE; ) acondbranch(a?branch,f --,f83 aquestion_branch, -if (f==0) { +,if (f==0) { ,: 0= dup \ !f !f \ !! still uses relative addresses r> dup @ \ !f !f IP branchoffset @@ -2505,8 +2550,13 @@ a?dup-?branch ( #a_target f -- f ) new a if (f==0) { sp++; IF_spTOS(spTOS = sp[0]); - SET_IP((Xt *)a_target); - INST_TAIL; +#ifdef NO_IP +INST_TAIL; +JUMP(a_target); +#else +SET_IP((Xt *)a_target); + INST_TAIL; NEXT_P2; +#endif } SUPER_CONTINUE; @@ -2518,8 +2568,12 @@ few cycles in that case, but is easy to invocation */ if (f!=0) { sp--; +#ifdef NO_IP + JUMP(a_target); +#else SET_IP((Xt *)a_target); NEXT; +#endif } SUPER_CONTINUE; @@ -2529,14 +2583,14 @@ SUPER_CONTINUE; acondbranch(a(next),R:n1 -- R:n2,cmFORTH aparen_next, n2=n1-1; -if (n1) { +,if (n1) { ,: r> r> dup 1- >r IF @ >r ELSE cell+ >r THEN ;) acondbranch(a(loop),R:nlimit R:n1 -- R:nlimit R:n2,gforth aparen_loop, n2=n1+1; -if (n2 != nlimit) { +,if (n2 != nlimit) { ,: r> r> 1+ r> 2dup = IF >r 1- >r cell+ >r @@ -2548,7 +2602,7 @@ acondbranch(a(+loop),n R:nlimit R:n1 -- /* dependent upon two's complement arithmetic */ Cell olddiff = n1-nlimit; n2=n1+n; -if ((olddiff^(olddiff+n))>=0 /* the limit is not crossed */ +,if ((olddiff^(olddiff+n))>=0 /* the limit is not crossed */ || (olddiff^n)>=0 /* it is a wrap-around effect */) { ,: r> swap @@ -2563,7 +2617,7 @@ if ((olddiff^(olddiff+n))>=0 /* the li acondbranch(a(-loop),u R:nlimit R:n1 -- R:nlimit R:n2,gforth aparen_minus_loop, UCell olddiff = n1-nlimit; n2=n1-u; -if (olddiff>u) { +,if (olddiff>u) { ,) acondbranch(a(s+loop),n R:nlimit R:n1 -- R:nlimit R:n2,gforth aparen_symmetric_plus_loop, @@ -2578,13 +2632,20 @@ if (n<0) { newdiff = -newdiff; } n2=n1+n; -if (diff>=0 || newdiff<0) { +,if (diff>=0 || newdiff<0) { ,) a(?do) ( #a_target nlimit nstart -- R:nlimit R:nstart ) gforth aparen_question_do +#ifdef NO_IP + INST_TAIL; +#endif if (nstart == nlimit) { +#ifdef NO_IP + JUMP(a_target); +#else SET_IP((Xt *)a_target); - INST_TAIL; + INST_TAIL; NEXT_P2; +#endif } SUPER_CONTINUE; : @@ -2598,9 +2659,16 @@ SUPER_CONTINUE; \+xconds a(+do) ( #a_target nlimit nstart -- R:nlimit R:nstart ) gforth aparen_plus_do +#ifdef NO_IP + INST_TAIL; +#endif if (nstart >= nlimit) { +#ifdef NO_IP + JUMP(a_target); +#else SET_IP((Xt *)a_target); - INST_TAIL; + INST_TAIL; NEXT_P2; +#endif } SUPER_CONTINUE; : @@ -2614,9 +2682,16 @@ SUPER_CONTINUE; THEN >r ; a(u+do) ( #a_target ulimit ustart -- R:ulimit R:ustart ) gforth aparen_u_plus_do -if (ustart >= ulimit) { - SET_IP((Xt *)a_target); +#ifdef NO_IP INST_TAIL; +#endif +if (ustart >= ulimit) { +#ifdef NO_IP +JUMP(a_target); +#else +SET_IP((Xt *)a_target); +INST_TAIL; NEXT_P2; +#endif } SUPER_CONTINUE; : @@ -2630,9 +2705,16 @@ SUPER_CONTINUE; THEN >r ; a(-do) ( #a_target nlimit nstart -- R:nlimit R:nstart ) gforth aparen_minus_do -if (nstart <= nlimit) { - SET_IP((Xt *)a_target); +#ifdef NO_IP INST_TAIL; +#endif +if (nstart <= nlimit) { +#ifdef NO_IP +JUMP(a_target); +#else +SET_IP((Xt *)a_target); +INST_TAIL; NEXT_P2; +#endif } SUPER_CONTINUE; : @@ -2646,9 +2728,16 @@ SUPER_CONTINUE; THEN >r ; a(u-do) ( #a_target ulimit ustart -- R:ulimit R:ustart ) gforth aparen_u_minus_do -if (ustart <= ulimit) { - SET_IP((Xt *)a_target); +#ifdef NO_IP INST_TAIL; +#endif +if (ustart <= ulimit) { +#ifdef NO_IP +JUMP(a_target); +#else +SET_IP((Xt *)a_target); +INST_TAIL; NEXT_P2; +#endif } SUPER_CONTINUE; : @@ -2661,6 +2750,29 @@ SUPER_CONTINUE; cell+ THEN >r ; +set-next-code ( #w -- ) gforth set_next_code +#ifdef NO_IP +next_code = (Label)w; +#endif + +call2 ( #a_callee #a_ret_addr -- R:a_ret_addr ) gforth +/* call with explicit return address */ +#ifdef NO_IP +INST_TAIL; +JUMP(a_callee); +#else +assert(0); +#endif + +compile-prim1 ( a_prim -- ) gforth compile_prim1 +""compile prim (incl. immargs) at @var{a_prim}"" +compile_prim1(a_prim); + +finish-code ( -- ) gforth finish_code +""Perform delayed steps in code generation (branch resolution, I-cache +flushing)."" +finish_code(); + \+ include(peeprules.vmg)