File:  [gforth] / gforth / locals-test.fs
Revision 1.15: download - view: text, annotated - select for diffs
Mon Dec 31 19:02:24 2007 UTC (16 years, 3 months ago) by anton
Branches: MAIN
CVS tags: v0-7-0, HEAD
updated copyright year after changing license notice

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

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