100% core test passing

diff --git a/forth/core.fth b/forth/core.fth
index ec4bcb59e535b2e1bdf547efa09e351ea7be3604..071af33f1776f04914ffba0a595b5b90c7e5d6b9 100644 (file)
--- 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 0e9ced980ffadb03c274be9c0f3f7b31bfa4d145..31f0ff22b036cbf4853904dee0b83256dc71e90b 100644 (file)
--- 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
 
-