bitgloo
/
alee-forth
1
0
Fork 0
Code Issues Pull Requests Projects Releases Wiki Activity

>number

Browse Source
llvm
Clyne 2 years ago
parent c46f531b6b
commit 74753670d5
7 changed files with 65 additions and 44 deletions
Show Stats Download Patch File Download Diff File

4
Makefile
Unescape Escape View File

@ -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 \

1
README.md
Unescape Escape View File

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

2
compat.txt
Unescape Escape View File

@ -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 @

16
forth/core.fth
Unescape Escape View File

@ -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 ;

71
forth/test/core.fr
Unescape Escape View File

@ -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

13
libalee/corewords.cpp
Unescape Escape View File

@ -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();

2
libalee/corewords.hpp
Unescape Escape View File

@ -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

Write Preview
Loading…
Cancel
Save