Annotation of gforth/locals-test.fs, revision 1.10

1.10    ! anton       1: \ test gforth locals
        !             2: 
        !             3: \ Copyright (C) 1995,1996,1997 Free Software Foundation, Inc.
        !             4: 
        !             5: \ This file is part of Gforth.
        !             6: 
        !             7: \ Gforth is free software; you can redistribute it and/or
        !             8: \ modify it under the terms of the GNU General Public License
        !             9: \ as published by the Free Software Foundation; either version 2
        !            10: \ of the License, or (at your option) any later version.
        !            11: 
        !            12: \ This program is distributed in the hope that it will be useful,
        !            13: \ but WITHOUT ANY WARRANTY; without even the implied warranty of
        !            14: \ MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE.  See the
        !            15: \ GNU General Public License for more details.
        !            16: 
        !            17: \ You should have received a copy of the GNU General Public License
        !            18: \ along with this program; if not, write to the Free Software
        !            19: \ Foundation, Inc., 675 Mass Ave, Cambridge, MA 02139, USA.
        !            20: 
        !            21: 
1.8       anton      22: require glocals.fs
1.9       anton      23: require debugs.fs
1.1       anton      24: 
                     25: : localsinfo \ !! only debugging
                     26:  ." stack: " .s ." locals-size: " locals-size ? ." locals-list"
                     27:  also locals words previous cr ;
                     28: 
                     29: ." before foo" cr
                     30: : foo
                     31: { c: a  b  c: c  d: d }
                     32: a .
                     33: b .
                     34: d type
                     35: c . cr
                     36: ;
                     37: 
                     38: ." before" .s cr
                     39: lp@ . cr
                     40: 1 2 3 s" xxx" foo
                     41: lp@ . cr
                     42: ." after" .s cr
                     43: 
                     44: 
                     45: ." xxx" cr
                     46: .s cr
                     47: depth . cr
                     48: 
                     49: 
                     50: ." testing part 2" cr
                     51: 
                     52: : xxxx
1.3       anton      53:    [ ." starting xxxx" .s cr ]
1.1       anton      54: { f } f
1.2       anton      55: if
1.3       anton      56:  { a b }
                     57:  b a
1.1       anton      58: [ ." before else" .s cr ]
1.2       anton      59: else
1.1       anton      60: [ ." after else" .s cr ]
1.3       anton      61:  { c d }
                     62:  c d
1.2       anton      63: then
1.1       anton      64: [ ." locals-size after then:" locals-size @ . cr ]
1.3       anton      65: ~~ f ~~ drop
                     66: [ ." ending xxxx" .s cr ]
1.1       anton      67: ;
                     68: 
                     69: 2 3 1 xxxx . . cr
                     70: 2 3 0 xxxx . . cr
                     71: cr cr cr
                     72: 
                     73: : xxx3
1.2       anton      74: begin
1.1       anton      75:   { a }
1.2       anton      76: until
1.1       anton      77: a
                     78: ;
                     79: ." after xxx3" .s cr cr cr
                     80: 
                     81: : xxx2
                     82: [ ." start of xxx2" .s cr ]
1.2       anton      83: begin
1.1       anton      84: [ ." after begin" .s cr ]
                     85:   { a }
                     86: [ ." after { a }" .s cr ]
1.2       anton      87: 1 while
1.1       anton      88: [ ." after while" .s cr ]
1.3       anton      89:  { b }
                     90:  a b
1.1       anton      91: [ ." after a" .s cr ]
1.2       anton      92: repeat
1.1       anton      93: [ ." after repeat" .s cr
                     94:   also locals words previous cr
                     95: ]
                     96: a
                     97: [ ." end of xxx2" .s cr ]
                     98: ;
                     99: 
                    100: : xxx4
                    101: [ ." before if" localsinfo ]
1.2       anton     102: if
1.1       anton     103: [ ." after if" localsinfo ]
                    104: { a }
                    105: [ ." before begin" localsinfo ]
1.2       anton     106: begin
1.1       anton     107: [ ." after begin" localsinfo ]
                    108: [ 1 cs-roll ]
                    109: [ ." before then" localsinfo ]
1.2       anton     110: then
1.1       anton     111: { b }
1.2       anton     112: until
1.1       anton     113: [ ." after until" localsinfo ]
                    114: ;
                    115: 
                    116: : xxx5
                    117: { a }
1.5       anton     118: a drop    
1.2       anton     119: ahead
1.5       anton     120: assume-live
1.2       anton     121: begin
1.1       anton     122: [ ." after begin" localsinfo ]
1.5       anton     123: a drop    
1.1       anton     124: [ 1 cs-roll ]
1.2       anton     125: then
1.1       anton     126: [ ." after then" localsinfo ]
1.2       anton     127: until
1.1       anton     128: [ ." after until" localsinfo ]
                    129: ;
                    130: 
1.2       anton     131: ." xxx6 coming up" cr
1.1       anton     132: : xxx6
1.2       anton     133:     [ ." starting xxx6" localsinfo ]
                    134: if
1.1       anton     135: { x }
1.2       anton     136: else
1.1       anton     137: [ ." after else" localsinfo ]
1.2       anton     138: ahead
                    139: begin
1.1       anton     140: [ ." after begin" localsinfo ]
1.2       anton     141: [ 2 CS-ROLL ] then
1.1       anton     142: [ ." after then" localsinfo ]
1.2       anton     143: until
                    144: then
                    145:     [ ." ending xxx6" localsinfo ]
1.1       anton     146: ;
                    147: 
                    148: ." xxx7 coming up" cr
                    149: : xxx7
                    150: { b }
1.2       anton     151: do
1.1       anton     152: { a }
                    153: [ ." before loop" localsinfo ]
1.2       anton     154: loop
1.1       anton     155: [ ." after loop" localsinfo ]
                    156: ;
                    157: 
                    158: ." xxx8 coming up" cr
                    159: 
                    160: : xxx8
                    161: { b }
1.2       anton     162: ?do
1.1       anton     163: { a }
                    164: [ ." before loop" localsinfo ]
1.2       anton     165: loop
1.1       anton     166: [ ." after loop" localsinfo ]
                    167: ;
                    168: 
                    169: ." xxx9 coming up" cr
                    170: : xxx9
                    171: { b }
1.2       anton     172: do
1.1       anton     173: { c }
                    174: [ ." before ?leave" leave-sp ? leave-stack . cr ]
1.2       anton     175: ?leave
1.1       anton     176: [ ." after ?leave" leave-sp ? cr ]
                    177: { a }
                    178: [ ." before loop" localsinfo ]
1.2       anton     179: loop
1.1       anton     180: [ ." after loop" localsinfo ]
                    181: ;
                    182: 
                    183: ." strcmp coming up" cr
                    184: : strcmp { addr1 u1 addr2 u2 -- n }
1.2       anton     185:  addr1 addr2 u1 u2 min 0 ?do
1.1       anton     186:    { s1 s2 }
1.2       anton     187:    s1 c@ s2 c@ - ?dup if
                    188:      unloop exit
                    189:    then
1.1       anton     190:    s1 char+ s2 char+
1.2       anton     191:  loop
1.1       anton     192:  2drop
                    193:  u1 u2 - ;
                    194: 
                    195: : teststrcmp
                    196: ." lp@:" lp@ . cr
                    197: s" xxx" s" yyy" strcmp . cr
                    198: ." lp@:" lp@ . cr
                    199: s" xxx" s" xxx" strcmp . cr
                    200: ." lp@:" lp@ . cr
                    201: s" xxx" s" xxxx" strcmp . cr
                    202: ." lp@:" lp@ . cr
                    203: s" xxx3" s" xxx2" strcmp . cr
                    204: ." lp@:" lp@ . cr
                    205: s" " s" " strcmp . cr
                    206: ." lp@:" lp@ . cr
                    207: ." lp@:" lp@ . cr
                    208: ." stack:" .s cr
                    209: ;
                    210: 
                    211: : findchar { c addr u -- i }
1.2       anton     212:  addr u 0 ?do
1.1       anton     213:    { p }
1.2       anton     214:    p c@ c = if
                    215:      p leave
                    216:    then
1.1       anton     217:    p char+
1.2       anton     218:  loop
1.1       anton     219:  addr - ;
                    220: 
                    221: 
                    222: : testfindchar
                    223: ." findcahr " cr
                    224: ." lp@:" lp@ . cr
                    225: [char] a s" xxx" findchar . cr
                    226: ." lp@:" lp@ . cr
                    227: [char] a s" " findchar . cr
                    228: ." lp@:" lp@ . cr
                    229: [char] a s" wam" findchar . cr
                    230: ." lp@:" lp@ . cr
                    231: [char] a s" wma" findchar . cr
                    232: ." lp@:" lp@ . cr
                    233: [char] a s" awam" findchar . cr
                    234: ." lp@:" lp@ . cr
                    235: ." stack:" .s cr
                    236: ;
                    237: 
                    238: 
                    239: 
                    240: ." stack:" .s cr
                    241: teststrcmp
                    242: testfindchar
                    243: ." hey you" cr
                    244: 
                    245: : xxx10
                    246: [ ." before if" localsinfo ]
1.2       anton     247: if
1.1       anton     248: [ ." after if" localsinfo ]
                    249: scope
                    250: [ ." after scope" localsinfo ]
                    251: { a }
                    252: [ ." before endscope" localsinfo ]
                    253: endscope
                    254: [ ." before begin" localsinfo ]
1.2       anton     255: begin
1.1       anton     256: [ ." after begin" localsinfo ]
                    257: [ 1 cs-roll ]
                    258: [ ." before then" localsinfo ]
1.2       anton     259: then
1.1       anton     260: { b }
1.2       anton     261: until
1.1       anton     262: [ ." after until" localsinfo ]
                    263: ;
                    264: 
1.2       anton     265: : xxx11
                    266:     if
                    267:     { a }
                    268:     exit
                    269:     [ ." after xexit" localsinfo ]
                    270:     else
                    271:     { b }
1.4       anton     272:     [ ." before xthen" localsinfo ]
1.2       anton     273:     then
                    274:     [ ." after xthen" localsinfo ]
                    275: ;
1.3       anton     276: 
                    277: ." strcmp1 coming up" cr
                    278: : strcmp1 { addr1 u1 addr2 u2 -- n }
                    279:  u1 u2 min 0 ?do
                    280:    addr1 c@ addr2 c@ - ?dup if
                    281:      unloop exit
                    282:    then
                    283:    addr1 char+ TO addr1
                    284:    addr2 char+ TO addr2
                    285:  loop
                    286:  u1 u2 - ;
                    287: 
                    288: : teststrcmp1
                    289: ." lp@:" lp@ . cr
                    290: s" xxx" s" yyy" strcmp1 . cr
                    291: ." lp@:" lp@ . cr
                    292: s" xxx" s" xxx" strcmp1 . cr
                    293: ." lp@:" lp@ . cr
                    294: s" xxx" s" xxxx" strcmp1 . cr
                    295: ." lp@:" lp@ . cr
                    296: s" xxx3" s" xxx2" strcmp1 . cr
                    297: ." lp@:" lp@ . cr
                    298: s" " s" " strcmp1 . cr
                    299: ." lp@:" lp@ . cr
                    300: ." lp@:" lp@ . cr
                    301: ." stack:" .s cr
                    302: ;
                    303: teststrcmp1
1.2       anton     304: 
1.5       anton     305: ." testing the abominable locals-ext wordset" cr
                    306: : puke locals| this read you can |
                    307:     you read this can ;
                    308: 
                    309: 1 2 3 4 puke . . . . cr
1.2       anton     310: 
1.6       anton     311: \ just some other stuff
                    312: 
                    313: : life1 { b0 b1 b23 old -- new }
                    314:     b23 invert old b1 b0 xor and old invert b1 and b0 and or and ;
                    315: 
                    316: : life2 { b0 b1 b23 old -- new }
                    317:     b0 b1 or old b0 xor b1 xor b23 or invert and ;
                    318: 
                    319: $5555 $3333 $0f0f $00ff life1 .
                    320: $5555 $3333 $0f0f $00ff life2 .
                    321: .s
                    322: cr
                    323: 
                    324: : test
                    325:     1 { a }  ." after }" cr
1.7       anton     326:     2 { b -- }  ." after --" cr
1.6       anton     327: ;
1.7       anton     328: test
1.6       anton     329: .s cr
                    330: 
1.2       anton     331: bye

FreeBSD-CVSweb <freebsd-cvsweb@FreeBSD.org>