--- gforth/prim	2005/01/23 22:09:29	1.159
+++ gforth/prim	2005/01/28 21:36:45	1.167
@@ -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,8 @@ execute	( xt -- )		core
 #ifndef NO_IP
 ip=IP;
 #endif
-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 +258,8 @@ perform	( a_addr -- )	gforth
 #ifndef NO_IP
 ip=IP;
 #endif
-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 +282,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,10 +322,7 @@ 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 ;
 
@@ -524,10 +519,8 @@ if (nstart == nlimit) {
     JUMP(a_target);
 #else
     SET_IP((Xt *)a_target);
-    INST_TAIL; NEXT_P2;
 #endif
 }
-SUPER_CONTINUE;
 :
   2dup =
   IF   r> swap rot >r >r
@@ -547,10 +540,8 @@ if (nstart >= nlimit) {
     JUMP(a_target);
 #else
     SET_IP((Xt *)a_target);
-    INST_TAIL; NEXT_P2;
 #endif
 }
-SUPER_CONTINUE;
 :
  swap 2dup
  r> swap >r swap >r
@@ -570,10 +561,8 @@ if (ustart >= ulimit) {
 JUMP(a_target);
 #else
 SET_IP((Xt *)a_target);
-INST_TAIL; NEXT_P2;
 #endif
 }
-SUPER_CONTINUE;
 :
  swap 2dup
  r> swap >r swap >r
@@ -593,10 +582,8 @@ if (nstart <= nlimit) {
 JUMP(a_target);
 #else
 SET_IP((Xt *)a_target);
-INST_TAIL; NEXT_P2;
 #endif
 }
-SUPER_CONTINUE;
 :
  swap 2dup
  r> swap >r swap >r
@@ -616,10 +603,8 @@ if (ustart <= ulimit) {
 JUMP(a_target);
 #else
 SET_IP((Xt *)a_target);
-INST_TAIL; NEXT_P2;
 #endif
 }
-SUPER_CONTINUE;
 :
  swap 2dup
  r> swap >r swap >r
@@ -820,20 +805,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;
@@ -854,10 +886,25 @@ n2 = n1>>1;
 fm/mod	( d1 n1 -- n2 n3 )		core		f_m_slash_mod
 ""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
+#ifdef ASM_SM_SLASH_REM
+ASM_SM_SLASH_REM(d1.lo, d1.hi, n1, n2, n3);
+if ((d1.hi<0) != (n1<0) && n2!=0) {
+  n3--;
+  n2+=n1;
+}
+#else /* !defined(ASM_SM_SLASH_REM) */
 DCell r = fmdiv(d1,n1);
-n2=r.hi;
-n3=r.lo;
-#else
+n2=DHI(r);
+n3=DLO(r);
+#endif /* !defined(ASM_SM_SLASH_REM) */
+#else
+#ifdef ASM_SM_SLASH_REM4
+ASM_SM_SLASH_REM4(d1, n1, n2, n3);
+if ((d1<0) != (n1<0) && n2!=0) {
+  n3--;
+  n2+=n1;
+}
+#else /* !defined(ASM_SM_SLASH_REM4) */
 /* assumes that the processor uses either floored or symmetric division */
 n3 = d1/n1;
 n2 = d1%n1;
@@ -866,6 +913,7 @@ if (1%-3>0 && (d1<0) != (n1<0) && n2!=0)
   n3--;
   n2+=n1;
 }
+#endif /* !defined(ASM_SM_SLASH_REM4) */
 #endif
 :
  dup >r dup 0< IF  negate >r dnegate r>  THEN
@@ -876,10 +924,17 @@ if (1%-3>0 && (d1<0) != (n1<0) && n2!=0)
 sm/rem	( d1 n1 -- n2 n3 )		core		s_m_slash_rem
 ""Symmetric division: @i{d1} = @i{n3}*@i{n1}+@i{n2}, sign(@i{n2})=sign(@i{d1}) or 0.""
 #ifdef BUGGY_LL_DIV
+#ifdef ASM_SM_SLASH_REM
+ASM_SM_SLASH_REM(d1.lo, d1.hi, n1, n2, n3);
+#else /* !defined(ASM_SM_SLASH_REM) */
 DCell r = smdiv(d1,n1);
-n2=r.hi;
-n3=r.lo;
-#else
+n2=DHI(r);
+n3=DLO(r);
+#endif /* !defined(ASM_SM_SLASH_REM) */
+#else
+#ifdef ASM_SM_SLASH_REM4
+ASM_SM_SLASH_REM4(d1, n1, n2, n3);
+#else /* !defined(ASM_SM_SLASH_REM4) */
 /* assumes that the processor uses either floored or symmetric division */
 n3 = d1/n1;
 n2 = d1%n1;
@@ -888,6 +943,7 @@ if (1%-3<0 && (d1<0) != (n1<0) && n2!=0)
   n3++;
   n2-=n1;
 }
+#endif /* !defined(ASM_SM_SLASH_REM4) */
 #endif
 :
  over >r dup >r abs -rot
@@ -925,12 +981,20 @@ ud = (UDCell)u1 * (UDCell)u2;
 um/mod	( ud u1 -- u2 u3 )		core	u_m_slash_mod
 ""ud=u3*u1+u2, u1>u2>=0""
 #ifdef BUGGY_LL_DIV
+#ifdef ASM_UM_SLASH_MOD
+ASM_UM_SLASH_MOD(ud.lo, ud.hi, u1, u2, u3);
+#else /* !defined(ASM_UM_SLASH_MOD) */
 UDCell r = umdiv(ud,u1);
-u2=r.hi;
-u3=r.lo;
-#else
+u2=DHI(r);
+u3=DLO(r);
+#endif /* !defined(ASM_UM_SLASH_MOD) */
+#else
+#ifdef ASM_UM_SLASH_MOD4
+ASM_UM_SLASH_MOD4(ud, u1, u2, u3);
+#else /* !defined(ASM_UM_SLASH_MOD4) */
 u3 = ud/u1;
 u2 = ud%u1;
+#endif /* !defined(ASM_UM_SLASH_MOD4) */
 #endif
 :
    0 swap [ 8 cells 1 + ] literal 0