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

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

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