Return to locals-test.fs CVS log | Up to [gforth] / gforth |
added code.fs (code, ;code, end-code, assembler) renamed dostruc to dofield made index and doc-entries nicer Only words containing 'e' or 'E' are converted to FP numbers. added many wordset comments added flush-icache primitive and FLUSH_ICACHE macro added +DO, U+DO, -DO, U-DO and -LOOP added code address labels (`docol:' etc.) fixed sparc cache_flush
1: require glocals.fs 2: require 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: a drop 98: ahead 99: assume-live 100: begin 101: [ ." after begin" localsinfo ] 102: a drop 103: [ 1 cs-roll ] 104: then 105: [ ." after then" localsinfo ] 106: until 107: [ ." after until" localsinfo ] 108: ; 109: 110: ." xxx6 coming up" cr 111: : xxx6 112: [ ." starting xxx6" localsinfo ] 113: if 114: { x } 115: else 116: [ ." after else" localsinfo ] 117: ahead 118: begin 119: [ ." after begin" localsinfo ] 120: [ 2 CS-ROLL ] then 121: [ ." after then" localsinfo ] 122: until 123: then 124: [ ." ending xxx6" localsinfo ] 125: ; 126: 127: ." xxx7 coming up" cr 128: : xxx7 129: { b } 130: do 131: { a } 132: [ ." before loop" localsinfo ] 133: loop 134: [ ." after loop" localsinfo ] 135: ; 136: 137: ." xxx8 coming up" cr 138: 139: : xxx8 140: { b } 141: ?do 142: { a } 143: [ ." before loop" localsinfo ] 144: loop 145: [ ." after loop" localsinfo ] 146: ; 147: 148: ." xxx9 coming up" cr 149: : xxx9 150: { b } 151: do 152: { c } 153: [ ." before ?leave" leave-sp ? leave-stack . cr ] 154: ?leave 155: [ ." after ?leave" leave-sp ? cr ] 156: { a } 157: [ ." before loop" localsinfo ] 158: loop 159: [ ." after loop" localsinfo ] 160: ; 161: 162: ." strcmp coming up" cr 163: : strcmp { addr1 u1 addr2 u2 -- n } 164: addr1 addr2 u1 u2 min 0 ?do 165: { s1 s2 } 166: s1 c@ s2 c@ - ?dup if 167: unloop exit 168: then 169: s1 char+ s2 char+ 170: loop 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 } 191: addr u 0 ?do 192: { p } 193: p c@ c = if 194: p leave 195: then 196: p char+ 197: loop 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 ] 226: if 227: [ ." after if" localsinfo ] 228: scope 229: [ ." after scope" localsinfo ] 230: { a } 231: [ ." before endscope" localsinfo ] 232: endscope 233: [ ." before begin" localsinfo ] 234: begin 235: [ ." after begin" localsinfo ] 236: [ 1 cs-roll ] 237: [ ." before then" localsinfo ] 238: then 239: { b } 240: until 241: [ ." after until" localsinfo ] 242: ; 243: 244: : xxx11 245: if 246: { a } 247: exit 248: [ ." after xexit" localsinfo ] 249: else 250: { b } 251: [ ." before xthen" localsinfo ] 252: then 253: [ ." after xthen" localsinfo ] 254: ; 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 283: 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 289: 290: \ just some other stuff 291: 292: : life1 { b0 b1 b23 old -- new } 293: b23 invert old b1 b0 xor and old invert b1 and b0 and or and ; 294: 295: : life2 { b0 b1 b23 old -- new } 296: b0 b1 or old b0 xor b1 xor b23 or invert and ; 297: 298: $5555 $3333 $0f0f $00ff life1 . 299: $5555 $3333 $0f0f $00ff life2 . 300: .s 301: cr 302: 303: : test 304: 1 { a } ." after }" cr 305: 2 { b -- } ." after --" cr 306: ; 307: test 308: .s cr 309: 310: bye