>number

diff --git a/Makefile b/Makefile
index 04791712df23942a747317417a8e5ea8fafe54e8..3ae2e234cad0bfe608db9e7962f23b55be838239 100644 (file)
--- a/Makefile
+++ b/Makefile
@@ -21,11 +21,11 @@ small: alee
 fast: CXXFLAGS += -O3 -march=native -mtune=native -flto
 fast: alee
 
-standalone: core.fth.h alee-standalone
+standalone: alee-standalone
 
 alee: $(LIBFILE)
 msp430/alee-msp430: $(LIBFILE)
-alee-standalone: $(LIBFILE)
+alee-standalone: core.fth.h $(LIBFILE)
 
 cppcheck:
        cppcheck --enable=warning,style,information --disable=missingInclude \

diff --git a/README.md b/README.md
index 90cfaafa07353e218e113d0c45844eab276c7ebe..148d51d269faa87634fe51b4423d3c08115e6c19 100644 (file)
--- a/README.md
+++ b/README.md
@@ -18,7 +18,6 @@ Running Alee without `core.fth` or `core-ext.fth` passed as arguments will leave
 
 **Missing** core features:  
 * Pictured numeric output conversion (e.g. `<# #>`)
-* `>NUMBER`
 
 **Missing** core extensions:  
 ```

diff --git a/compat.txt b/compat.txt
index 3de92fbea058aae910dadf60e84e3584a6f088b6..49d39cf8f629b00c3357e13a49756588f2961ff9 100644 (file)
--- a/compat.txt
+++ b/compat.txt
@@ -38,7 +38,7 @@ yes 6.1.0530 =
 yes 6.1.0540 >
 yes 6.1.0550 >BODY
 yes 6.1.0560 >IN
-    6.1.0570 >NUMBER
+yes 6.1.0570 >NUMBER
 yes 6.1.0580 >R
 yes 6.1.0630 ?DUP
 yes 6.1.0650 @

diff --git a/forth/core.fth b/forth/core.fth
index bbaa67dfdd874c5f8d7f24a780042baae46bd3b1..f16224ac48bcc84c698c42147a2d168a901a617e 100644 (file)
--- a/forth/core.fth
+++ b/forth/core.fth
@@ -2,6 +2,7 @@
 : s>d      1 m* ;
 : /        >r s>d r> _/ ;
 : %        >r s>d r> _% ;
+: um*      0 swap 0 _uma ;
 
 : cell+    2 + ;
 : cells    2 * ;
@@ -201,3 +202,18 @@
 : evaluate _source @ >r _sourceu @ >r >in @ >r
            0 >in ! _sourceu ! _source ! _ev
            r> >in ! r> _sourceu ! r> _source ! ;
+
+: _isdigit ( ch -- bch )
+  dup [char] 0 over <= swap [char] 0 base @ 10 min 1- + <= and
+  if drop [char] 0 exit then
+  base @ 11 < if drop 0 exit then
+  base @ 36 min 10 - >r
+  dup [char] a over <= swap [char] a r@ + < and
+  if r> 2drop [char] a 10 - exit then
+  [char] A over <= swap [char] A r> + < and
+  if [char] A 10 - else 0 then ;
+: >number  begin dup 0 >
+           dup if drop over c@ _isdigit then while
+           >r dup c@ swap >r base @ swap
+           dup _isdigit - _uma
+           r> char+ r> 1- repeat ;

diff --git a/forth/test/core.fr b/forth/test/core.fr
index 42fff2585960110feb329643d0ffc8facef71aaa..f326432b685d67df0a29cd99106f0d28f13adfed 100644 (file)
--- a/forth/test/core.fr
+++ b/forth/test/core.fr
@@ -820,6 +820,7 @@ T{ GS4 123 456
 
 \ \ ------------------------------------------------------------------------
 \ TESTING <# # #S #> HOLD SIGN BASE >NUMBER HEX DECIMAL
+." TESTING BASE >NUMBER HEX DEMICAL" CR
 \ 
 \ : S=  \ ( ADDR1 C1 ADDR2 C2 -- T/F ) COMPARE TWO STRINGS.
 \    >R SWAP R@ = IF         \ MAKE SURE STRINGS HAVE SAME LENGTH
@@ -845,12 +846,12 @@ T{ GS4 123 456
 \ 
 \ : GP4  <# 1 0 #S #> S" 1" S= ;
 \ T{ GP4 -> <TRUE> }T
-\ 
-\ 24 CONSTANT MAX-BASE         \ BASE 2 .. 36
-\ : COUNT-BITS
-\    0 0 INVERT BEGIN DUP WHILE >R 1+ R> 2* REPEAT DROP ;
-\ COUNT-BITS 2* CONSTANT #BITS-UD      \ NUMBER OF BITS IN UD
-\ 
+
+24 CONSTANT MAX-BASE         \ BASE 2 .. 36
+: COUNT-BITS
+   0 0 INVERT BEGIN DUP WHILE >R 1+ R> 2* REPEAT DROP ;
+COUNT-BITS 2* CONSTANT #BITS-UD      \ NUMBER OF BITS IN UD
+
 \ : GP5
 \    BASE @ <TRUE>
 \    MAX-BASE 1+ 2 DO         \ FOR EACH POSSIBLE BASE
@@ -885,30 +886,30 @@ T{ GS4 123 456
 \    R> BASE ! ;
 \ 
 \ T{ GP7 -> <TRUE> }T
-\ 
-\ \ >NUMBER TESTS
-\ CREATE GN-BUF 0 C,
-\ : GN-STRING   GN-BUF 1 ;
-\ : GN-CONSUMED   GN-BUF CHAR+ 0 ;
-\ : GN'      [CHAR] ' WORD CHAR+ C@ GN-BUF C!  GN-STRING ;
-\ 
-\ T{ 0 0 GN' 0' >NUMBER -> 0 0 GN-CONSUMED }T
-\ T{ 0 0 GN' 1' >NUMBER -> 1 0 GN-CONSUMED }T
-\ T{ 1 0 GN' 1' >NUMBER -> BASE @ 1+ 0 GN-CONSUMED }T
-\ T{ 0 0 GN' -' >NUMBER -> 0 0 GN-STRING }T   \ SHOULD FAIL TO CONVERT THESE
-\ T{ 0 0 GN' +' >NUMBER -> 0 0 GN-STRING }T
-\ T{ 0 0 GN' .' >NUMBER -> 0 0 GN-STRING }T
-\ 
-\ : >NUMBER-BASED
-\    BASE @ >R BASE ! >NUMBER R> BASE ! ;
-\ 
-\ T{ 0 0 GN' 2' 10 >NUMBER-BASED -> 2 0 GN-CONSUMED }T
-\ T{ 0 0 GN' 2'  2 >NUMBER-BASED -> 0 0 GN-STRING }T
-\ T{ 0 0 GN' F' 10 >NUMBER-BASED -> F 0 GN-CONSUMED }T
-\ T{ 0 0 GN' G' 10 >NUMBER-BASED -> 0 0 GN-STRING }T
-\ T{ 0 0 GN' G' MAX-BASE >NUMBER-BASED -> 10 0 GN-CONSUMED }T
-\ T{ 0 0 GN' Z' MAX-BASE >NUMBER-BASED -> 23 0 GN-CONSUMED }T
-\ 
+
+\ >NUMBER TESTS
+CREATE GN-BUF 0 C,
+: GN-STRING   GN-BUF 1 ;
+: GN-CONSUMED   GN-BUF CHAR+ 0 ;
+: GN'      [CHAR] ' WORD CHAR+ C@ GN-BUF C!  GN-STRING ;
+
+T{ 0 0 GN' 0' >NUMBER -> 0 0 GN-CONSUMED }T
+T{ 0 0 GN' 1' >NUMBER -> 1 0 GN-CONSUMED }T
+T{ 1 0 GN' 1' >NUMBER -> BASE @ 1+ 0 GN-CONSUMED }T
+T{ 0 0 GN' -' >NUMBER -> 0 0 GN-STRING }T   \ SHOULD FAIL TO CONVERT THESE
+T{ 0 0 GN' +' >NUMBER -> 0 0 GN-STRING }T
+T{ 0 0 GN' .' >NUMBER -> 0 0 GN-STRING }T
+
+: >NUMBER-BASED
+   BASE @ >R BASE ! >NUMBER R> BASE ! ;
+
+T{ 0 0 GN' 2' 10 >NUMBER-BASED -> 2 0 GN-CONSUMED }T
+T{ 0 0 GN' 2'  2 >NUMBER-BASED -> 0 0 GN-STRING }T
+T{ 0 0 GN' F' 10 >NUMBER-BASED -> F 0 GN-CONSUMED }T
+T{ 0 0 GN' G' 10 >NUMBER-BASED -> 0 0 GN-STRING }T
+T{ 0 0 GN' G' MAX-BASE >NUMBER-BASED -> 10 0 GN-CONSUMED }T
+T{ 0 0 GN' Z' MAX-BASE >NUMBER-BASED -> 23 0 GN-CONSUMED }T
+
 \ : GN1   \ ( UD BASE -- UD' LEN ) UD SHOULD EQUAL UD' AND LEN SHOULD BE ZERO.
 \    BASE @ >R BASE !
 \    <# #S #>
@@ -920,11 +921,11 @@ T{ GS4 123 456
 \ T{ 0 0 MAX-BASE GN1 -> 0 0 0 }T
 \ T{ MAX-UINT 0 MAX-BASE GN1 -> MAX-UINT 0 0 }T
 \ T{ MAX-UINT DUP MAX-BASE GN1 -> MAX-UINT DUP 0 }T
-\ 
-\ : GN2   \ ( -- 16 10 )
-\    BASE @ >R  HEX BASE @  DECIMAL BASE @  R> BASE ! ;
-\ T{ GN2 -> 10 A }T
-\ 
+
+: GN2   \ ( -- 16 10 )
+   BASE @ >R  HEX BASE @  DECIMAL BASE @  R> BASE ! ;
+T{ GN2 -> 10 A }T
+
 \ ------------------------------------------------------------------------
 ." TESTING FILL MOVE" CR
 

diff --git a/libalee/corewords.cpp b/libalee/corewords.cpp
index b12f53b0ca82de23e0f34bffe4123b1dcb22b5d8..9fef7b1c2565b8b73391ae2ebc655830fb1c19a9 100644 (file)
--- a/libalee/corewords.cpp
+++ b/libalee/corewords.cpp
@@ -222,13 +222,18 @@ execute:
         find(state, word);
         }
         break;
-    case 34: // um*
+    case 34: // _uma
+        {
+        const auto plus = state.pop();
         cell = state.pop();
-        dcell = static_cast<DoubleCell>(
-            static_cast<Addr>(state.pop()) *
-            static_cast<Addr>(cell));
+        dcell = state.pop();
+        dcell <<= sizeof(Cell) * 8;
+        dcell |= static_cast<Addr>(state.pop());
+        dcell *= static_cast<Addr>(cell);
+        dcell += static_cast<Addr>(plus);
         state.push(dcell);
         state.push(dcell >> (sizeof(Cell) * 8));
+        }
         break;
     case 35: // u<
         cell = state.pop();

diff --git a/libalee/corewords.hpp b/libalee/corewords.hpp
index f6465c46fca0938a03e7f5adb013b0d4ac0a25db..993a42042d41938b2faabaf4613cada05e5ada9b 100644 (file)
--- a/libalee/corewords.hpp
+++ b/libalee/corewords.hpp
@@ -54,7 +54,7 @@ public:
         "<<\0>>\0:\0_'\0execute\0"
         "exit\0;\0_jmp0\0_jmp\0"
         "depth\0_rdepth\0_in\0_ev\0find\0"
-        "um*\0u<\0um/mod\0";
+        "_uma\0u<\0um/mod\0";
 };
 
 #endif // ALEEFORTH_COREWORDS_HPP