Commit 62ba0a72 authored by bp's avatar bp

Fixed greedy loop counting

git-svn-id: https://forth-ev.de/repos/bigforth@1824 3b8d8251-53f3-0310-8f3b-fd1cb8370982
parent 334b3f7c
......@@ -151,4 +151,37 @@ s" bla 45296s fasel 117s blubber" str= [IF] .( ok) [ELSE] .( failed) [THEN] cr
s" (bla) 12:34:56 (fasel) 00:01:57 (blubber)" 2dup type hms>s,del() ." -> " type cr
\ more tests from David Kühling
: underflow1 ( c-addr u -- flag )
(( {{
{{ ` - || }} \d
|| \d
}} )) ;
s" -1dummy" underflow1 0= [IF] ." failed" cr [THEN]
: underflow2 ( -- )
(( \( {{ \s {** \s **}
|| =" /*" // =" */"
|| =" //" {** \d **} }} \) )) ;
s" /*10203030203030404*/ " underflow2 0= [IF] ." failed" cr [THEN]
pad 0 underflow2 [IF] ." failed" cr [THEN]
charclass [*] '* +char
charclass [*/] '* +char '/ +char
: underflow3 ( -- )
((
=" /*"
\( {** {{ [*] -c? || ` * [*/] -c? }} **} \)
{++ ` * ++} ` /
)) ;
s" /*10203030203030404*/ " underflow3 0= [IF] ." failed" cr [THEN] \1 type cr
: underflow4 ( -- )
(( \( {{ {** \d **} || {** \d **} }} \d \) )) ;
s" 0 " underflow4 0= [IF] ." failed" cr [THEN]
script? [IF] bye [THEN]
......@@ -82,6 +82,8 @@ Variable varsmax
: var> ( -- addr ) -1 varstack +!
varstack @+ swap cells + @
1+ 2* cells vars + ;
Variable greed-counts 9 cells allot \ no more than 9 nested greedy loops
: greed' ( -- addr ) greed-counts dup @ + ;
\ start end
......@@ -105,7 +107,7 @@ Variable varsmax
\ instead of a jump.
: (( ( addr u -- )
vars off varsmax off loops off
vars off varsmax off loops off greed-counts off
]] FORK AHEAD BUT JOIN !end [[ BEGIN, ; immediate
: )) ( -- addr f )
]] ?end drop true UNNEST [[
......@@ -119,14 +121,16 @@ Variable varsmax
: drops ( n -- ) 1+ cells sp@ + sp! ;
: {** ( addr -- addr addr )
0 ]] Literal >r BEGIN dup [[ BEGIN, ; immediate
cell greed-counts +!
greed' ]] Literal off BEGIN dup [[ BEGIN, ; immediate
' {** Alias {++ ( addr -- addr addr ) immediate
: n*} ( sys n -- )
>r ]] r> 1+ >r $? 0= UNTIL dup [[ DONE, ]] drop [[
r@ ]] r> 1+ Literal U+DO FORK BUT [[
>r greed' ]] 1 Literal +! $? 0= UNTIL dup [[ DONE, ]] drop [[
r@ greed' ]] Literal @ 1+ Literal U+DO FORK BUT [[
]] IF I' I - [[ r@ 1- ]] Literal + drops true UNLOOP UNNEST THEN LOOP [[
r@ IF r@ ]] Literal drops [[ THEN
rdrop ]] dup LEAVE JOIN [[ ; immediate
rdrop ]] dup LEAVE JOIN [[
-cell greed-counts +! ; immediate
: **} 0 postpone n*} ; immediate
: ++} 1 postpone n*} ; immediate
......
Markdown is supported
0% or
You are about to add 0 people to the discussion. Proceed with caution.
Finish editing this message first!
Please register or to comment