--- gforth/locals-test.fs 1994/05/07 14:55:59 1.1 +++ gforth/locals-test.fs 1995/01/25 18:53:50 1.6 @@ -1,4 +1,5 @@ include glocals.fs +include debugging.fs : localsinfo \ !! only debugging ." stack: " .s ." locals-size: " locals-size ? ." locals-list" @@ -28,18 +29,20 @@ depth . cr ." testing part 2" cr : xxxx + [ ." starting xxxx" .s cr ] { f } f -xif - { a b } - b a +if + { a b } + b a [ ." before else" .s cr ] -xelse +else [ ." after else" .s cr ] - { c d } - c d -xthen + { c d } + c d +then [ ." locals-size after then:" locals-size @ . cr ] -f drop +~~ f ~~ drop +[ ." ending xxxx" .s cr ] ; 2 3 1 xxxx . . cr @@ -47,25 +50,25 @@ f drop cr cr cr : xxx3 -xbegin +begin { a } -xuntil +until a ; ." after xxx3" .s cr cr cr : xxx2 [ ." start of xxx2" .s cr ] -xbegin +begin [ ." after begin" .s cr ] { a } [ ." after { a }" .s cr ] -1 xwhile +1 while [ ." after while" .s cr ] - { b } - a b + { b } + a b [ ." after a" .s cr ] -xrepeat +repeat [ ." after repeat" .s cr also locals words previous cr ] @@ -75,52 +78,59 @@ a : xxx4 [ ." before if" localsinfo ] -xif +if [ ." after if" localsinfo ] { a } [ ." before begin" localsinfo ] -xbegin +begin [ ." after begin" localsinfo ] [ 1 cs-roll ] [ ." before then" localsinfo ] -xthen +then { b } -xuntil +until [ ." after until" localsinfo ] ; : xxx5 { a } -xahead -xbegin +a drop +ahead +assume-live +begin [ ." after begin" localsinfo ] +a drop [ 1 cs-roll ] -xthen +then [ ." after then" localsinfo ] -xuntil +until [ ." after until" localsinfo ] ; +." xxx6 coming up" cr : xxx6 -xif + [ ." starting xxx6" localsinfo ] +if { x } -xelse +else [ ." after else" localsinfo ] -xahead -xbegin +ahead +begin [ ." after begin" localsinfo ] -[ 2 CS-ROLL ] xthen +[ 2 CS-ROLL ] then [ ." after then" localsinfo ] -xuntil +until +then + [ ." ending xxx6" localsinfo ] ; ." xxx7 coming up" cr : xxx7 { b } -xdo +do { a } [ ." before loop" localsinfo ] -xloop +loop [ ." after loop" localsinfo ] ; @@ -128,36 +138,36 @@ xloop : xxx8 { b } -x?do +?do { a } [ ." before loop" localsinfo ] -xloop +loop [ ." after loop" localsinfo ] ; ." xxx9 coming up" cr : xxx9 { b } -xdo +do { c } [ ." before ?leave" leave-sp ? leave-stack . cr ] -x?leave +?leave [ ." after ?leave" leave-sp ? cr ] { a } [ ." before loop" localsinfo ] -xloop +loop [ ." after loop" localsinfo ] ; ." strcmp coming up" cr : strcmp { addr1 u1 addr2 u2 -- n } - addr1 addr2 u1 u2 min 0 x?do + addr1 addr2 u1 u2 min 0 ?do { s1 s2 } - s1 c@ s2 c@ - ?dup xif - unloop xexit - xthen + s1 c@ s2 c@ - ?dup if + unloop exit + then s1 char+ s2 char+ - xloop + loop 2drop u1 u2 - ; @@ -178,13 +188,13 @@ s" " s" " strcmp . cr ; : findchar { c addr u -- i } - addr u 0 x?do + addr u 0 ?do { p } - p c@ c = xif - p xleave - xthen + p c@ c = if + p leave + then p char+ - xloop + loop addr - ; @@ -213,7 +223,7 @@ testfindchar : xxx10 [ ." before if" localsinfo ] -xif +if [ ." after if" localsinfo ] scope [ ." after scope" localsinfo ] @@ -221,13 +231,79 @@ scope [ ." before endscope" localsinfo ] endscope [ ." before begin" localsinfo ] -xbegin +begin [ ." after begin" localsinfo ] [ 1 cs-roll ] [ ." before then" localsinfo ] -xthen +then { b } -xuntil +until [ ." after until" localsinfo ] ; +: xxx11 + if + { a } + exit + [ ." after xexit" localsinfo ] + else + { b } + [ ." before xthen" localsinfo ] + then + [ ." after xthen" localsinfo ] +; + +." strcmp1 coming up" cr +: strcmp1 { addr1 u1 addr2 u2 -- n } + u1 u2 min 0 ?do + addr1 c@ addr2 c@ - ?dup if + unloop exit + then + addr1 char+ TO addr1 + addr2 char+ TO addr2 + loop + u1 u2 - ; + +: teststrcmp1 +." lp@:" lp@ . cr +s" xxx" s" yyy" strcmp1 . cr +." lp@:" lp@ . cr +s" xxx" s" xxx" strcmp1 . cr +." lp@:" lp@ . cr +s" xxx" s" xxxx" strcmp1 . cr +." lp@:" lp@ . cr +s" xxx3" s" xxx2" strcmp1 . cr +." lp@:" lp@ . cr +s" " s" " strcmp1 . cr +." lp@:" lp@ . cr +." lp@:" lp@ . cr +." stack:" .s cr +; +teststrcmp1 + +." testing the abominable locals-ext wordset" cr +: puke locals| this read you can | + you read this can ; + +1 2 3 4 puke . . . . cr + +\ just some other stuff + +: life1 { b0 b1 b23 old -- new } + b23 invert old b1 b0 xor and old invert b1 and b0 and or and ; + +: life2 { b0 b1 b23 old -- new } + b0 b1 or old b0 xor b1 xor b23 or invert and ; + +$5555 $3333 $0f0f $00ff life1 . +$5555 $3333 $0f0f $00ff life2 . +.s +cr + +: test + 1 { a } ." after }" cr + 2 { b -- } ." after --" cr +; +.s cr + +bye