![[BACK]](/cvsweb/icons/back.gif){kind=icon}
Return to table.fs CVS log ![[TXT]](/cvsweb/icons/text.gif){kind=icon}
![[DIR]](/cvsweb/icons/dir.gif){kind=icon}
Up to [Qemu by Fabrice Bellard] / qemu / roms / openbios / forth / device|
Return to table.fs CVS log | Up to [Qemu by Fabrice Bellard] / qemu / roms / openbios / forth / device |
1.1 ! root 1: \ tag: FCode table setup ! 2: \ ! 3: \ this code implements an fcode evaluator ! 4: \ as described in IEEE 1275-1994 ! 5: \ ! 6: \ Copyright (C) 2003 Stefan Reinauer ! 7: \ ! 8: \ See the file "COPYING" for further information about ! 9: \ the copyright and warranty status of this work. ! 10: \ ! 11: ! 12: hex ! 13: ! 14: : undefined-fcode ." undefined fcode word." cr ; ! 15: : reserved-fcode ." reserved fcode word." cr ; ! 16: ! 17: : ['], ( <word> -- ) ! 18: ' , ! 19: ; ! 20: ! 21: : n['], ( n <word> -- ) ! 22: ' swap 0 do ! 23: dup , ! 24: loop ! 25: drop ! 26: ; ! 27: ! 28: \ the table used ! 29: create fcode-master-table ! 30: ['], end0 ! 31: f n['], reserved-fcode ! 32: ['], b(lit) ! 33: ['], b(') ! 34: ['], b(") ! 35: ['], bbranch ! 36: ['], b?branch ! 37: ['], b(loop) ! 38: ['], b(+loop) ! 39: ['], b(do) ! 40: ['], b(?do) ! 41: ['], i ! 42: ['], j ! 43: ['], b(leave) ! 44: ['], b(of) ! 45: ['], execute ! 46: ['], + ! 47: ['], - ! 48: ['], * ! 49: ['], / ! 50: ['], mod ! 51: ['], and ! 52: ['], or ! 53: ['], xor ! 54: ['], invert ! 55: ['], lshift ! 56: ['], rshift ! 57: ['], >>a ! 58: ['], /mod ! 59: ['], u/mod ! 60: ['], negate ! 61: ['], abs ! 62: ['], min ! 63: ['], max ! 64: ['], >r ! 65: ['], r> ! 66: ['], r@ ! 67: ['], exit ! 68: ['], 0= ! 69: ['], 0<> ! 70: ['], 0< ! 71: ['], 0<= ! 72: ['], 0> ! 73: ['], 0>= ! 74: ['], < ! 75: ['], > ! 76: ['], = ! 77: ['], <> ! 78: ['], u> ! 79: ['], u<= ! 80: ['], u< ! 81: ['], u>= ! 82: ['], >= ! 83: ['], <= ! 84: ['], between ! 85: ['], within ! 86: ['], drop ! 87: ['], dup ! 88: ['], over ! 89: ['], swap ! 90: ['], rot ! 91: ['], -rot ! 92: ['], tuck ! 93: ['], nip ! 94: ['], pick ! 95: ['], roll ! 96: ['], ?dup ! 97: ['], depth ! 98: ['], 2drop ! 99: ['], 2dup ! 100: ['], 2over ! 101: ['], 2swap ! 102: ['], 2rot ! 103: ['], 2/ ! 104: ['], u2/ ! 105: ['], 2* ! 106: ['], /c ! 107: ['], /w ! 108: ['], /l ! 109: ['], /n ! 110: ['], ca+ ! 111: ['], wa+ ! 112: ['], la+ ! 113: ['], na+ ! 114: ['], char+ ! 115: ['], wa1+ ! 116: ['], la1+ ! 117: ['], cell+ ! 118: ['], chars ! 119: ['], /w* ! 120: ['], /l* ! 121: ['], cells ! 122: ['], on ! 123: ['], off ! 124: ['], +! ! 125: ['], @ ! 126: ['], l@ ! 127: ['], w@ ! 128: ['], <w@ ! 129: ['], c@ ! 130: ['], ! ! 131: ['], l! ! 132: ['], w! ! 133: ['], c! ! 134: ['], 2@ ! 135: ['], 2! ! 136: ['], move ! 137: ['], fill ! 138: ['], comp ! 139: ['], noop ! 140: ['], lwsplit ! 141: ['], wljoin ! 142: ['], lbsplit ! 143: ['], bljoin ! 144: ['], wbflip ! 145: ['], upc ! 146: ['], lcc ! 147: ['], pack ! 148: ['], count ! 149: ['], body> ! 150: ['], >body ! 151: ['], fcode-revision ! 152: ['], span ! 153: ['], unloop ! 154: ['], expect ! 155: ['], alloc-mem ! 156: ['], free-mem ! 157: ['], key? ! 158: ['], key ! 159: ['], emit ! 160: ['], type ! 161: ['], (cr ! 162: ['], cr ! 163: ['], #out ! 164: ['], #line ! 165: ['], hold ! 166: ['], <# ! 167: ['], u#> ! 168: ['], sign ! 169: ['], u# ! 170: ['], u#s ! 171: ['], u. ! 172: ['], u.r ! 173: ['], . ! 174: ['], .r ! 175: ['], .s ! 176: ['], base ! 177: ['], convert \ reserved (compatibility) ! 178: ['], $number ! 179: ['], digit ! 180: ['], -1 ! 181: ['], 0 ! 182: ['], 1 ! 183: ['], 2 ! 184: ['], 3 ! 185: ['], bl ! 186: ['], bs ! 187: ['], bell ! 188: ['], bounds ! 189: ['], here ! 190: ['], aligned ! 191: ['], wbsplit ! 192: ['], bwjoin ! 193: ['], b(<mark) ! 194: ['], b(>resolve) ! 195: ['], set-token-table ! 196: ['], set-table ! 197: ['], new-token ! 198: ['], named-token ! 199: ['], b(:) ! 200: ['], b(value) ! 201: ['], b(variable) ! 202: ['], b(constant) ! 203: ['], b(create) ! 204: ['], b(defer) ! 205: ['], b(buffer:) ! 206: ['], b(field) ! 207: ['], b(code) ! 208: ['], instance ! 209: ['], reserved-fcode ! 210: ['], b(;) ! 211: ['], b(to) ! 212: ['], b(case) ! 213: ['], b(endcase) ! 214: ['], b(endof) ! 215: ['], # ! 216: ['], #s ! 217: ['], #> ! 218: ['], external-token ! 219: ['], $find ! 220: ['], offset16 ! 221: ['], evaluate ! 222: ['], reserved-fcode ! 223: ['], reserved-fcode ! 224: ['], c, ! 225: ['], w, ! 226: ['], l, ! 227: ['], , ! 228: ['], um* ! 229: ['], um/mod ! 230: ['], reserved-fcode ! 231: ['], reserved-fcode ! 232: ['], d+ ! 233: ['], d- ! 234: ['], get-token ! 235: ['], set-token ! 236: ['], state ! 237: ['], compile, ! 238: ['], behavior ! 239: 11 n['], reserved-fcode ! 240: ['], start0 ! 241: ['], start1 ! 242: ['], start2 ! 243: ['], start4 ! 244: 8 n['], reserved-fcode ! 245: ['], ferror ! 246: ['], version1 ! 247: ['], 4-byte-id ! 248: ['], end1 ! 249: ['], reserved-fcode ! 250: ['], dma-alloc ! 251: ['], my-address ! 252: ['], my-space ! 253: ['], memmap ! 254: ['], free-virtual ! 255: ['], >physical ! 256: 8 n['], reserved-fcode ! 257: ['], my-params ! 258: ['], property ! 259: ['], encode-int ! 260: ['], encode+ ! 261: ['], encode-phys ! 262: ['], encode-string ! 263: ['], encode-bytes ! 264: ['], reg ! 265: ['], intr ! 266: ['], driver ! 267: ['], model ! 268: ['], device-type ! 269: ['], parse-2int ! 270: ['], is-install ! 271: ['], is-remove ! 272: ['], is-selftest ! 273: ['], new-device ! 274: ['], diagnostic-mode? ! 275: ['], display-status ! 276: ['], memory-test-suite ! 277: ['], group-code ! 278: ['], mask ! 279: ['], get-msecs ! 280: ['], ms ! 281: ['], finish-device ! 282: ['], decode-phys \ 128 ! 283: ['], push-package ! 284: ['], pop-package ! 285: ['], interpose \ extension (recommended practice) ! 286: 4 n['], reserved-fcode ! 287: ['], map-low ! 288: ['], sbus-intr>cpu ! 289: 1e n['], reserved-fcode ! 290: ['], #lines ! 291: ['], #columns ! 292: ['], line# ! 293: ['], column# ! 294: ['], inverse? ! 295: ['], inverse-screen? ! 296: ['], frame-buffer-busy? ! 297: ['], draw-character ! 298: ['], reset-screen ! 299: ['], toggle-cursor ! 300: ['], erase-screen ! 301: ['], blink-screen ! 302: ['], invert-screen ! 303: ['], insert-characters ! 304: ['], delete-characters ! 305: ['], insert-lines ! 306: ['], delete-lines ! 307: ['], draw-logo ! 308: ['], frame-buffer-adr ! 309: ['], screen-height ! 310: ['], screen-width ! 311: ['], window-top ! 312: ['], window-left ! 313: 3 n['], reserved-fcode ! 314: ['], default-font ! 315: ['], set-font ! 316: ['], char-height ! 317: ['], char-width ! 318: ['], >font ! 319: ['], fontbytes ! 320: 10 n['], reserved-fcode \ fb1 words ! 321: ['], fb8-draw-character ! 322: ['], fb8-reset-screen ! 323: ['], fb8-toggle-cursor ! 324: ['], fb8-erase-screen ! 325: ['], fb8-blink-screen ! 326: ['], fb8-invert-screen ! 327: ['], fb8-insert-characters ! 328: ['], fb8-delete-characters ! 329: ['], fb8-insert-lines ! 330: ['], fb8-delete-lines ! 331: ['], fb8-draw-logo ! 332: ['], fb8-install ! 333: 4 n['], reserved-fcode \ reserved ! 334: 7 n['], reserved-fcode \ VME-bus support ! 335: 9 n['], reserved-fcode \ reserved ! 336: ['], return-buffer ! 337: ['], xmit-packet ! 338: ['], poll-packet ! 339: ['], reserved-fcode ! 340: ['], mac-address ! 341: 5c n['], reserved-fcode \ 1a5-200 reserved ! 342: ['], device-name ! 343: ['], my-args ! 344: ['], my-self ! 345: ['], find-package ! 346: ['], open-package ! 347: ['], close-package ! 348: ['], find-method ! 349: ['], call-package ! 350: ['], $call-parent ! 351: ['], my-parent ! 352: ['], ihandle>phandle ! 353: ['], reserved-fcode ! 354: ['], my-unit ! 355: ['], $call-method ! 356: ['], $open-package ! 357: ['], processor-type ! 358: ['], firmware-version ! 359: ['], fcode-version ! 360: ['], alarm ! 361: ['], (is-user-word) ! 362: ['], suspend-fcode ! 363: ['], abort ! 364: ['], catch ! 365: ['], throw ! 366: ['], user-abort ! 367: ['], get-my-property ! 368: ['], decode-int ! 369: ['], decode-string ! 370: ['], get-inherited-property ! 371: ['], delete-property ! 372: ['], get-package-property ! 373: ['], cpeek ! 374: ['], wpeek ! 375: ['], lpeek ! 376: ['], cpoke ! 377: ['], wpoke ! 378: ['], lpoke ! 379: ['], lwflip ! 380: ['], lbflip ! 381: ['], lbflips ! 382: ['], adr-mask ! 383: 4 n['], reserved-fcode \ 22a-22d ! 384: 64bit? [IF] ! 385: ['], (rx@) ! 386: ['], (rx!) ! 387: [ELSE] ! 388: 2 n['], reserved-fcode \ 22e-22f ! 389: [THEN] ! 390: ['], rb@ ! 391: ['], rb! ! 392: ['], rw@ ! 393: ['], rw! ! 394: ['], rl@ ! 395: ['], rl! ! 396: ['], wbflips ! 397: ['], lwflips ! 398: ['], probe ! 399: ['], probe-virtual ! 400: ['], reserved-fcode ! 401: ['], child ! 402: ['], peer ! 403: ['], next-property ! 404: ['], byte-load ! 405: ['], set-args ! 406: ['], left-parse-string \ 240 ! 407: 64bit? [IF] ! 408: ['], bxjoin ! 409: ['], <l@ ! 410: ['], lxjoin ! 411: ['], wxjoin ! 412: ['], x, ! 413: ['], x@ ! 414: ['], x! ! 415: ['], /x ! 416: ['], /x* ! 417: \ ['], /xa+ ! 418: \ ['], /xa1+ ! 419: ['], xbflip ! 420: ['], xbflips ! 421: ['], xbsplit ! 422: ['], xlflip ! 423: ['], xlflips ! 424: ['], xlsplit ! 425: ['], xwflip ! 426: ['], xwflips ! 427: ['], xwsplit ! 428: [ELSE] ! 429: 7 n['], reserved-fcode \ 241-247 (Part of IEEE1275 64-bit draft standard) ! 430: ['], /x ! 431: c n['], reserved-fcode \ 249-254 (Part of IEEE1275 64-bit draft standard) ! 432: [THEN] ! 433: ! 434: ! 435: here fcode-master-table - constant fcode-master-table-size ! 436: ! 437: ! 438: : nreserved ( fcode-table-ptr first last xt -- ) ! 439: -rot 1+ swap do ! 440: 2dup swap i cells + ! ! 441: loop ! 442: 2drop ! 443: ; ! 444: ! 445: :noname ! 446: 800 cells alloc-mem to fcode-sys-table ! 447: ! 448: fcode-sys-table ! 449: dup 0 5ff ['] reserved-fcode nreserved \ built-in fcodes ! 450: dup 600 7ff ['] undefined-fcode nreserved \ vendor fcodes ! 451: ! 452: \ copy built-in fcodes ! 453: fcode-master-table swap fcode-master-table-size move ! 454: ; initializer ! 455: ! 456: : (init-fcode-table) ( -- ) ! 457: fcode-sys-table fcode-table 800 cells move ! 458: \ clear local fcodes ! 459: fcode-table 800 fff ['] undefined-fcode nreserved ! 460: ; ! 461: ! 462: ['] (init-fcode-table) to init-fcode-table
This archive runs on limited infrastructure. Preserving old code on modern bandwidth. Automated agents are requested to crawl responsibly.