diff options
Diffstat (limited to 'qemu/roms/openbios/forth/lib/locals.fs')
| -rw-r--r-- | qemu/roms/openbios/forth/lib/locals.fs | 197 |
1 files changed, 0 insertions, 197 deletions
diff --git a/qemu/roms/openbios/forth/lib/locals.fs b/qemu/roms/openbios/forth/lib/locals.fs deleted file mode 100644 index e697383b6..000000000 --- a/qemu/roms/openbios/forth/lib/locals.fs +++ /dev/null @@ -1,197 +0,0 @@ -\ tag: local variables -\ -\ Copyright (C) 2012 Mark Cave-Ayland -\ -\ See the file "COPYING" for further information about -\ the copyright and warranty status of this work. -\ - -[IFDEF] CONFIG_LOCALS - -\ Init local variable stack -variable locals-var-stack -here 200 cells allot locals-var-stack ! - -\ Set initial stack pointer -\ -\ Stack looks like this: -\ ... (sp n-2) local1 ... localm-1 localm (sp n-1) <-- sp - -locals-var-stack @ value locals-var-sp -locals-var-sp locals-var-stack @ ! - -0 value locals-var-count -0 value locals-flags - -here 200 cells allot locals-dict-buf ! - -8 constant #locals - -: (local1) locals-var-sp @ /n + ; -: (local2) locals-var-sp @ 2 cells + ; -: (local3) locals-var-sp @ 3 cells + ; -: (local4) locals-var-sp @ 4 cells + ; -: (local5) locals-var-sp @ 5 cells + ; -: (local6) locals-var-sp @ 6 cells + ; -: (local7) locals-var-sp @ 7 cells + ; -: (local8) locals-var-sp @ 8 cells + ; - -: local1@ (local1) @ ; -: local2@ (local2) @ ; -: local3@ (local3) @ ; -: local4@ (local4) @ ; -: local5@ (local5) @ ; -: local6@ (local6) @ ; -: local7@ (local7) @ ; -: local8@ (local8) @ ; - -: local1! (local1) ! ; -: local2! (local2) ! ; -: local3! (local3) ! ; -: local4! (local4) ! ; -: local5! (local5) ! ; -: local6! (local6) ! ; -: local7! (local7) ! ; -: local8! (local8) ! ; - -create locals-read-table -['] local1@ , -['] local2@ , -['] local3@ , -['] local4@ , -['] local5@ , -['] local6@ , -['] local7@ , -['] local8@ , - -create locals-write-table -['] local1! , -['] local2! , -['] local3! , -['] local4! , -['] local5! , -['] local6! , -['] local7! , -['] local8! , - - -: locals-push ( n -- ) - locals-var-sp /n + to locals-var-sp - locals-var-sp ! -; - -: locals-0-push ( -- ) - 0 locals-push -; - -: (apply-local-flags) ( lfa -- ) - 1 - dup c@ locals-flags or swap c! -; - -: locals-no-pop? ( lfa -- ? ) - 1 - c@ 8 and 0<> -; - -: locals-drop \ Destroy current stack frame - locals-var-sp @ to locals-var-sp -; - -['] locals-drop to locals-end - -: (local-init) ( str len -- ) - header 1 , \ DOCOL - ['] (lit) , ['] noop , \ read-xt - ['] (lit) , ['] noop , \ write-xt - ['] 2drop , \ do nothing - ['] (lit) , - here 5 cells - , - ['] @ , ['] , , \ store read-xt - ['] (semis) , - reveal - immediate - last @ (apply-local-flags) -; - -: (local-noop) ( str len -- ) - 2drop -; - -\ Word called when consuming a local variable -defer (local) - -: } ( C: current latest here -- ) - here! latest ! current ! \ Switch back to normal dict - locals-dict-buf @ to locals-dict \ Make locals-dict visible to $find - 0 to locals-var-count - ['] locals-var-sp , \ save previous sp on rstack - ['] >r , - locals-dict @ \ ( last -- ) - begin - ?dup 0<> - while - >r - locals-var-count /n * - locals-read-table + @ r@ 3 cells + ! \ set read-xt - locals-var-count /n * - locals-write-table + @ r@ 5 cells + ! \ set write-xt - locals-var-count 1+ to locals-var-count - r@ locals-no-pop? if - ['] locals-0-push , \ initialise with 0 - else - ['] locals-push , \ initialise from stack - then - r> @ \ next lfa - repeat - ['] r> , - ['] locals-push , \ write previous sp -; immediate - -: { ( C: -- current latest here ) - current @ latest @ here - ['] (local-init) to (local) - 0 to locals-flags - 0 to locals-var-count - locals-dict-buf @ 200 cells 0 fill \ Zero out temporary dictionary - locals-dict-buf @ current ! \ Switch to locals dictionary - locals-dict-buf @ /n + here! - - begin - parse-word - 2dup s" }" strcmp 0= if - 2drop - ['] } execute -1 - else - 2dup s" ;" strcmp 0= if - 2drop - 8 to locals-flags 0 \ Don't init from stack - else - 2dup s" |" strcmp 0= if - 2drop - 8 to locals-flags 0 \ Don't init from stack - else - 2dup s" --" strcmp 0= if - 2drop - ['] (local-noop) to (local) 0 - else - locals-var-count #locals < if - (local) 0 \ accept local - else - s" maximum locals used ignoring " type type cr 0 - then - locals-var-count 1+ to locals-var-count - then - then - then - then - until -; immediate - -: -> ( n -- ) - parse-word $find if - 4 cells + @ , - else - s" unable to find word " type type - then -; immediate - -[THEN] |