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 -> }T +: GS1 S" SOURCE" 2DUP EVALUATE + >R SWAP >R = R> R> = ; +T{ GS1 -> }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 -