Return to locals-test.fs CVS log

Up to [gforth] / gforth

Changed environment? to use a wordlist
added most of the core environmental queries

    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: ahead
   98: begin
   99: [ ." after begin" localsinfo ]
  100: [ 1 cs-roll ]
  101: then
  102: [ ." after then" localsinfo ]
  103: until
  104: [ ." after until" localsinfo ]
  105: ;
  106: 
  107: ." xxx6 coming up" cr
  108: : xxx6
  109:     [ ." starting xxx6" localsinfo ]
  110: if
  111: { x }
  112: else
  113: [ ." after else" localsinfo ]
  114: ahead
  115: begin
  116: [ ." after begin" localsinfo ]
  117: [ 2 CS-ROLL ] then
  118: [ ." after then" localsinfo ]
  119: until
  120: then
  121:     [ ." ending xxx6" localsinfo ]
  122: ;
  123: 
  124: ." xxx7 coming up" cr
  125: : xxx7
  126: { b }
  127: do
  128: { a }
  129: [ ." before loop" localsinfo ]
  130: loop
  131: [ ." after loop" localsinfo ]
  132: ;
  133: 
  134: ." xxx8 coming up" cr
  135: 
  136: : xxx8
  137: { b }
  138: ?do
  139: { a }
  140: [ ." before loop" localsinfo ]
  141: loop
  142: [ ." after loop" localsinfo ]
  143: ;
  144: 
  145: ." xxx9 coming up" cr
  146: : xxx9
  147: { b }
  148: do
  149: { c }
  150: [ ." before ?leave" leave-sp ? leave-stack . cr ]
  151: ?leave
  152: [ ." after ?leave" leave-sp ? cr ]
  153: { a }
  154: [ ." before loop" localsinfo ]
  155: loop
  156: [ ." after loop" localsinfo ]
  157: ;
  158: 
  159: ." strcmp coming up" cr
  160: : strcmp { addr1 u1 addr2 u2 -- n }
  161:  addr1 addr2 u1 u2 min 0 ?do
  162:    { s1 s2 }
  163:    s1 c@ s2 c@ - ?dup if
  164:      unloop exit
  165:    then
  166:    s1 char+ s2 char+
  167:  loop
  168:  2drop
  169:  u1 u2 - ;
  170: 
  171: : teststrcmp
  172: ." lp@:" lp@ . cr
  173: s" xxx" s" yyy" strcmp . cr
  174: ." lp@:" lp@ . cr
  175: s" xxx" s" xxx" strcmp . cr
  176: ." lp@:" lp@ . cr
  177: s" xxx" s" xxxx" strcmp . cr
  178: ." lp@:" lp@ . cr
  179: s" xxx3" s" xxx2" strcmp . cr
  180: ." lp@:" lp@ . cr
  181: s" " s" " strcmp . cr
  182: ." lp@:" lp@ . cr
  183: ." lp@:" lp@ . cr
  184: ." stack:" .s cr
  185: ;
  186: 
  187: : findchar { c addr u -- i }
  188:  addr u 0 ?do
  189:    { p }
  190:    p c@ c = if
  191:      p leave
  192:    then
  193:    p char+
  194:  loop
  195:  addr - ;
  196: 
  197: 
  198: : testfindchar
  199: ." findcahr " cr
  200: ." lp@:" lp@ . cr
  201: [char] a s" xxx" findchar . cr
  202: ." lp@:" lp@ . cr
  203: [char] a s" " findchar . cr
  204: ." lp@:" lp@ . cr
  205: [char] a s" wam" findchar . cr
  206: ." lp@:" lp@ . cr
  207: [char] a s" wma" findchar . cr
  208: ." lp@:" lp@ . cr
  209: [char] a s" awam" findchar . cr
  210: ." lp@:" lp@ . cr
  211: ." stack:" .s cr
  212: ;
  213: 
  214: 
  215: 
  216: ." stack:" .s cr
  217: teststrcmp
  218: testfindchar
  219: ." hey you" cr
  220: 
  221: : xxx10
  222: [ ." before if" localsinfo ]
  223: if
  224: [ ." after if" localsinfo ]
  225: scope
  226: [ ." after scope" localsinfo ]
  227: { a }
  228: [ ." before endscope" localsinfo ]
  229: endscope
  230: [ ." before begin" localsinfo ]
  231: begin
  232: [ ." after begin" localsinfo ]
  233: [ 1 cs-roll ]
  234: [ ." before then" localsinfo ]
  235: then
  236: { b }
  237: until
  238: [ ." after until" localsinfo ]
  239: ;
  240: 
  241: : xxx11
  242:     if
  243:     { a }
  244:     exit
  245:     [ ." after xexit" localsinfo ]
  246:     else
  247:     { b }
  248:     [ ." before xthen" localsinfo ]
  249:     then
  250:     [ ." after xthen" localsinfo ]
  251: ;
  252: 
  253: ." strcmp1 coming up" cr
  254: : strcmp1 { addr1 u1 addr2 u2 -- n }
  255:  u1 u2 min 0 ?do
  256:    addr1 c@ addr2 c@ - ?dup if
  257:      unloop exit
  258:    then
  259:    addr1 char+ TO addr1
  260:    addr2 char+ TO addr2
  261:  loop
  262:  u1 u2 - ;
  263: 
  264: : teststrcmp1
  265: ." lp@:" lp@ . cr
  266: s" xxx" s" yyy" strcmp1 . cr
  267: ." lp@:" lp@ . cr
  268: s" xxx" s" xxx" strcmp1 . cr
  269: ." lp@:" lp@ . cr
  270: s" xxx" s" xxxx" strcmp1 . cr
  271: ." lp@:" lp@ . cr
  272: s" xxx3" s" xxx2" strcmp1 . cr
  273: ." lp@:" lp@ . cr
  274: s" " s" " strcmp1 . cr
  275: ." lp@:" lp@ . cr
  276: ." lp@:" lp@ . cr
  277: ." stack:" .s cr
  278: ;
  279: teststrcmp1
  280: 
  281: 
  282: bye