diff --git a/common/base_tests.fs b/common/base_tests.fs index 68ced6b..6c59a1a 100644 --- a/common/base_tests.fs +++ b/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 diff --git a/common/throw_values_tests.fs b/common/throw_values_tests.fs index b0fc4fa..49d2b52 100644 --- a/common/throw_values_tests.fs +++ b/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] diff --git a/common/tier0_opcodes.h b/common/tier0_opcodes.h index 8b5e1d3..c4447c4 100644 --- a/common/tier0_opcodes.h +++ b/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 { diff --git a/common/tier1_opcodes.h b/common/tier1_opcodes.h index cf71fb3..e70caee 100644 --- a/common/tier1_opcodes.h +++ b/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]) \ diff --git a/esp32/faults.h b/esp32/faults.h index a28e97c..9ed3790 100644 --- a/esp32/faults.h +++ b/esp32/faults.h @@ -23,10 +23,22 @@ static __thread int g_forth_signal; static __thread uint32_t g_forth_setlevel; #define FAULT_ENTRY \ - if (setjmp(g_forth_fault)) { THROWIT(-g_forth_signal); } + if (setjmp(g_forth_fault)) { THROWIT(g_forth_signal); } static void IRAM_ATTR forth_exception_handler(XtExcFrame *frame) { - g_forth_signal = frame->exccause; + switch (frame->exccause) { + case EXCCAUSE_LOAD_STORE_ERROR: + case EXCCAUSE_LOAD_PROHIBITED: + case EXCCAUSE_STORE_PROHIBITED: + case EXCCAUSE_LOAD_STORE_DATA_ERROR: + case EXCCAUSE_LOAD_STORE_RING: + case EXCCAUSE_LOAD_STORE_ADDR_ERROR: + g_forth_signal = -9; + break; + case EXCCAUSE_DIVIDE_BY_ZERO: g_forth_signal = -10; break; + case EXCCAUSE_UNALIGNED: g_forth_signal = -23; break; + default: g_forth_signal = -256 - frame->exccause; break; + } XTOS_RESTORE_INTLEVEL(g_forth_setlevel); longjmp(g_forth_fault, 1); } diff --git a/posix/faults.h b/posix/faults.h index 521940f..0bc2027 100644 --- a/posix/faults.h +++ b/posix/faults.h @@ -19,10 +19,16 @@ static __thread jmp_buf g_forth_fault; static __thread int g_forth_signal; #define FAULT_ENTRY \ - if (setjmp(g_forth_fault)) { THROWIT(-g_forth_signal); } + if (setjmp(g_forth_fault)) { THROWIT(g_forth_signal); } static void forth_signal_handler(int sig) { - g_forth_signal = sig; + switch (sig) { + case SIGSEGV: g_forth_signal = -9; break; + case SIGBUS: g_forth_signal = -23; break; + case SIGINT: g_forth_signal = -28; break; + case SIGFPE: g_forth_signal = -10; break; + default: g_forth_signal = -256 - sig; break; + } sigset_t ss; sigemptyset(&ss); sigprocmask(SIG_SETMASK, &ss, 0); diff --git a/web/dump_web_opcodes.c b/web/dump_web_opcodes.c index 6fdaa29..4972810 100644 --- a/web/dump_web_opcodes.c +++ b/web/dump_web_opcodes.c @@ -17,6 +17,7 @@ #define JMPW continue decode #define SSMOD_FUNC SSMOD_FUNC +#define WEB_DUMP #define COMMA COMMA #include "common/tier0_opcodes.h" diff --git a/web/web.template.js b/web/web.template.js index 11a5f40..d049685 100644 --- a/web/web.template.js +++ b/web/web.template.js @@ -192,10 +192,6 @@ function SSMOD(sp) { a *= b; var x = Math.floor(a / c); var m = a - x * c; - if (m < 0) { - x--; - m += c; - } i32[(sp - 8)>>2] = m; i32[sp>>2] = x; } diff --git a/windows/interp.h b/windows/interp.h index 6c65c3f..e2fae6f 100644 --- a/windows/interp.h +++ b/windows/interp.h @@ -62,7 +62,12 @@ work: } } } __except (EXCEPTION_EXECUTE_HANDLER) { - THROWIT(GetExceptionCode()); + DWORD code = GetExceptionCode(); + switch (code) { + case EXCEPTION_INT_DIVIDE_BY_ZERO: THROWIT(-10); break; + case EXCEPTION_ACCESS_VIOLATION: THROWIT(-9); break; + default: THROWIT(code); break; + } } } }