Diff for /gforth/locals-test.fs between versions 1.1 and 1.12

version 1.1, 1994/05/07 14:55:59 version 1.12, 2003/03/09 15:16:50
Line 1 Line 1
 include glocals.fs  \ test gforth locals
   
   \ Copyright (C) 1995,1996,1997,2000 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  : localsinfo \ !! only debugging
  ." stack: " .s ." locals-size: " locals-size ? ." locals-list"   ." stack: " .s ." locals-size: " locals-size ? ." locals-list"
Line 28  depth . cr Line 50  depth . cr
 ." testing part 2" cr  ." testing part 2" cr
   
 : xxxx  : xxxx
      [ ." starting xxxx" .s cr ]
 { f } f  { f } f
 xif  if
   { a b }   { a b }
   b a   b a
 [ ." before else" .s cr ]  [ ." before else" .s cr ]
 xelse  else
 [ ." after else" .s cr ]  [ ." after else" .s cr ]
   { c d }   { c d }
   c d   c d
 xthen  then
 [ ." locals-size after then:" locals-size @ . cr ]  [ ." locals-size after then:" locals-size @ . cr ]
 f drop  ~~ f ~~ drop
   [ ." ending xxxx" .s cr ]
 ;  ;
   
 2 3 1 xxxx . . cr  2 3 1 xxxx . . cr
Line 47  f drop Line 71  f drop
 cr cr cr  cr cr cr
   
 : xxx3  : xxx3
 xbegin  begin
   { a }    { a }
 xuntil  until
 a  a
 ;  ;
 ." after xxx3" .s cr cr cr  ." after xxx3" .s cr cr cr
   
 : xxx2  : xxx2
 [ ." start of xxx2" .s cr ]  [ ." start of xxx2" .s cr ]
 xbegin  begin
 [ ." after begin" .s cr ]  [ ." after begin" .s cr ]
   { a }    { a }
 [ ." after { a }" .s cr ]  [ ." after { a }" .s cr ]
 1 xwhile  1 while
 [ ." after while" .s cr ]  [ ." after while" .s cr ]
   { b }   { b }
   a b   a b
 [ ." after a" .s cr ]  [ ." after a" .s cr ]
 xrepeat  repeat
 [ ." after repeat" .s cr  [ ." after repeat" .s cr
   also locals words previous cr    also locals words previous cr
 ]  ]
Line 75  a Line 99  a
   
 : xxx4  : xxx4
 [ ." before if" localsinfo ]  [ ." before if" localsinfo ]
 xif  if
 [ ." after if" localsinfo ]  [ ." after if" localsinfo ]
 { a }  { a }
 [ ." before begin" localsinfo ]  [ ." before begin" localsinfo ]
 xbegin  begin
 [ ." after begin" localsinfo ]  [ ." after begin" localsinfo ]
 [ 1 cs-roll ]  [ 1 cs-roll ]
 [ ." before then" localsinfo ]  [ ." before then" localsinfo ]
 xthen  then
 { b }  { b }
 xuntil  until
 [ ." after until" localsinfo ]  [ ." after until" localsinfo ]
 ;  ;
   
 : xxx5  : xxx5
 { a }  { a }
 xahead  a drop    
 xbegin  ahead
   assume-live
   begin
 [ ." after begin" localsinfo ]  [ ." after begin" localsinfo ]
   a drop    
 [ 1 cs-roll ]  [ 1 cs-roll ]
 xthen  then
 [ ." after then" localsinfo ]  [ ." after then" localsinfo ]
 xuntil  until
 [ ." after until" localsinfo ]  [ ." after until" localsinfo ]
 ;  ;
   
   ." xxx6 coming up" cr
 : xxx6  : xxx6
 xif      [ ." starting xxx6" localsinfo ]
   if
 { x }  { x }
 xelse  else
 [ ." after else" localsinfo ]  [ ." after else" localsinfo ]
 xahead  ahead
 xbegin  begin
 [ ." after begin" localsinfo ]  [ ." after begin" localsinfo ]
 [ 2 CS-ROLL ] xthen  [ 2 CS-ROLL ] then
 [ ." after then" localsinfo ]  [ ." after then" localsinfo ]
 xuntil  until
   then
       [ ." ending xxx6" localsinfo ]
 ;  ;
   
 ." xxx7 coming up" cr  ." xxx7 coming up" cr
 : xxx7  : xxx7
 { b }  { b }
 xdo  do
 { a }  { a }
 [ ." before loop" localsinfo ]  [ ." before loop" localsinfo ]
 xloop  loop
 [ ." after loop" localsinfo ]  [ ." after loop" localsinfo ]
 ;  ;
   
Line 128  xloop Line 159  xloop
   
 : xxx8  : xxx8
 { b }  { b }
 x?do  ?do
 { a }  { a }
 [ ." before loop" localsinfo ]  [ ." before loop" localsinfo ]
 xloop  loop
 [ ." after loop" localsinfo ]  [ ." after loop" localsinfo ]
 ;  ;
   
 ." xxx9 coming up" cr  ." xxx9 coming up" cr
 : xxx9  : xxx9
 { b }  { b }
 xdo  do
 { c }  { c }
 [ ." before ?leave" leave-sp ? leave-stack . cr ]  [ ." before ?leave" leave-sp ? leave-stack . cr ]
 x?leave  ?leave
 [ ." after ?leave" leave-sp ? cr ]  [ ." after ?leave" leave-sp ? cr ]
 { a }  { a }
 [ ." before loop" localsinfo ]  [ ." before loop" localsinfo ]
 xloop  loop
 [ ." after loop" localsinfo ]  [ ." after loop" localsinfo ]
 ;  ;
   
 ." strcmp coming up" cr  ." strcmp coming up" cr
 : strcmp { addr1 u1 addr2 u2 -- n }  : strcmp { addr1 u1 addr2 u2 -- n }
  addr1 addr2 u1 u2 min 0 x?do   addr1 addr2 u1 u2 min 0 ?do
    { s1 s2 }     { s1 s2 }
    s1 c@ s2 c@ - ?dup xif     s1 c@ s2 c@ - ?dup if
      unloop xexit       unloop exit
    xthen     then
    s1 char+ s2 char+     s1 char+ s2 char+
  xloop   loop
  2drop   2drop
  u1 u2 - ;   u1 u2 - ;
   
Line 178  s" " s" " strcmp . cr Line 209  s" " s" " strcmp . cr
 ;  ;
   
 : findchar { c addr u -- i }  : findchar { c addr u -- i }
  addr u 0 x?do   addr u 0 ?do
    { p }     { p }
    p c@ c = xif     p c@ c = if
      p xleave       p leave
    xthen     then
    p char+     p char+
  xloop   loop
  addr - ;   addr - ;
   
   
Line 213  testfindchar Line 244  testfindchar
   
 : xxx10  : xxx10
 [ ." before if" localsinfo ]  [ ." before if" localsinfo ]
 xif  if
 [ ." after if" localsinfo ]  [ ." after if" localsinfo ]
 scope  scope
 [ ." after scope" localsinfo ]  [ ." after scope" localsinfo ]
Line 221  scope Line 252  scope
 [ ." before endscope" localsinfo ]  [ ." before endscope" localsinfo ]
 endscope  endscope
 [ ." before begin" localsinfo ]  [ ." before begin" localsinfo ]
 xbegin  begin
 [ ." after begin" localsinfo ]  [ ." after begin" localsinfo ]
 [ 1 cs-roll ]  [ 1 cs-roll ]
 [ ." before then" localsinfo ]  [ ." before then" localsinfo ]
 xthen  then
 { b }  { b }
 xuntil  until
 [ ." after until" localsinfo ]  [ ." 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

Removed from v.1.1  
changed lines
  Added in v.1.12


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