File:  [gforth] / gforth / locals-test.fs
Revision 1.2: download - view: text, annotated - select for diffs
Fri Jun 17 12:35:08 1994 UTC (27 years, 3 months ago) by anton
Branches: MAIN
CVS tags: HEAD
Integrated locals (in particular automatic scoping) into the system.

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

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