File:  [gforth] / gforth / locals-test.fs
Revision 1.5: download - view: text, annotated - select for diffs
Mon Oct 24 19:16:01 1994 UTC (29 years, 5 months ago) by anton
Branches: MAIN
CVS tags: HEAD
Added automatic glossary entry transfer from primitives to the texi file.
renamed gfoprth.texi to gforth.ds.
fixed a few minor bugs.
changed the behaviour of locals scoping when encountering an unreachable BEGIN.
made UNREACHABLE immediate

    1: include glocals.fs
    2: include debugging.fs
    3: 
    4: : localsinfo \ !! only debugging
    5:  ." stack: " .s ." locals-size: " locals-size ? ." locals-list"
    6:  also locals words previous cr ;
    7: 
    8: ." before foo" cr
    9: : foo
   10: { c: a  b  c: c  d: d }
   11: a .
   12: b .
   13: d type
   14: c . cr
   15: ;
   16: 
   17: ." before" .s cr
   18: lp@ . cr
   19: 1 2 3 s" xxx" foo
   20: lp@ . cr
   21: ." after" .s cr
   22: 
   23: 
   24: ." xxx" cr
   25: .s cr
   26: depth . cr
   27: 
   28: 
   29: ." testing part 2" cr
   30: 
   31: : xxxx
   32:    [ ." starting xxxx" .s cr ]
   33: { f } f
   34: if
   35:  { a b }
   36:  b a
   37: [ ." before else" .s cr ]
   38: else
   39: [ ." after else" .s cr ]
   40:  { c d }
   41:  c d
   42: then
   43: [ ." locals-size after then:" locals-size @ . cr ]
   44: ~~ f ~~ drop
   45: [ ." ending xxxx" .s cr ]
   46: ;
   47: 
   48: 2 3 1 xxxx . . cr
   49: 2 3 0 xxxx . . cr
   50: cr cr cr
   51: 
   52: : xxx3
   53: begin
   54:   { a }
   55: until
   56: a
   57: ;
   58: ." after xxx3" .s cr cr cr
   59: 
   60: : xxx2
   61: [ ." start of xxx2" .s cr ]
   62: begin
   63: [ ." after begin" .s cr ]
   64:   { a }
   65: [ ." after { a }" .s cr ]
   66: 1 while
   67: [ ." after while" .s cr ]
   68:  { b }
   69:  a b
   70: [ ." after a" .s cr ]
   71: repeat
   72: [ ." after repeat" .s cr
   73:   also locals words previous cr
   74: ]
   75: a
   76: [ ." end of xxx2" .s cr ]
   77: ;
   78: 
   79: : xxx4
   80: [ ." before if" localsinfo ]
   81: if
   82: [ ." after if" localsinfo ]
   83: { a }
   84: [ ." before begin" localsinfo ]
   85: begin
   86: [ ." after begin" localsinfo ]
   87: [ 1 cs-roll ]
   88: [ ." before then" localsinfo ]
   89: then
   90: { b }
   91: until
   92: [ ." after until" localsinfo ]
   93: ;
   94: 
   95: : xxx5
   96: { a }
   97: a drop    
   98: ahead
   99: assume-live
  100: begin
  101: [ ." after begin" localsinfo ]
  102: a drop    
  103: [ 1 cs-roll ]
  104: then
  105: [ ." after then" localsinfo ]
  106: until
  107: [ ." after until" localsinfo ]
  108: ;
  109: 
  110: ." xxx6 coming up" cr
  111: : xxx6
  112:     [ ." starting xxx6" localsinfo ]
  113: if
  114: { x }
  115: else
  116: [ ." after else" localsinfo ]
  117: ahead
  118: begin
  119: [ ." after begin" localsinfo ]
  120: [ 2 CS-ROLL ] then
  121: [ ." after then" localsinfo ]
  122: until
  123: then
  124:     [ ." ending xxx6" localsinfo ]
  125: ;
  126: 
  127: ." xxx7 coming up" cr
  128: : xxx7
  129: { b }
  130: do
  131: { a }
  132: [ ." before loop" localsinfo ]
  133: loop
  134: [ ." after loop" localsinfo ]
  135: ;
  136: 
  137: ." xxx8 coming up" cr
  138: 
  139: : xxx8
  140: { b }
  141: ?do
  142: { a }
  143: [ ." before loop" localsinfo ]
  144: loop
  145: [ ." after loop" localsinfo ]
  146: ;
  147: 
  148: ." xxx9 coming up" cr
  149: : xxx9
  150: { b }
  151: do
  152: { c }
  153: [ ." before ?leave" leave-sp ? leave-stack . cr ]
  154: ?leave
  155: [ ." after ?leave" leave-sp ? cr ]
  156: { a }
  157: [ ." before loop" localsinfo ]
  158: loop
  159: [ ." after loop" localsinfo ]
  160: ;
  161: 
  162: ." strcmp coming up" cr
  163: : strcmp { addr1 u1 addr2 u2 -- n }
  164:  addr1 addr2 u1 u2 min 0 ?do
  165:    { s1 s2 }
  166:    s1 c@ s2 c@ - ?dup if
  167:      unloop exit
  168:    then
  169:    s1 char+ s2 char+
  170:  loop
  171:  2drop
  172:  u1 u2 - ;
  173: 
  174: : teststrcmp
  175: ." lp@:" lp@ . cr
  176: s" xxx" s" yyy" strcmp . cr
  177: ." lp@:" lp@ . cr
  178: s" xxx" s" xxx" strcmp . cr
  179: ." lp@:" lp@ . cr
  180: s" xxx" s" xxxx" strcmp . cr
  181: ." lp@:" lp@ . cr
  182: s" xxx3" s" xxx2" strcmp . cr
  183: ." lp@:" lp@ . cr
  184: s" " s" " strcmp . cr
  185: ." lp@:" lp@ . cr
  186: ." lp@:" lp@ . cr
  187: ." stack:" .s cr
  188: ;
  189: 
  190: : findchar { c addr u -- i }
  191:  addr u 0 ?do
  192:    { p }
  193:    p c@ c = if
  194:      p leave
  195:    then
  196:    p char+
  197:  loop
  198:  addr - ;
  199: 
  200: 
  201: : testfindchar
  202: ." findcahr " cr
  203: ." lp@:" lp@ . cr
  204: [char] a s" xxx" findchar . cr
  205: ." lp@:" lp@ . cr
  206: [char] a s" " findchar . cr
  207: ." lp@:" lp@ . cr
  208: [char] a s" wam" findchar . cr
  209: ." lp@:" lp@ . cr
  210: [char] a s" wma" findchar . cr
  211: ." lp@:" lp@ . cr
  212: [char] a s" awam" findchar . cr
  213: ." lp@:" lp@ . cr
  214: ." stack:" .s cr
  215: ;
  216: 
  217: 
  218: 
  219: ." stack:" .s cr
  220: teststrcmp
  221: testfindchar
  222: ." hey you" cr
  223: 
  224: : xxx10
  225: [ ." before if" localsinfo ]
  226: if
  227: [ ." after if" localsinfo ]
  228: scope
  229: [ ." after scope" localsinfo ]
  230: { a }
  231: [ ." before endscope" localsinfo ]
  232: endscope
  233: [ ." before begin" localsinfo ]
  234: begin
  235: [ ." after begin" localsinfo ]
  236: [ 1 cs-roll ]
  237: [ ." before then" localsinfo ]
  238: then
  239: { b }
  240: until
  241: [ ." after until" localsinfo ]
  242: ;
  243: 
  244: : xxx11
  245:     if
  246:     { a }
  247:     exit
  248:     [ ." after xexit" localsinfo ]
  249:     else
  250:     { b }
  251:     [ ." before xthen" localsinfo ]
  252:     then
  253:     [ ." after xthen" localsinfo ]
  254: ;
  255: 
  256: ." strcmp1 coming up" cr
  257: : strcmp1 { addr1 u1 addr2 u2 -- n }
  258:  u1 u2 min 0 ?do
  259:    addr1 c@ addr2 c@ - ?dup if
  260:      unloop exit
  261:    then
  262:    addr1 char+ TO addr1
  263:    addr2 char+ TO addr2
  264:  loop
  265:  u1 u2 - ;
  266: 
  267: : teststrcmp1
  268: ." lp@:" lp@ . cr
  269: s" xxx" s" yyy" strcmp1 . cr
  270: ." lp@:" lp@ . cr
  271: s" xxx" s" xxx" strcmp1 . cr
  272: ." lp@:" lp@ . cr
  273: s" xxx" s" xxxx" strcmp1 . cr
  274: ." lp@:" lp@ . cr
  275: s" xxx3" s" xxx2" strcmp1 . cr
  276: ." lp@:" lp@ . cr
  277: s" " s" " strcmp1 . cr
  278: ." lp@:" lp@ . cr
  279: ." lp@:" lp@ . cr
  280: ." stack:" .s cr
  281: ;
  282: teststrcmp1
  283: 
  284: ." testing the abominable locals-ext wordset" cr
  285: : puke locals| this read you can |
  286:     you read this can ;
  287: 
  288: 1 2 3 4 puke . . . . cr
  289: 
  290: bye

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