From 74753670d582e4ceeaba383e4ce360eb13004a35 Mon Sep 17 00:00:00 2001 From: Clyne Sullivan Date: Tue, 14 Mar 2023 09:44:08 -0400 Subject: [PATCH] >number --- Makefile | 4 +-- README.md | 1 - compat.txt | 2 +- forth/core.fth | 16 ++++++++++ forth/test/core.fr | 71 ++++++++++++++++++++++--------------------- libalee/corewords.cpp | 13 +++++--- libalee/corewords.hpp | 2 +- 7 files changed, 65 insertions(+), 44 deletions(-) diff --git a/Makefile b/Makefile index 0479171..3ae2e23 100644 --- 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 90cfaaf..148d51d 100644 --- 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 3de92fb..49d39cf 100644 --- 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 bbaa67d..f16224a 100644 --- 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 42fff25..f326432 100644 --- 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 -> }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 @ \ MAX-BASE 1+ 2 DO \ FOR EACH POSSIBLE BASE @@ -885,30 +886,30 @@ T{ GS4 123 456 \ R> BASE ! ; \ \ T{ GP7 -> }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 b12f53b..9fef7b1 100644 --- 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( - static_cast(state.pop()) * - static_cast(cell)); + dcell = state.pop(); + dcell <<= sizeof(Cell) * 8; + dcell |= static_cast(state.pop()); + dcell *= static_cast(cell); + dcell += static_cast(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 f6465c4..993a420 100644 --- 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