File:  [gforth] / gforth / locals-test.fs
Revision 1.12: download - view: text, annotated - select for diffs
Sun Mar 9 15:16:50 2003 UTC (16 years, 2 months ago) by anton
Branches: MAIN
CVS tags: v0-6-1, v0-6-0, HEAD
updated copyright years

    1: \ test gforth locals
    2: 
    3: \ Copyright (C) 1995,1996,1997,2000 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., 59 Temple Place, Suite 330, Boston, MA 02111, USA.
   20: 
   21: 
   22: require glocals.fs
   23: require debugs.fs
   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
   53:    [ ." starting xxxx" .s cr ]
   54: { f } f
   55: if
   56:  { a b }
   57:  b a
   58: [ ." before else" .s cr ]
   59: else
   60: [ ." after else" .s cr ]
   61:  { c d }
   62:  c d
   63: then
   64: [ ." locals-size after then:" locals-size @ . cr ]
   65: ~~ f ~~ drop
   66: [ ." ending xxxx" .s cr ]
   67: ;
   68: 
   69: 2 3 1 xxxx . . cr
   70: 2 3 0 xxxx . . cr
   71: cr cr cr
   72: 
   73: : xxx3
   74: begin
   75:   { a }
   76: until
   77: a
   78: ;
   79: ." after xxx3" .s cr cr cr
   80: 
   81: : xxx2
   82: [ ." start of xxx2" .s cr ]
   83: begin
   84: [ ." after begin" .s cr ]
   85:   { a }
   86: [ ." after { a }" .s cr ]
   87: 1 while
   88: [ ." after while" .s cr ]
   89:  { b }
   90:  a b
   91: [ ." after a" .s cr ]
   92: repeat
   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 ]
  102: if
  103: [ ." after if" localsinfo ]
  104: { a }
  105: [ ." before begin" localsinfo ]
  106: begin
  107: [ ." after begin" localsinfo ]
  108: [ 1 cs-roll ]
  109: [ ." before then" localsinfo ]
  110: then
  111: { b }
  112: until
  113: [ ." after until" localsinfo ]
  114: ;
  115: 
  116: : xxx5
  117: { a }
  118: a drop    
  119: ahead
  120: assume-live
  121: begin
  122: [ ." after begin" localsinfo ]
  123: a drop    
  124: [ 1 cs-roll ]
  125: then
  126: [ ." after then" localsinfo ]
  127: until
  128: [ ." after until" localsinfo ]
  129: ;
  130: 
  131: ." xxx6 coming up" cr
  132: : xxx6
  133:     [ ." starting xxx6" localsinfo ]
  134: if
  135: { x }
  136: else
  137: [ ." after else" localsinfo ]
  138: ahead
  139: begin
  140: [ ." after begin" localsinfo ]
  141: [ 2 CS-ROLL ] then
  142: [ ." after then" localsinfo ]
  143: until
  144: then
  145:     [ ." ending xxx6" localsinfo ]
  146: ;
  147: 
  148: ." xxx7 coming up" cr
  149: : xxx7
  150: { b }
  151: do
  152: { a }
  153: [ ." before loop" localsinfo ]
  154: loop
  155: [ ." after loop" localsinfo ]
  156: ;
  157: 
  158: ." xxx8 coming up" cr
  159: 
  160: : xxx8
  161: { b }
  162: ?do
  163: { a }
  164: [ ." before loop" localsinfo ]
  165: loop
  166: [ ." after loop" localsinfo ]
  167: ;
  168: 
  169: ." xxx9 coming up" cr
  170: : xxx9
  171: { b }
  172: do
  173: { c }
  174: [ ." before ?leave" leave-sp ? leave-stack . cr ]
  175: ?leave
  176: [ ." after ?leave" leave-sp ? cr ]
  177: { a }
  178: [ ." before loop" localsinfo ]
  179: loop
  180: [ ." after loop" localsinfo ]
  181: ;
  182: 
  183: ." strcmp coming up" cr
  184: : strcmp { addr1 u1 addr2 u2 -- n }
  185:  addr1 addr2 u1 u2 min 0 ?do
  186:    { s1 s2 }
  187:    s1 c@ s2 c@ - ?dup if
  188:      unloop exit
  189:    then
  190:    s1 char+ s2 char+
  191:  loop
  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 }
  212:  addr u 0 ?do
  213:    { p }
  214:    p c@ c = if
  215:      p leave
  216:    then
  217:    p char+
  218:  loop
  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 ]
  247: if
  248: [ ." after if" localsinfo ]
  249: scope
  250: [ ." after scope" localsinfo ]
  251: { a }
  252: [ ." before endscope" localsinfo ]
  253: endscope
  254: [ ." before begin" localsinfo ]
  255: begin
  256: [ ." after begin" localsinfo ]
  257: [ 1 cs-roll ]
  258: [ ." before then" localsinfo ]
  259: then
  260: { b }
  261: until
  262: [ ." after until" localsinfo ]
  263: ;
  264: 
  265: : xxx11
  266:     if
  267:     { a }
  268:     exit
  269:     [ ." after xexit" localsinfo ]
  270:     else
  271:     { b }
  272:     [ ." before xthen" localsinfo ]
  273:     then
  274:     [ ." after xthen" localsinfo ]
  275: ;
  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
  304: 
  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
  310: 
  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
  326:     2 { b -- }  ." after --" cr
  327: ;
  328: test
  329: .s cr
  330: 
  331: bye

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