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

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.5     ! anton      97: a drop    
1.2       anton      98: ahead
1.5     ! anton      99: assume-live
1.2       anton     100: begin
1.1       anton     101: [ ." after begin" localsinfo ]
1.5     ! anton     102: a drop    
1.1       anton     103: [ 1 cs-roll ]
1.2       anton     104: then
1.1       anton     105: [ ." after then" localsinfo ]
1.2       anton     106: until
1.1       anton     107: [ ." after until" localsinfo ]
                    108: ;
                    109: 
1.2       anton     110: ." xxx6 coming up" cr
1.1       anton     111: : xxx6
1.2       anton     112:     [ ." starting xxx6" localsinfo ]
                    113: if
1.1       anton     114: { x }
1.2       anton     115: else
1.1       anton     116: [ ." after else" localsinfo ]
1.2       anton     117: ahead
                    118: begin
1.1       anton     119: [ ." after begin" localsinfo ]
1.2       anton     120: [ 2 CS-ROLL ] then
1.1       anton     121: [ ." after then" localsinfo ]
1.2       anton     122: until
                    123: then
                    124:     [ ." ending xxx6" localsinfo ]
1.1       anton     125: ;
                    126: 
                    127: ." xxx7 coming up" cr
                    128: : xxx7
                    129: { b }
1.2       anton     130: do
1.1       anton     131: { a }
                    132: [ ." before loop" localsinfo ]
1.2       anton     133: loop
1.1       anton     134: [ ." after loop" localsinfo ]
                    135: ;
                    136: 
                    137: ." xxx8 coming up" cr
                    138: 
                    139: : xxx8
                    140: { b }
1.2       anton     141: ?do
1.1       anton     142: { a }
                    143: [ ." before loop" localsinfo ]
1.2       anton     144: loop
1.1       anton     145: [ ." after loop" localsinfo ]
                    146: ;
                    147: 
                    148: ." xxx9 coming up" cr
                    149: : xxx9
                    150: { b }
1.2       anton     151: do
1.1       anton     152: { c }
                    153: [ ." before ?leave" leave-sp ? leave-stack . cr ]
1.2       anton     154: ?leave
1.1       anton     155: [ ." after ?leave" leave-sp ? cr ]
                    156: { a }
                    157: [ ." before loop" localsinfo ]
1.2       anton     158: loop
1.1       anton     159: [ ." after loop" localsinfo ]
                    160: ;
                    161: 
                    162: ." strcmp coming up" cr
                    163: : strcmp { addr1 u1 addr2 u2 -- n }
1.2       anton     164:  addr1 addr2 u1 u2 min 0 ?do
1.1       anton     165:    { s1 s2 }
1.2       anton     166:    s1 c@ s2 c@ - ?dup if
                    167:      unloop exit
                    168:    then
1.1       anton     169:    s1 char+ s2 char+
1.2       anton     170:  loop
1.1       anton     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 }
1.2       anton     191:  addr u 0 ?do
1.1       anton     192:    { p }
1.2       anton     193:    p c@ c = if
                    194:      p leave
                    195:    then
1.1       anton     196:    p char+
1.2       anton     197:  loop
1.1       anton     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 ]
1.2       anton     226: if
1.1       anton     227: [ ." after if" localsinfo ]
                    228: scope
                    229: [ ." after scope" localsinfo ]
                    230: { a }
                    231: [ ." before endscope" localsinfo ]
                    232: endscope
                    233: [ ." before begin" localsinfo ]
1.2       anton     234: begin
1.1       anton     235: [ ." after begin" localsinfo ]
                    236: [ 1 cs-roll ]
                    237: [ ." before then" localsinfo ]
1.2       anton     238: then
1.1       anton     239: { b }
1.2       anton     240: until
1.1       anton     241: [ ." after until" localsinfo ]
                    242: ;
                    243: 
1.2       anton     244: : xxx11
                    245:     if
                    246:     { a }
                    247:     exit
                    248:     [ ." after xexit" localsinfo ]
                    249:     else
                    250:     { b }
1.4       anton     251:     [ ." before xthen" localsinfo ]
1.2       anton     252:     then
                    253:     [ ." after xthen" localsinfo ]
                    254: ;
1.3       anton     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
1.2       anton     283: 
1.5     ! anton     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
1.2       anton     289: 
                    290: bye

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