| \ 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 |