Return to locals-test.fs CVS log

Up to [gforth] / gforth

local variables
rewrote primitives2c.el in Forth (prims2x.el)
various small changes
Added Files:
 	from-cut-here gforth.el gforth.texi glocals.fs gray.fs
 	locals-test.fs prims2x.fs

    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: { f } f
   32: xif
   33:   { a b }
   34:   b a
   35: [ ." before else" .s cr ]
   36: xelse
   37: [ ." after else" .s cr ]
   38:   { c d }
   39:   c d
   40: xthen
   41: [ ." locals-size after then:" locals-size @ . cr ]
   42: f drop
   43: ;
   44: 
   45: 2 3 1 xxxx . . cr
   46: 2 3 0 xxxx . . cr
   47: cr cr cr
   48: 
   49: : xxx3
   50: xbegin
   51:   { a }
   52: xuntil
   53: a
   54: ;
   55: ." after xxx3" .s cr cr cr
   56: 
   57: : xxx2
   58: [ ." start of xxx2" .s cr ]
   59: xbegin
   60: [ ." after begin" .s cr ]
   61:   { a }
   62: [ ." after { a }" .s cr ]
   63: 1 xwhile
   64: [ ." after while" .s cr ]
   65:   { b }
   66:   a b
   67: [ ." after a" .s cr ]
   68: xrepeat
   69: [ ." after repeat" .s cr
   70:   also locals words previous cr
   71: ]
   72: a
   73: [ ." end of xxx2" .s cr ]
   74: ;
   75: 
   76: : xxx4
   77: [ ." before if" localsinfo ]
   78: xif
   79: [ ." after if" localsinfo ]
   80: { a }
   81: [ ." before begin" localsinfo ]
   82: xbegin
   83: [ ." after begin" localsinfo ]
   84: [ 1 cs-roll ]
   85: [ ." before then" localsinfo ]
   86: xthen
   87: { b }
   88: xuntil
   89: [ ." after until" localsinfo ]
   90: ;
   91: 
   92: : xxx5
   93: { a }
   94: xahead
   95: xbegin
   96: [ ." after begin" localsinfo ]
   97: [ 1 cs-roll ]
   98: xthen
   99: [ ." after then" localsinfo ]
  100: xuntil
  101: [ ." after until" localsinfo ]
  102: ;
  103: 
  104: : xxx6
  105: xif
  106: { x }
  107: xelse
  108: [ ." after else" localsinfo ]
  109: xahead
  110: xbegin
  111: [ ." after begin" localsinfo ]
  112: [ 2 CS-ROLL ] xthen
  113: [ ." after then" localsinfo ]
  114: xuntil
  115: ;
  116: 
  117: ." xxx7 coming up" cr
  118: : xxx7
  119: { b }
  120: xdo
  121: { a }
  122: [ ." before loop" localsinfo ]
  123: xloop
  124: [ ." after loop" localsinfo ]
  125: ;
  126: 
  127: ." xxx8 coming up" cr
  128: 
  129: : xxx8
  130: { b }
  131: x?do
  132: { a }
  133: [ ." before loop" localsinfo ]
  134: xloop
  135: [ ." after loop" localsinfo ]
  136: ;
  137: 
  138: ." xxx9 coming up" cr
  139: : xxx9
  140: { b }
  141: xdo
  142: { c }
  143: [ ." before ?leave" leave-sp ? leave-stack . cr ]
  144: x?leave
  145: [ ." after ?leave" leave-sp ? cr ]
  146: { a }
  147: [ ." before loop" localsinfo ]
  148: xloop
  149: [ ." after loop" localsinfo ]
  150: ;
  151: 
  152: ." strcmp coming up" cr
  153: : strcmp { addr1 u1 addr2 u2 -- n }
  154:  addr1 addr2 u1 u2 min 0 x?do
  155:    { s1 s2 }
  156:    s1 c@ s2 c@ - ?dup xif
  157:      unloop xexit
  158:    xthen
  159:    s1 char+ s2 char+
  160:  xloop
  161:  2drop
  162:  u1 u2 - ;
  163: 
  164: : teststrcmp
  165: ." lp@:" lp@ . cr
  166: s" xxx" s" yyy" strcmp . cr
  167: ." lp@:" lp@ . cr
  168: s" xxx" s" xxx" strcmp . cr
  169: ." lp@:" lp@ . cr
  170: s" xxx" s" xxxx" strcmp . cr
  171: ." lp@:" lp@ . cr
  172: s" xxx3" s" xxx2" strcmp . cr
  173: ." lp@:" lp@ . cr
  174: s" " s" " strcmp . cr
  175: ." lp@:" lp@ . cr
  176: ." lp@:" lp@ . cr
  177: ." stack:" .s cr
  178: ;
  179: 
  180: : findchar { c addr u -- i }
  181:  addr u 0 x?do
  182:    { p }
  183:    p c@ c = xif
  184:      p xleave
  185:    xthen
  186:    p char+
  187:  xloop
  188:  addr - ;
  189: 
  190: 
  191: : testfindchar
  192: ." findcahr " cr
  193: ." lp@:" lp@ . cr
  194: [char] a s" xxx" findchar . cr
  195: ." lp@:" lp@ . cr
  196: [char] a s" " findchar . cr
  197: ." lp@:" lp@ . cr
  198: [char] a s" wam" findchar . cr
  199: ." lp@:" lp@ . cr
  200: [char] a s" wma" findchar . cr
  201: ." lp@:" lp@ . cr
  202: [char] a s" awam" findchar . cr
  203: ." lp@:" lp@ . cr
  204: ." stack:" .s cr
  205: ;
  206: 
  207: 
  208: 
  209: ." stack:" .s cr
  210: teststrcmp
  211: testfindchar
  212: ." hey you" cr
  213: 
  214: : xxx10
  215: [ ." before if" localsinfo ]
  216: xif
  217: [ ." after if" localsinfo ]
  218: scope
  219: [ ." after scope" localsinfo ]
  220: { a }
  221: [ ." before endscope" localsinfo ]
  222: endscope
  223: [ ." before begin" localsinfo ]
  224: xbegin
  225: [ ." after begin" localsinfo ]
  226: [ 1 cs-roll ]
  227: [ ." before then" localsinfo ]
  228: xthen
  229: { b }
  230: xuntil
  231: [ ." after until" localsinfo ]
  232: ;
  233: