Annotation of gforth/locals-test.fs, revision 1.4

1.1       anton       1: include glocals.fs
1.3       anton       2: include debugging.fs
1.1       anton       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
1.3       anton      32:    [ ." starting xxxx" .s cr ]
1.1       anton      33: { f } f
1.2       anton      34: if
1.3       anton      35:  { a b }
                     36:  b a
1.1       anton      37: [ ." before else" .s cr ]
1.2       anton      38: else
1.1       anton      39: [ ." after else" .s cr ]
1.3       anton      40:  { c d }
                     41:  c d
1.2       anton      42: then
1.1       anton      43: [ ." locals-size after then:" locals-size @ . cr ]
1.3       anton      44: ~~ f ~~ drop
                     45: [ ." ending xxxx" .s cr ]
1.1       anton      46: ;
                     47: 
                     48: 2 3 1 xxxx . . cr
                     49: 2 3 0 xxxx . . cr
                     50: cr cr cr
                     51: 
                     52: : xxx3
1.2       anton      53: begin
1.1       anton      54:   { a }
1.2       anton      55: until
1.1       anton      56: a
                     57: ;
                     58: ." after xxx3" .s cr cr cr
                     59: 
                     60: : xxx2
                     61: [ ." start of xxx2" .s cr ]
1.2       anton      62: begin
1.1       anton      63: [ ." after begin" .s cr ]
                     64:   { a }
                     65: [ ." after { a }" .s cr ]
1.2       anton      66: 1 while
1.1       anton      67: [ ." after while" .s cr ]
1.3       anton      68:  { b }
                     69:  a b
1.1       anton      70: [ ." after a" .s cr ]
1.2       anton      71: repeat
1.1       anton      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 ]
1.2       anton      81: if
1.1       anton      82: [ ." after if" localsinfo ]
                     83: { a }
                     84: [ ." before begin" localsinfo ]
1.2       anton      85: begin
1.1       anton      86: [ ." after begin" localsinfo ]
                     87: [ 1 cs-roll ]
                     88: [ ." before then" localsinfo ]
1.2       anton      89: then
1.1       anton      90: { b }
1.2       anton      91: until
1.1       anton      92: [ ." after until" localsinfo ]
                     93: ;
                     94: 
                     95: : xxx5
                     96: { a }
1.2       anton      97: ahead
                     98: begin
1.1       anton      99: [ ." after begin" localsinfo ]
                    100: [ 1 cs-roll ]
1.2       anton     101: then
1.1       anton     102: [ ." after then" localsinfo ]
1.2       anton     103: until
1.1       anton     104: [ ." after until" localsinfo ]
                    105: ;
                    106: 
1.2       anton     107: ." xxx6 coming up" cr
1.1       anton     108: : xxx6
1.2       anton     109:     [ ." starting xxx6" localsinfo ]
                    110: if
1.1       anton     111: { x }
1.2       anton     112: else
1.1       anton     113: [ ." after else" localsinfo ]
1.2       anton     114: ahead
                    115: begin
1.1       anton     116: [ ." after begin" localsinfo ]
1.2       anton     117: [ 2 CS-ROLL ] then
1.1       anton     118: [ ." after then" localsinfo ]
1.2       anton     119: until
                    120: then
                    121:     [ ." ending xxx6" localsinfo ]
1.1       anton     122: ;
                    123: 
                    124: ." xxx7 coming up" cr
                    125: : xxx7
                    126: { b }
1.2       anton     127: do
1.1       anton     128: { a }
                    129: [ ." before loop" localsinfo ]
1.2       anton     130: loop
1.1       anton     131: [ ." after loop" localsinfo ]
                    132: ;
                    133: 
                    134: ." xxx8 coming up" cr
                    135: 
                    136: : xxx8
                    137: { b }
1.2       anton     138: ?do
1.1       anton     139: { a }
                    140: [ ." before loop" localsinfo ]
1.2       anton     141: loop
1.1       anton     142: [ ." after loop" localsinfo ]
                    143: ;
                    144: 
                    145: ." xxx9 coming up" cr
                    146: : xxx9
                    147: { b }
1.2       anton     148: do
1.1       anton     149: { c }
                    150: [ ." before ?leave" leave-sp ? leave-stack . cr ]
1.2       anton     151: ?leave
1.1       anton     152: [ ." after ?leave" leave-sp ? cr ]
                    153: { a }
                    154: [ ." before loop" localsinfo ]
1.2       anton     155: loop
1.1       anton     156: [ ." after loop" localsinfo ]
                    157: ;
                    158: 
                    159: ." strcmp coming up" cr
                    160: : strcmp { addr1 u1 addr2 u2 -- n }
1.2       anton     161:  addr1 addr2 u1 u2 min 0 ?do
1.1       anton     162:    { s1 s2 }
1.2       anton     163:    s1 c@ s2 c@ - ?dup if
                    164:      unloop exit
                    165:    then
1.1       anton     166:    s1 char+ s2 char+
1.2       anton     167:  loop
1.1       anton     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 }
1.2       anton     188:  addr u 0 ?do
1.1       anton     189:    { p }
1.2       anton     190:    p c@ c = if
                    191:      p leave
                    192:    then
1.1       anton     193:    p char+
1.2       anton     194:  loop
1.1       anton     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 ]
1.2       anton     223: if
1.1       anton     224: [ ." after if" localsinfo ]
                    225: scope
                    226: [ ." after scope" localsinfo ]
                    227: { a }
                    228: [ ." before endscope" localsinfo ]
                    229: endscope
                    230: [ ." before begin" localsinfo ]
1.2       anton     231: begin
1.1       anton     232: [ ." after begin" localsinfo ]
                    233: [ 1 cs-roll ]
                    234: [ ." before then" localsinfo ]
1.2       anton     235: then
1.1       anton     236: { b }
1.2       anton     237: until
1.1       anton     238: [ ." after until" localsinfo ]
                    239: ;
                    240: 
1.2       anton     241: : xxx11
                    242:     if
                    243:     { a }
                    244:     exit
                    245:     [ ." after xexit" localsinfo ]
                    246:     else
                    247:     { b }
1.4     ! anton     248:     [ ." before xthen" localsinfo ]
1.2       anton     249:     then
                    250:     [ ." after xthen" localsinfo ]
                    251: ;
1.3       anton     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
1.2       anton     280: 
                    281: 
                    282: bye

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