Author: mcayland Date: Fri Nov 23 15:44:23 2012 New Revision: 1068 URL: http://tracker.coreboot.org/trac/openbios/changeset/1068
Log: Implementation of Forth local variables for OpenBIOS.
Some bootloaders, particularly OS X, execute Forth strings that make use of Forth local variables. This patch provides an implementation that allows OpenBIOS to execute such code.
A couple of examples are included below:
: diff.squares { A B -- A*A-B*B } A A * B B * - ;
: myword { ; cat dog } 4 -> cat 5 -> dog
cat \ cat's value pushed onto stack ( - cat) dog \ dog's value pushed onto stack (cat - cat dog ) +
cr ." Total animals = " . cr ;
Since the Forth locals stack and temporary dictionary take up extra space, the locals implementation is protected by a new CONFIG_LOCALS build variable.
Signed-off-by: Mark Cave-Ayland mark.cave-ayland@ilande.co.uk
Added: trunk/openbios-devel/forth/lib/locals.fs Modified: trunk/openbios-devel/forth/bootstrap/bootstrap.fs trunk/openbios-devel/forth/lib/build.xml
Modified: trunk/openbios-devel/forth/bootstrap/bootstrap.fs ============================================================================== --- trunk/openbios-devel/forth/bootstrap/bootstrap.fs Sun Oct 21 20:14:06 2012 (r1067) +++ trunk/openbios-devel/forth/bootstrap/bootstrap.fs Fri Nov 23 15:44:23 2012 (r1068) @@ -49,6 +49,10 @@ defer context 0 value vocabularies?
+defer locals-end +0 value locals-dict +variable locals-dict-buf + \ \ 7.3.7 Flag constants \ @@ -925,6 +929,11 @@ ;
: $find ( name-str name-len -- xt true | name-str name-len false ) + locals-dict 0<> if + locals-dict-buf @ find-wordlist ?dup if + exit + then + then vocabularies? if #order @ 0 ?do i cells context + @ @@ -1426,6 +1435,10 @@ ;
: ; + locals-dict 0<> if + 0 ['] locals-dict /n + ! + ['] locals-end , + then ['] (semis) , reveal ['] [ execute ; immediate
Modified: trunk/openbios-devel/forth/lib/build.xml ============================================================================== --- trunk/openbios-devel/forth/lib/build.xml Sun Oct 21 20:14:06 2012 (r1067) +++ trunk/openbios-devel/forth/lib/build.xml Fri Nov 23 15:44:23 2012 (r1068) @@ -16,6 +16,7 @@ <object source="split.fs"/> <object source="lists.fs"/> <object source="64bit.fs"/> + <object source="locals.fs"/> </dictionary>
</build>
Added: trunk/openbios-devel/forth/lib/locals.fs ============================================================================== --- /dev/null 00:00:00 1970 (empty, because file is newly added) +++ trunk/openbios-devel/forth/lib/locals.fs Fri Nov 23 15:44:23 2012 (r1068) @@ -0,0 +1,197 @@ +\ 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]
-
repository service