Switched to no ftos, to allow throw/catch.

Hitting longstanding bug with see-all in httpd

ueforth/common/boot.fs

@@ -153,9 +153,11 @@ variable leaving
 ( Exceptions )
 variable handler
 : catch ( xt -- n )
-  sp@ >r handler @ >r rp@ handler ! execute r> handler ! r> drop 0 ;
+  fp@ >r sp@ >r handler @ >r rp@ handler ! execute
+  r> handler ! rdrop rdrop 0 ;
 : throw ( n -- )
-  dup if handler @ rp! r> handler ! r> swap >r sp! drop r> else drop then ;
+  dup if handler @ rp! r> handler !
+         r> swap >r sp! drop r> r> fp! else drop then ;
 ' throw 'notfound !
 
 ( Values )
@@ -252,6 +254,6 @@ create input-buffer   input-limit allot
                       #tib ! 'tib ! 0 >in ! evaluate-buffer
                       r> >in ! r> #tib ! r> 'tib ! ;
 : quit    begin ['] evaluate-buffer catch
-          if 0 state ! sp0 sp! rp0 rp! ." ERROR" cr then
+          if 0 state ! sp0 sp! fp0 fp! rp0 rp! ." ERROR" cr then
           prompt refill drop again ;
 : ok   ." uEForth" cr prompt refill drop quit ;

ueforth/common/float_tests.fs

@@ -55,3 +55,10 @@ e: test-fover
   123e 234e fover f. f. f. cr
   out: 123.000000 234.000000 123.000000 
 ;e
+
+e: test-throw
+  : bar   123e 124e 125e 1 throw ;
+  : foo   99e ['] bar catch . f. ;
+  foo cr
+  out: 1 99.000000 
+;e

ueforth/common/floats.fs

@@ -34,11 +34,11 @@ $7f800000 constant exp-mask
 $3f000000 constant half-mask
 $007fffff constant mantissa-mask
 : fsplit ( r -- r f n )
-  fdup fp@ l@ dup mantissa-mask and half-mask or fp@ l!
+  fp@ l@ dup mantissa-mask and half-mask or fp@ l!
-  dup 0< swap exp-mask and 23 rshift 126 - fdrop ;
+  dup 0< swap exp-mask and 23 rshift 126 - ;
 : fjoin ( r f n -- r )
   127 + 23 lshift swap $80000000 and or
-  1e fswap fp@ @ mantissa-mask and or fp@ ! f* ;
+  1e fp@ @ mantissa-mask and or fp@ ! f* ;
 forth definitions internals
 
 : 1/f ( r -- r ) fsplit negate 1/f' fjoin ;

ueforth/common/floats.h

@@ -12,24 +12,21 @@
 // See the License for the specific language governing permissions and
 // limitations under the License.
 
-#define FDUP (*++fp = ftos)
-#define FDROP (ftos = *fp--)
-
 #define FLOATING_POINT_LIST \
-  Y(DOFLIT, FDUP; ftos = *(float *) ip++) \
+  Y(DOFLIT, *++fp = *(float *) ip++) \
   X("FP@", FPAT, DUP; tos = (cell_t) fp) \
   X("FP!", FPSTORE, fp = (float *) tos; DROP) \
-  X("SF@", FAT, FDUP; ftos = *(float *) tos; DROP) \
+  X("SF@", FAT, *++fp = *(float *) tos; DROP) \
-  X("SF!", FSTORE, *(float *) tos = ftos; FDROP; DROP) \
+  X("SF!", FSTORE, *(float *) tos = *fp--; DROP) \
-  X("FDUP", FDUP, FDUP) \
+  X("FDUP", FDUP, fp[1] = *fp; ++fp) \
-  X("FDROP", FDROP, FDROP) \
+  X("FDROP", FDROP, --fp) \
-  X("FOVER", FOVER, FDUP; ftos = fp[-1]) \
+  X("FOVER", FOVER, fp[1] = fp[-1]; ++fp) \
-  X("FSWAP", FSWAP, float ft = ftos; ftos = *fp; *fp = ft) \
+  X("FSWAP", FSWAP, float ft = fp[-1]; fp[-1] = *fp; *fp = ft) \
-  X("FNEGATE", FNEGATE, ftos = -ftos) \
+  X("FNEGATE", FNEGATE, *fp = -*fp) \
-  X("F0<", FZLESS, DUP; tos = ftos < 0 ? -1 : 0; FDROP) \
+  X("F0<", FZLESS, DUP; tos = *fp-- < 0 ? -1 : 0) \
-  X("F+", FPLUS, ftos += *fp--) \
+  X("F+", FPLUS, fp[-1] += *fp; --fp) \
-  X("F-", FMINUS, ftos = (*fp--) - ftos) \
+  X("F-", FMINUS, fp[-1] -= *fp; --fp) \
-  X("F*", FSTAR, ftos *= *fp--) \
+  X("F*", FSTAR, fp[-1] *= *fp; --fp) \
-  X("S>F", STOF, FDUP; ftos = (float) tos; DROP) \
+  X("S>F", STOF, *++fp = (float) tos; DROP) \
-  X("F>S", FTOS, DUP; tos = (cell_t) ftos; FDROP) \
+  X("F>S", FTOS, DUP; tos = (cell_t) *fp--) \
 

ueforth/common/interp.h

@@ -27,10 +27,10 @@ static cell_t *forth_run(cell_t *init_rp) {
     return 0;
   }
   register cell_t *ip, *rp, *sp, tos, w;
-  register float ftos, *fp;
+  register float *fp;
   rp = init_rp;  ip = (cell_t *) *rp--;  sp = (cell_t *) *rp--;
   fp = (float *) *rp--;
-  DROP; FDROP; NEXT;
+  DROP; NEXT;
 #define X(name, op, code) OP_ ## op: { code; } NEXT;
   PLATFORM_OPCODE_LIST
   OPCODE_LIST

ueforth/common/opcodes.h

@@ -86,8 +86,7 @@ typedef int64_t dcell_t;
   Y(PARSE, DUP; tos = parse(tos, sp)) \
   X("S>NUMBER?", CONVERT, tos = convert((const char *) *sp, tos, g_sys.base, sp); \
                           if (!tos) --sp) \
-  X("F>NUMBER?", FCONVERT, FDUP; tos = fconvert((const char *) *sp, tos, fp); \
+  X("F>NUMBER?", FCONVERT, tos = fconvert((const char *) *sp, tos, fp); --sp) \
-                           --sp; FDROP) \
   Y(CREATE, DUP; DUP; tos = parse(32, sp); \
             create((const char *) *sp, tos, 0, ADDR_DOCREATE); \
             COMMA(0); DROPn(2)) \
@@ -98,9 +97,9 @@ typedef int64_t dcell_t;
   X(":", COLON, DUP; DUP; tos = parse(32, sp); \
                 create((const char *) *sp, tos, SMUDGE, ADDR_DOCOLON); \
                 g_sys.state = -1; --sp; DROP) \
-  Y(EVALUATE1, DUP; FDUP; float *tfp = fp; \
+  Y(EVALUATE1, DUP; float *tfp = fp; \
                sp = evaluate1(sp, &tfp); \
-               fp = tfp; FDROP; w = *sp--; DROP; if (w) JMPW) \
+               fp = tfp; w = *sp--; DROP; if (w) JMPW) \
   Y(EXIT, ip = (cell_t *) *rp--) \
   X(";", SEMICOLON, UNSMUDGE(); COMMA(g_sys.DOEXIT_XT); g_sys.state = 0) \
 

ueforth/windows/windows_interp.h

@@ -38,10 +38,10 @@ static cell_t *forth_run(cell_t *init_rp) {
     return 0;
   }
   register cell_t *ip, *rp, *sp, tos, w;
-  register float ftos, *fp;
+  register float *fp;
   rp = init_rp;  ip = (cell_t *) *rp--;  sp = (cell_t *) *rp--;
   fp = (float *) *rp--;
-  DROP; FDROP;
+  DROP;
   for (;;) {
 next:
     w = *ip++;