Cleaning up throw values around division + faults.

common/base_tests.fs

@@ -157,3 +157,63 @@ e: test-2@2!
   123 =assert
   999 =assert
 ;e
+
+e: test-/
+  101 2 / 50 =assert
+  101 -2 / -51 =assert
+  -101 -2 / 50 =assert
+  -101 2 / -51 =assert
+
+  100 2 / 50 = assert
+  100 -2 / -50 = assert
+  -100 -2 / 50 = assert
+  -100 2 / -50 = assert
+;e
+
+e: test-mod
+  101 2 mod 1 =assert
+  101 -2 mod -1 =assert
+  -101 -2 mod -1 =assert
+  -101 2 mod 1 =assert
+
+  100 2 mod 0 =assert
+  100 -2 mod 0 =assert
+  -100 -2 mod 0 =assert
+  -100 2 mod 0 =assert
+;e
+
+e: test-/mod-consistent
+  101 2 /mod 50 =assert 1 =assert
+  101 -2 /mod -51 =assert -1 =assert
+  -101 -2 /mod 50 =assert -1 =assert
+  -101 2 /mod -51 =assert 1 =assert
+
+  100 2 /mod 50 = assert 0 =assert
+  100 -2 /mod -50 = assert 0 =assert
+  -100 -2 /mod 50 = assert 0 =assert
+  -100 2 /mod -50 = assert 0 =assert
+;e
+
+e: test-/mod-consistent
+  : /mod-check { a b -- } a b /mod b * + a = assert ;
+  101 2 /mod-check
+  101 -2 /mod-check
+  -101 2 /mod-check
+  -101 -2 /mod-check
+  100 2 /mod-check
+  100 -2 /mod-check
+  -100 2 /mod-check
+  -100 -2 /mod-check
+;e
+
+e: test-*/
+  50 2 4 */ 25 =assert
+  -50 2 4 */ -25 =assert
+;e
+
+e: test-/cell
+  10 cells cell/ 10 =assert
+  10 cells 1+ cell/ 10 =assert
+  -10 cells cell/ -10 =assert
+  -10 cells 1- cell/ -11 =assert
+;e

common/throw_values_tests.fs

@@ -23,3 +23,54 @@ e: test-abort"
   ' test catch -2 =assert
   out: doh!
 ;e
+
+( Skip on ESP32 as not emulated. )
+DEFINED? esp 0= [IF]
+
+e: test-0/
+  123 0 ' / catch -10 =assert
+  0 =assert 123 =assert
+;e
+
+e: test-0mod
+  123 0 ' mod catch -10 =assert
+  0 =assert 123 =assert
+;e
+
+e: test-0*/
+  123 456 0 ' */ catch -10 =assert
+  0 =assert 456 =assert 123 =assert
+;e
+
+e: test-0*/mod
+  123 456 0 ' */mod catch -10 =assert
+  0 =assert 456 =assert 123 =assert
+;e
+
+e: test-0/mod
+  123 0 ' /mod catch -10 =assert
+  0 =assert 123 =assert
+;e
+
+e: test-bad-load
+  0 ' @ catch -9 =assert
+  0 =assert
+;e
+
+e: test-bad-store
+  123 0 ' ! catch -9 =assert
+  0 =assert 123 =assert
+;e
+
+( Skip on win64 because wine can't handle these, unsure why. )
+DEFINED? windows 0= cell 4 = or [IF]
+
+e: test-bad-execute
+  internals
+  0 ' call0 catch -9 =assert
+  0 =assert
+;e
+
+[THEN]
+
+[THEN]

common/tier0_opcodes.h

@@ -66,10 +66,30 @@ typedef int64_t dcell_t;
 #  error "unsupported cell size"
 # endif
 # define SSMOD_FUNC dcell_t d = (dcell_t) *sp * (dcell_t) sp[-1]; \
-                    --sp; cell_t a = (cell_t) (d < 0 ? ~(~d / tos) : d / tos); \
+                    --sp; cell_t a = (cell_t) (d / tos); \
+                    a = a * tos == d ? a : a - ((d < 0) ^ (tos < 0)); \
                     *sp = (cell_t) (d - ((dcell_t) a) * tos); tos = a
 #endif
 
+#ifdef WEB_DUMP
+// Use */mod as the base for the web version.
+# define SLASHMOD_FUNC DUP; *sp = 1; SSMOD_FUNC
+# define SLASH_FUNC SLASHMOD_FUNC; NIP
+# define MOD_FUNC SLASHMOD_FUNC; DROP
+# define CELLSLASH_FUNC DUP; tos = sizeof(cell_t); SLASH_FUNC
+#else
+// Use separate versions for non-web so throw has the right depth.
+# define SLASHMOD_FUNC cell_t d = *sp; cell_t a = d / tos; \
+                       cell_t b = a * tos == d ? a : a - ((d < 0) ^ (tos < 0)); \
+                       *sp = d - b * tos; tos = b
+# define SLASH_FUNC cell_t d = *sp; cell_t a = d / tos; NIP; \
+                    tos = a * tos == d ? a : a - ((d < 0) ^ (tos < 0))
+# define MOD_FUNC cell_t d = *sp; cell_t a = d / tos; \
+                  cell_t b = a * tos == d ? a : a - ((d < 0) ^ (tos < 0)); \
+                  NIP; tos = d - b * tos
+# define CELLSLASH_FUNC tos = tos < 0 ? ~(~tos / sizeof(cell_t)) : tos / sizeof(cell_t)
+#endif
+
 typedef struct {
   const char *name;
   union {

common/tier1_opcodes.h

@@ -17,9 +17,9 @@
   Y(rdrop, --rp) \
   XV(forth, "*/", STARSLASH, SSMOD_FUNC; NIP) \
   X("*", STAR, tos *= *sp--) \
-  X("/mod", SLASHMOD, DUP; *sp = 1; SSMOD_FUNC) \
-  X("/", SLASH, DUP; *sp = 1; SSMOD_FUNC; NIP) \
-  Y(mod, DUP; *sp = 1; SSMOD_FUNC; DROP) \
+  X("/mod", SLASHMOD, SLASHMOD_FUNC) \
+  X("/", SLASH, SLASH_FUNC) \
+  X("mod", MOD, MOD_FUNC) \
   Y(invert, tos = ~tos) \
   Y(negate, tos = -tos) \
   X("-", MINUS, tos = (*sp--) - tos) \
@@ -44,7 +44,7 @@
   X("+!", PLUSSTORE, *((cell_t *) tos) += *sp--; DROP) \
   X("cell+", CELLPLUS, tos += sizeof(cell_t)) \
   Y(cells, tos *= sizeof(cell_t)) \
-  X("cell/", CELLSLASH, DUP; tos = sizeof(cell_t); DUP; *sp = 1; SSMOD_FUNC; NIP) \
+  X("cell/", CELLSLASH, CELLSLASH_FUNC) \
   X("2drop", TWODROP, NIP; DROP) \
   X("2dup", TWODUP, DUP; tos = sp[-1]; DUP; tos = sp[-1]) \
   X("2@", TWOAT, DUP; *sp = *(cell_t *) tos; tos = ((cell_t *) tos)[1]) \