alx/ueforth
1
0
Fork 0
Code Issues Pull Requests Releases Wiki Activity

Fix LOOP/+LOOP bug.

Browse Source 
Forth-83 and after pick a more useful definition of how
LOOP and +LOOP should decide termination:
if the last step traversed between limit-1 and limit.

This allows for signed or unsigned loops with the same construct.

Updating to this behavior + adding test + fixing old test
that didn't match gforth.
This commit is contained in:
Brad Nelson
2023-05-05 00:46:18 -07:00
parent 705e839c62
commit bab72b79a7
2 changed files with 63 additions and 50 deletions
Download Patch File Download Diff File Expand all files Collapse all files

6
common/boot.fs
View File

@ -69,10 +69,12 @@ variable leaving
: UNLOOP r> rdrop rdrop >r ;
: LEAVE r> rdrop rdrop @ >r ;
: leave postpone LEAVE leaving, ; immediate
: +LOOP ( n -- ) dup 0< swap r> r> rot + dup r@ < -rot >r >r xor 0=
: +LOOP ( n -- ) r> r> dup r@ - >r rot + r> -rot
dup r@ - -rot >r >r xor 0<
if r> cell+ rdrop rdrop >r else r> @ >r then ;
: +loop ( n -- ) postpone +LOOP , )leaving ; immediate
: LOOP r> r> 1+ dup r@ < -rot >r >r 0=
: LOOP r> r> dup r@ - >r 1+ r> -rot
dup r@ - -rot >r >r xor 0<
if r> cell+ rdrop rdrop >r else r> @ >r then ;
: loop postpone LOOP , )leaving ; immediate
create I ' r@ @ ' i ! ( i is same as r@ )

107
common/doloop_tests.fs
View File

@ -42,74 +42,74 @@ e: test-rev-?doloop
e: test-do+loop
: foo 0 do i . 2 +loop cr ;
9 foo
out: 0 2 4 6 8
10 foo
out: 0 2 4 6 8
11 foo
out: 0 2 4 6 8 10
1 foo
out: 0
." 9 foo " 9 foo
out: 9 foo 0 2 4 6 8
." 10 foo " 10 foo
out: 10 foo 0 2 4 6 8
." 11 foo " 11 foo
out: 11 foo 0 2 4 6 8 10
." 1 foo " 1 foo
out: 1 foo 0
;e
e: test-?do+loop
: foo 0 ?do i . 2 +loop cr ;
9 foo
out: 0 2 4 6 8
10 foo
out: 0 2 4 6 8
11 foo
out: 0 2 4 6 8 10
1 foo
out: 0
0 foo
out:
." 9 foo " 9 foo
out: 9 foo 0 2 4 6 8
." 10 foo " 10 foo
out: 10 foo 0 2 4 6 8
." 11 foo " 11 foo
out: 11 foo 0 2 4 6 8 10
." 1 foo " 1 foo
out: 1 foo 0
." 0 foo " 0 foo
out: 0 foo
;e
e: test-doloop-leave
: foo 0 do 42 emit i 7 = if ." left " leave ." nope" then i . loop cr ;
7 foo
out: *0 *1 *2 *3 *4 *5 *6
8 foo
out: *0 *1 *2 *3 *4 *5 *6 *left
9 foo
out: *0 *1 *2 *3 *4 *5 *6 *left
." 7 foo " 7 foo
out: 7 foo *0 *1 *2 *3 *4 *5 *6
." 8 foo " 8 foo
out: 8 foo *0 *1 *2 *3 *4 *5 *6 *left
." 9 foo " 9 foo
out: 9 foo *0 *1 *2 *3 *4 *5 *6 *left
;e
e: test-do+loop-leave
: foo 0 do 42 emit i 8 = if ." left " leave ." nope" then i . 2 +loop cr ;
7 foo
out: *0 *2 *4 *6
8 foo
out: *0 *2 *4 *6
9 foo
out: *0 *2 *4 *6 *left
0 foo
out: *0
." 7 foo " 7 foo
out: 7 foo *0 *2 *4 *6
." 8 foo " 8 foo
out: 8 foo *0 *2 *4 *6
." 9 foo " 9 foo
out: 9 foo *0 *2 *4 *6 *left
." 0 foo " 0 foo
out: 0 foo *0 *2 *4 *6 *left
;e
e: test-?do+loop-leave
: foo 0 ?do 42 emit i 8 = if ." left " leave ." nope" then i . 2 +loop cr ;
7 foo
out: *0 *2 *4 *6
8 foo
out: *0 *2 *4 *6
9 foo
out: *0 *2 *4 *6 *left
0 foo
out:
." 7 foo " 7 foo
out: 7 foo *0 *2 *4 *6
." 8 foo " 8 foo
out: 8 foo *0 *2 *4 *6
." 9 foo " 9 foo
out: 9 foo *0 *2 *4 *6 *left
." 0 foo " 0 foo
out: 0 foo
;e
e: test-do+loop-unloop
: foo 0 do 42 emit i 8 = if ." left " cr unloop exit then i . 2 +loop ." done " cr ;
7 foo
out: *0 *2 *4 *6 done
8 foo
out: *0 *2 *4 *6 done
9 foo
out: *0 *2 *4 *6 *left
0 foo
out: *0 done
." 7 foo " 7 foo
out: 7 foo *0 *2 *4 *6 done
." 8 foo " 8 foo
out: 8 foo *0 *2 *4 *6 done
." 9 foo " 9 foo
out: 9 foo *0 *2 *4 *6 *left
." 0 foo " 0 foo
out: 0 foo *0 *2 *4 *6 *left
;e
e: test-?do+loop-unloop
@ -130,3 +130,14 @@ e: test-doloop-j
out: 0 0 0 1 1 1 2 2 2 3 3 3 4 4 4
;e
e: test-doloop-unsigned
: foo 0 -1 1 rshift 1+ dup 10 + swap do 1+ loop . cr ;
foo
out: 10
;e
e: test-do+loop-unsigned
: foo 0 -1 1 rshift dup 10 + do 1+ -1 +loop . cr ;
foo
out: 11
;e