--- gforth/prim 2005/01/19 22:11:52 1.158 +++ gforth/prim 2005/01/26 21:24:15 1.163 @@ -191,7 +191,7 @@ goto *next_code; ip=IP; /* undo any ip updating that may have been performed by NEXT_P0 */ #endif /* !defined(NO_IP) */ SUPER_END; /* !! probably unnecessary and may lead to measurement errors */ -EXEC(*(Xt *)PFA(CFA)); +VM_JUMP(EXEC1(*(Xt *)PFA(CFA))); (dofield) ( n1 -- n2 ) gforth-internal paren_field ""run-time routine for fields"" @@ -249,9 +249,9 @@ execute ( xt -- ) core #ifndef NO_IP ip=IP; #endif -IF_spTOS(spTOS = sp[0]); /* inst_tail would produce a NEXT_P1 */ +/* IF_spTOS(spTOS = sp[0]); /* inst_tail would produce a NEXT_P1 */ SUPER_END; -EXEC(xt); +VM_JUMP(EXEC1(xt)); perform ( a_addr -- ) gforth ""@code{@@ execute}."" @@ -259,9 +259,9 @@ perform ( a_addr -- ) gforth #ifndef NO_IP ip=IP; #endif -IF_spTOS(spTOS = sp[0]); /* inst_tail would produce a NEXT_P1 */ +/* IF_spTOS(spTOS = sp[0]); /* inst_tail would produce a NEXT_P1 */ SUPER_END; -EXEC(*(Xt *)a_addr); +VM_JUMP(EXEC1(*(Xt *)a_addr)); : @ execute ; @@ -284,7 +284,7 @@ lit-perform ( #a_addr -- ) new lit_perfo ip=IP; #endif SUPER_END; -EXEC(*(Xt *)a_addr); +VM_JUMP(EXEC1(*(Xt *)a_addr)); does-exec ( #a_cfa -- R:nest a_pfa ) new does_exec #ifdef NO_IP @@ -324,15 +324,14 @@ INST_TAIL; JUMP(a_target); #else SET_IP((Xt *)a_target); -INST_TAIL; -NEXT_P2; #endif -SUPER_CONTINUE; /* we do our own control flow, so don't append NEXT etc. */ : r> @ >r ; \ condbranch(forthname,stackeffect,restline,code1,code2,forthcode) \ this is non-syntactical: code must open a brace that is closed by the macro +\ condbranch(forthname,stackeffect,restline,code1,code2,forthcode) +\ this is non-syntactical: code must open a brace that is closed by the macro define(condbranch, $1 ( `#'a_target $2 ) $3 $4 #ifdef NO_IP @@ -342,6 +341,37 @@ $5 #ifdef NO_IP JUMP(a_target); #else SET_IP((Xt *)a_target); +#endif +} +$6 + +\+glocals + +$1-lp+!`#' ( `#'a_target `#'nlocals $2 ) $3_lp_plus_store_number +$4 #ifdef NO_IP +INST_TAIL; +#endif +$5 lp += nlocals; +#ifdef NO_IP +JUMP(a_target); +#else +SET_IP((Xt *)a_target); +#endif +} + +\+ +) + +\ version that generates two jumps (not good for PR 15242 workaround) +define(condbranch_twojump, +$1 ( `#'a_target $2 ) $3 +$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 } @@ -787,20 +817,67 @@ n = n1*n2; / ( n1 n2 -- n ) core slash n = n1/n2; +if(FLOORED_DIV && (n1 < 0) != (n2 < 0) && (n1%n2 != 0)) n--; : /mod nip ; mod ( n1 n2 -- n ) core n = n1%n2; +if(FLOORED_DIV && (n1 < 0) != (n2 < 0) && n!=0) n += n2; : /mod drop ; /mod ( n1 n2 -- n3 n4 ) core slash_mod n4 = n1/n2; n3 = n1%n2; /* !! is this correct? look into C standard! */ +if (FLOORED_DIV && (n1<0) != (n2<0) && n3!=0) { + n4--; + n3+=n2; +} : >r s>d r> fm/mod ; +*/mod ( n1 n2 n3 -- n4 n5 ) core star_slash_mod +""n1*n2=n3*n5+n4, with the intermediate result (n1*n2) being double."" +#ifdef BUGGY_LL_MUL +DCell d = mmul(n1,n2); +#else +DCell d = (DCell)n1 * (DCell)n2; +#endif +#ifdef BUGGY_LL_DIV +DCell r = fmdiv(d,n3); +n4=DHI(r); +n5=DLO(r); +#else +/* assumes that the processor uses either floored or symmetric division */ +n5 = d/n3; +n4 = d%n3; +if (FLOORED_DIV && (d<0) != (n3<0) && n4!=0) { + n5--; + n4+=n3; +} +#endif +: + >r m* r> fm/mod ; + +*/ ( n1 n2 n3 -- n4 ) core star_slash +""n4=(n1*n2)/n3, with the intermediate result being double."" +#ifdef BUGGY_LL_MUL +DCell d = mmul(n1,n2); +#else +DCell d = (DCell)n1 * (DCell)n2; +#endif +#ifdef BUGGY_LL_DIV +DCell r = fmdiv(d,n3); +n4=DHI(r); +#else +/* assumes that the processor uses either floored or symmetric division */ +n4 = d/n3; +if (FLOORED_DIV && (d<0) != (n3<0) && (d%n3)!=0) n4--; +#endif +: + */mod nip ; + 2* ( n1 -- n2 ) core two_star ""Shift left by 1; also works on unsigned numbers"" n2 = 2*n1; @@ -822,8 +899,8 @@ fm/mod ( d1 n1 -- n2 n3 ) core f_m_sla ""Floored division: @i{d1} = @i{n3}*@i{n1}+@i{n2}, @i{n1}>@i{n2}>=0 or 0>=@i{n2}>@i{n1}."" #ifdef BUGGY_LL_DIV DCell r = fmdiv(d1,n1); -n2=r.hi; -n3=r.lo; +n2=DHI(r); +n3=DLO(r); #else /* assumes that the processor uses either floored or symmetric division */ n3 = d1/n1; @@ -844,8 +921,8 @@ sm/rem ( d1 n1 -- n2 n3 ) core s_m_sla ""Symmetric division: @i{d1} = @i{n3}*@i{n1}+@i{n2}, sign(@i{n2})=sign(@i{d1}) or 0."" #ifdef BUGGY_LL_DIV DCell r = smdiv(d1,n1); -n2=r.hi; -n3=r.lo; +n2=DHI(r); +n3=DLO(r); #else /* assumes that the processor uses either floored or symmetric division */ n3 = d1/n1; @@ -893,8 +970,8 @@ um/mod ( ud u1 -- u2 u3 ) core u_m_slas ""ud=u3*u1+u2, u1>u2>=0"" #ifdef BUGGY_LL_DIV UDCell r = umdiv(ud,u1); -u2=r.hi; -u3=r.lo; +u2=DHI(r); +u3=DLO(r); #else u3 = ud/u1; u2 = ud%u1;