100% core test passing

tcsullivan · Oct 25, 2023 · 7381e87 · 7381e87
1 parent 194acf0
commit 7381e87
Show file tree

Hide file tree

Showing 2 changed files with 12 additions and 14 deletions.
diff --git 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
@@ -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
 
-