diff options
Diffstat (limited to 'qemu/roms/openbios/forth/device/table.fs')
| -rw-r--r-- | qemu/roms/openbios/forth/device/table.fs | 462 |
1 files changed, 462 insertions, 0 deletions
diff --git a/qemu/roms/openbios/forth/device/table.fs b/qemu/roms/openbios/forth/device/table.fs new file mode 100644 index 000000000..5c58f2d9d --- /dev/null +++ b/qemu/roms/openbios/forth/device/table.fs @@ -0,0 +1,462 @@ +\ tag: FCode table setup +\ +\ this code implements an fcode evaluator +\ as described in IEEE 1275-1994 +\ +\ Copyright (C) 2003 Stefan Reinauer +\ +\ See the file "COPYING" for further information about +\ the copyright and warranty status of this work. +\ + +hex + +: undefined-fcode ." undefined fcode word." cr ; +: reserved-fcode ." reserved fcode word." cr ; + +: ['], ( <word> -- ) + ' , +; + +: n['], ( n <word> -- ) + ' swap 0 do + dup , + loop + drop +; + +\ the table used +create fcode-master-table + ['], end0 + f n['], reserved-fcode + ['], b(lit) + ['], b(') + ['], b(") + ['], bbranch + ['], b?branch + ['], b(loop) + ['], b(+loop) + ['], b(do) + ['], b(?do) + ['], i + ['], j + ['], b(leave) + ['], b(of) + ['], execute + ['], + + ['], - + ['], * + ['], / + ['], mod + ['], and + ['], or + ['], xor + ['], invert + ['], lshift + ['], rshift + ['], >>a + ['], /mod + ['], u/mod + ['], negate + ['], abs + ['], min + ['], max + ['], >r + ['], r> + ['], r@ + ['], exit + ['], 0= + ['], 0<> + ['], 0< + ['], 0<= + ['], 0> + ['], 0>= + ['], < + ['], > + ['], = + ['], <> + ['], u> + ['], u<= + ['], u< + ['], u>= + ['], >= + ['], <= + ['], between + ['], within + ['], drop + ['], dup + ['], over + ['], swap + ['], rot + ['], -rot + ['], tuck + ['], nip + ['], pick + ['], roll + ['], ?dup + ['], depth + ['], 2drop + ['], 2dup + ['], 2over + ['], 2swap + ['], 2rot + ['], 2/ + ['], u2/ + ['], 2* + ['], /c + ['], /w + ['], /l + ['], /n + ['], ca+ + ['], wa+ + ['], la+ + ['], na+ + ['], char+ + ['], wa1+ + ['], la1+ + ['], cell+ + ['], chars + ['], /w* + ['], /l* + ['], cells + ['], on + ['], off + ['], +! + ['], @ + ['], l@ + ['], w@ + ['], <w@ + ['], c@ + ['], ! + ['], l! + ['], w! + ['], c! + ['], 2@ + ['], 2! + ['], move + ['], fill + ['], comp + ['], noop + ['], lwsplit + ['], wljoin + ['], lbsplit + ['], bljoin + ['], wbflip + ['], upc + ['], lcc + ['], pack + ['], count + ['], body> + ['], >body + ['], fcode-revision + ['], span + ['], unloop + ['], expect + ['], alloc-mem + ['], free-mem + ['], key? + ['], key + ['], emit + ['], type + ['], (cr + ['], cr + ['], #out + ['], #line + ['], hold + ['], <# + ['], u#> + ['], sign + ['], u# + ['], u#s + ['], u. + ['], u.r + ['], . + ['], .r + ['], .s + ['], base + ['], convert \ reserved (compatibility) + ['], $number + ['], digit + ['], -1 + ['], 0 + ['], 1 + ['], 2 + ['], 3 + ['], bl + ['], bs + ['], bell + ['], bounds + ['], here + ['], aligned + ['], wbsplit + ['], bwjoin + ['], b(<mark) + ['], b(>resolve) + ['], set-token-table + ['], set-table + ['], new-token + ['], named-token + ['], b(:) + ['], b(value) + ['], b(variable) + ['], b(constant) + ['], b(create) + ['], b(defer) + ['], b(buffer:) + ['], b(field) + ['], b(code) + ['], instance + ['], reserved-fcode + ['], b(;) + ['], b(to) + ['], b(case) + ['], b(endcase) + ['], b(endof) + ['], # + ['], #s + ['], #> + ['], external-token + ['], $find + ['], offset16 + ['], evaluate + ['], reserved-fcode + ['], reserved-fcode + ['], c, + ['], w, + ['], l, + ['], , + ['], um* + ['], um/mod + ['], reserved-fcode + ['], reserved-fcode + ['], d+ + ['], d- + ['], get-token + ['], set-token + ['], state + ['], compile, + ['], behavior + 11 n['], reserved-fcode + ['], start0 + ['], start1 + ['], start2 + ['], start4 + 8 n['], reserved-fcode + ['], ferror + ['], version1 + ['], 4-byte-id + ['], end1 + ['], reserved-fcode + ['], dma-alloc + ['], my-address + ['], my-space + ['], memmap + ['], free-virtual + ['], >physical + 8 n['], reserved-fcode + ['], my-params + ['], property + ['], encode-int + ['], encode+ + ['], encode-phys + ['], encode-string + ['], encode-bytes + ['], reg + ['], intr + ['], driver + ['], model + ['], device-type + ['], parse-2int + ['], is-install + ['], is-remove + ['], is-selftest + ['], new-device + ['], diagnostic-mode? + ['], display-status + ['], memory-test-suite + ['], group-code + ['], mask + ['], get-msecs + ['], ms + ['], finish-device + ['], decode-phys \ 128 + ['], push-package + ['], pop-package + ['], interpose \ extension (recommended practice) + 4 n['], reserved-fcode + ['], map-low + ['], sbus-intr>cpu + 1e n['], reserved-fcode + ['], #lines + ['], #columns + ['], line# + ['], column# + ['], inverse? + ['], inverse-screen? + ['], frame-buffer-busy? + ['], draw-character + ['], reset-screen + ['], toggle-cursor + ['], erase-screen + ['], blink-screen + ['], invert-screen + ['], insert-characters + ['], delete-characters + ['], insert-lines + ['], delete-lines + ['], draw-logo + ['], frame-buffer-adr + ['], screen-height + ['], screen-width + ['], window-top + ['], window-left + 3 n['], reserved-fcode + ['], default-font + ['], set-font + ['], char-height + ['], char-width + ['], >font + ['], fontbytes + 10 n['], reserved-fcode \ fb1 words + ['], fb8-draw-character + ['], fb8-reset-screen + ['], fb8-toggle-cursor + ['], fb8-erase-screen + ['], fb8-blink-screen + ['], fb8-invert-screen + ['], fb8-insert-characters + ['], fb8-delete-characters + ['], fb8-insert-lines + ['], fb8-delete-lines + ['], fb8-draw-logo + ['], fb8-install + 4 n['], reserved-fcode \ reserved + 7 n['], reserved-fcode \ VME-bus support + 9 n['], reserved-fcode \ reserved + ['], return-buffer + ['], xmit-packet + ['], poll-packet + ['], reserved-fcode + ['], mac-address + 5c n['], reserved-fcode \ 1a5-200 reserved + ['], device-name + ['], my-args + ['], my-self + ['], find-package + ['], open-package + ['], close-package + ['], find-method + ['], call-package + ['], $call-parent + ['], my-parent + ['], ihandle>phandle + ['], reserved-fcode + ['], my-unit + ['], $call-method + ['], $open-package + ['], processor-type + ['], firmware-version + ['], fcode-version + ['], alarm + ['], (is-user-word) + ['], suspend-fcode + ['], abort + ['], catch + ['], throw + ['], user-abort + ['], get-my-property + ['], decode-int + ['], decode-string + ['], get-inherited-property + ['], delete-property + ['], get-package-property + ['], cpeek + ['], wpeek + ['], lpeek + ['], cpoke + ['], wpoke + ['], lpoke + ['], lwflip + ['], lbflip + ['], lbflips + ['], adr-mask + 4 n['], reserved-fcode \ 22a-22d +64bit? [IF] + ['], (rx@) + ['], (rx!) +[ELSE] + 2 n['], reserved-fcode \ 22e-22f +[THEN] + ['], rb@ + ['], rb! + ['], rw@ + ['], rw! + ['], rl@ + ['], rl! + ['], wbflips + ['], lwflips + ['], probe + ['], probe-virtual + ['], reserved-fcode + ['], child + ['], peer + ['], next-property + ['], byte-load + ['], set-args + ['], left-parse-string \ 240 +64bit? [IF] + ['], bxjoin + ['], <l@ + ['], lxjoin + ['], wxjoin + ['], x, + ['], x@ + ['], x! + ['], /x + ['], /x* +\ ['], /xa+ +\ ['], /xa1+ + ['], xbflip + ['], xbflips + ['], xbsplit + ['], xlflip + ['], xlflips + ['], xlsplit + ['], xwflip + ['], xwflips + ['], xwsplit +[ELSE] + 7 n['], reserved-fcode \ 241-247 (Part of IEEE1275 64-bit draft standard) + ['], /x + c n['], reserved-fcode \ 249-254 (Part of IEEE1275 64-bit draft standard) +[THEN] + + +here fcode-master-table - constant fcode-master-table-size + + +: nreserved ( fcode-table-ptr first last xt -- ) + -rot 1+ swap do + 2dup swap i cells + ! + loop + 2drop +; + +:noname + 800 cells alloc-mem to fcode-sys-table + + fcode-sys-table + dup 0 5ff ['] reserved-fcode nreserved \ built-in fcodes + dup 600 7ff ['] undefined-fcode nreserved \ vendor fcodes + + \ copy built-in fcodes + fcode-master-table swap fcode-master-table-size move +; initializer + +: (init-fcode-table) ( -- ) + fcode-sys-table fcode-table 800 cells move + \ clear local fcodes + fcode-table 800 fff ['] undefined-fcode nreserved +; + +['] (init-fcode-table) to init-fcode-table |