>number

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 \

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:  
 ```

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 @

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 ;

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
+24 CONSTANT MAX-BASE         \ BASE 2 .. 36
-\ : COUNT-BITS
+: COUNT-BITS
-\    0 0 INVERT BEGIN DUP WHILE >R 1+ R> 2* REPEAT DROP ;
+   0 0 INVERT BEGIN DUP WHILE >R 1+ R> 2* REPEAT DROP ;
-\ COUNT-BITS 2* CONSTANT #BITS-UD      \ NUMBER OF BITS IN UD
+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
+\ >NUMBER TESTS
-\ CREATE GN-BUF 0 C,
+CREATE GN-BUF 0 C,
-\ : GN-STRING   GN-BUF 1 ;
+: GN-STRING   GN-BUF 1 ;
-\ : GN-CONSUMED   GN-BUF CHAR+ 0 ;
+: GN-CONSUMED   GN-BUF CHAR+ 0 ;
-\ : GN'      [CHAR] ' WORD CHAR+ C@ GN-BUF C!  GN-STRING ;
+: 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' 0' >NUMBER -> 0 0 GN-CONSUMED }T
-\ T{ 0 0 GN' 1' >NUMBER -> 1 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{ 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   \ 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
-\ T{ 0 0 GN' .' >NUMBER -> 0 0 GN-STRING }T
+T{ 0 0 GN' .' >NUMBER -> 0 0 GN-STRING }T
-\ 
+
-\ : >NUMBER-BASED
+: >NUMBER-BASED
-\    BASE @ >R BASE ! >NUMBER R> BASE ! ;
+   BASE @ >R BASE ! >NUMBER R> BASE ! ;
-\ 
+
-\ T{ 0 0 GN' 2' 10 >NUMBER-BASED -> 2 0 GN-CONSUMED }T
+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' 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' 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' 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' G' MAX-BASE >NUMBER-BASED -> 10 0 GN-CONSUMED }T
-\ T{ 0 0 GN' Z' MAX-BASE >NUMBER-BASED -> 23 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 )
+: GN2   \ ( -- 16 10 )
-\    BASE @ >R  HEX BASE @  DECIMAL BASE @  R> BASE ! ;
+   BASE @ >R  HEX BASE @  DECIMAL BASE @  R> BASE ! ;
-\ T{ GN2 -> 10 A }T
+T{ GN2 -> 10 A }T
-\ 
+
 \ ------------------------------------------------------------------------
 ." TESTING FILL MOVE" CR
 

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>(
+        dcell = state.pop();
-            static_cast<Addr>(state.pop()) *
+        dcell <<= sizeof(Cell) * 8;
-            static_cast<Addr>(cell));
+        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();

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