--- gforth/locals-test.fs 1994/05/07 14:55:59 1.1 +++ gforth/locals-test.fs 2003/08/25 14:17:45 1.13 @@ -1,4 +1,26 @@ -include glocals.fs +\ test gforth locals + +\ Copyright (C) 1995,1996,1997,2000,2003 Free Software Foundation, Inc. + +\ This file is part of Gforth. + +\ Gforth is free software; you can redistribute it and/or +\ modify it under the terms of the GNU General Public License +\ as published by the Free Software Foundation; either version 2 +\ of the License, or (at your option) any later version. + +\ This program is distributed in the hope that it will be useful, +\ but WITHOUT ANY WARRANTY; without even the implied warranty of +\ MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE. See the +\ GNU General Public License for more details. + +\ You should have received a copy of the GNU General Public License +\ along with this program; if not, write to the Free Software +\ Foundation, Inc., 59 Temple Place, Suite 330, Boston, MA 02111, USA. + + +require glocals.fs +require debugs.fs : localsinfo \ !! only debugging ." stack: " .s ." locals-size: " locals-size ? ." locals-list" @@ -28,18 +50,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 +71,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 +99,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 +159,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 +209,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 +244,7 @@ testfindchar : xxx10 [ ." before if" localsinfo ] -xif +if [ ." after if" localsinfo ] scope [ ." after scope" localsinfo ] @@ -221,13 +252,80 @@ 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 +; +test +.s cr + +bye