diff options
| author | Clyne Sullivan <clyne@bitgloo.com> | 2023-10-25 05:41:35 -0400 |
|---|---|---|
| committer | Clyne Sullivan <clyne@bitgloo.com> | 2023-10-25 05:41:35 -0400 |
| commit | 7381e87be6f2fa545e11a0a538291e7e2fc1e1a6 (patch) | |
| tree | 69518452aaed11bc44b9c0c21f39b91974cb4870 | |
| parent | 194acf022da8099126a096751294fe8e41a20343 (diff) | |
100% core test passing
| -rw-r--r-- | forth/core.fth | 12 | ||||
| -rw-r--r-- | forth/test/core.fr | 14 |
2 files changed, 12 insertions, 14 deletions
diff --git a/forth/core.fth b/forth/core.fth index ec4bcb5..071af33 100644 --- a/forth/core.fth +++ b/forth/core.fth @@ -85,10 +85,11 @@ : unloop postpone 2r> ['] 2drop , ['] r> , ['] drop , ; imm : leave postpone 2r> ['] 2drop , postpone 2r> ['] drop , ['] >r , ['] exit , ; imm -: +loop postpone 2r> ['] 2dup , ['] swap , ['] < , ['] >r , - ['] rot , ['] + , ['] 2dup , ['] swap , ['] < , - ['] r> , ['] ^ , ['] -rot , - postpone 2>r ['] _jmp0 , , +: +loop ['] r> , ['] 2dup , ['] + , + postpone r@ ['] swap , ['] >r , + ['] - , ['] 2dup , ['] + , ['] over , ['] ^ , + ['] rot , ['] rot , ['] ^ , ['] & , ['] _lit , 0 , + ['] < , ['] _jmp0 , , postpone unloop here swap ! ; imm : loop postpone 2r> ['] 1+ , ['] 2dup , postpone 2>r ['] = , ['] _jmp0 , , @@ -131,7 +132,7 @@ : min 2dup <= if drop else swap drop then ; : max 2dup <= if swap drop else drop then ; -: source _source @ 0 begin 2dup + c@ while char+ repeat ; +: source _source @ _sourceu @ ; : key _source @ >in @ + begin dup c@ 0 = while _in repeat c@ 1 >in +! ; @@ -227,4 +228,3 @@ if 7 + then 48 + hold ; : #s begin # 2dup or 0= until ; : sign 0< if [char] - hold then ; - diff --git a/forth/test/core.fr b/forth/test/core.fr index 0e9ced9..31f0ff2 100644 --- a/forth/test/core.fr +++ b/forth/test/core.fr @@ -713,17 +713,17 @@ T{ MID-UINT+1 MID-UINT GD1 -> MID-UINT }T T{ : GD2 DO I -1 +LOOP ; -> }T T{ 1 4 GD2 -> 4 3 2 1 }T T{ -1 2 GD2 -> 2 1 0 -1 }T -\ T{ MID-UINT MID-UINT+1 GD2 -> MID-UINT+1 MID-UINT }T +T{ MID-UINT MID-UINT+1 GD2 -> MID-UINT+1 MID-UINT }T T{ : GD3 DO 1 0 DO J LOOP LOOP ; -> }T T{ 4 1 GD3 -> 1 2 3 }T T{ 2 -1 GD3 -> -1 0 1 }T -\ T{ MID-UINT+1 MID-UINT GD3 -> MID-UINT }T +T{ MID-UINT+1 MID-UINT GD3 -> MID-UINT }T T{ : GD4 DO 1 0 DO J LOOP -1 +LOOP ; -> }T T{ 1 4 GD4 -> 4 3 2 1 }T T{ -1 2 GD4 -> 2 1 0 -1 }T -\ T{ MID-UINT MID-UINT+1 GD4 -> MID-UINT+1 MID-UINT }T +T{ MID-UINT MID-UINT+1 GD4 -> MID-UINT+1 MID-UINT }T T{ : GD5 123 SWAP 0 DO I 4 > IF DROP 234 LEAVE THEN LOOP ; -> }T T{ 1 GD5 -> 123 }T @@ -795,10 +795,9 @@ T{ GE7 -> 124 }T \ ------------------------------------------------------------------------ ." TESTING SOURCE >IN WORD" CR -\ String is compiled into GS1 and is distinct from SOURCE. -\ : GS1 S" SOURCE" 2DUP 2DUP EVALUATE -\ >R SWAP >R = R> R> = ; -\ T{ GS1 -> <TRUE> <TRUE> }T +: GS1 S" SOURCE" 2DUP EVALUATE + >R SWAP >R = R> R> = ; +T{ GS1 -> <TRUE> <TRUE> }T VARIABLE SCANS : RESCAN? -1 SCANS +! SCANS @ IF 0 >IN ! THEN ; @@ -1013,4 +1012,3 @@ T{ GDX -> 123 234 }T CR .( End of Core word set tests) CR - |