[PATCH] Adds local variable support to OpenBIOS. Local variable implementation is based on Apple's local variable support in Open Firmware.
This patch has been improved from the last patch. Local variable code now is in its own file. The Array word has also been greatly simplified. Signed-off-by: John Arbuckle <programmingkidx@gmail.com> --- forth/bootstrap/interpreter.fs | 51 +++- forth/util/build.xml | 1 + forth/util/locals.fs | 531 ++++++++++++++++++++++++++++++++++++++++ 3 files changed, 569 insertions(+), 14 deletions(-) create mode 100644 forth/util/locals.fs diff --git a/forth/bootstrap/interpreter.fs b/forth/bootstrap/interpreter.fs index 5187058..9221cdc 100644 --- a/forth/bootstrap/interpreter.fs +++ b/forth/bootstrap/interpreter.fs @@ -40,26 +40,20 @@ \ 7.3.9.2.4 Miscellaneous dictionary \ -\ interpreter. This word checks whether the interpreted word -\ is a word in dictionary or a number. It honours compile mode -\ and immediate/compile-only words. -: interpret - 0 >in ! - begin - parse-word dup 0> \ was there a word at all? - while - $find +\ Most of the old version of interpret +: old-interpret ( addr len -- ) + $find if dup flags? 0<> state @ 0= or if execute else - , \ compile mode && !immediate + , \ Compile mode && !immediate then - else \ word is not known. maybe it's a number + else \ Word is not known. maybe it's a number 2dup $number if - span @ >in ! \ if we encountered an error, don't continue parsing + span @ >in ! \ If we encountered an error, don't continue parsing type 3a emit -13 throw else @@ -70,9 +64,38 @@ depth 0< if -4 throw then rdepth 200 >= if -5 throw then rdepth 0< if -6 throw then +; + + +Defer lfind-defer +false VALUE using-locals + +\ The refactored interpret - supports local variables +: interpret ( -- ) + 0 >in ! + begin + parse-word ( addr len ) + dup ( addr len len1 ) + 0> ( addr len flag ) \ Was there a word at all? + while ( addr len ) + using-locals true = IF ( addr len ) \ If local variables are being used + 2dup ( addr len addr1 len1 ) + lfind-defer ( addr len flag ) + not IF ( addr len ) \ If symbol is not a local variable + old-interpret ( ) + ELSE \ Else clean up the stack + 2drop ( ) + THEN + + ELSE \ If not using local variables + old-interpret ( addr len -- ) + THEN + repeat - 2drop - ; + 2drop \ Removes the addr len pair if the loop ends at the WHILE word +; + + : refill ( -- ) ib #ib @ expect 0 >in ! ; diff --git a/forth/util/build.xml b/forth/util/build.xml index 4839d2c..d10f35a 100644 --- a/forth/util/build.xml +++ b/forth/util/build.xml @@ -11,6 +11,7 @@ <dictionary name="openbios" target="forth"> <object source="util.fs"/> <object source="pci.fs"/> + <object source="locals.fs"/> <!-- We don't want/need these at the moment <object source="apic.fs"/> --> diff --git a/forth/util/locals.fs b/forth/util/locals.fs new file mode 100644 index 0000000..22a6f55 --- /dev/null +++ b/forth/util/locals.fs @@ -0,0 +1,531 @@ +\ File: locals.fs +\ Description: Adds local variable support to OpenBIOS. This is Apple's local variable specification. + + +\ Creates an array variable +: ARRAY ( cellCount -- ) + + \ Compile-time behavior + CREATE CELLS ALLOT ( cellCount -- ) \ Creates and initializes the instance + + \ Run-time behavior + DOES> ( index addr ) + + SWAP CELLS + ( index addr -- addr1 ) \ Calculates address to return +; + + +\ Declare the local-base-address VALUE +0 VALUE local-base-address + +\ Returns the base address used for the local words +: get-base-address ( - addr ) + local-base-address +; + +\ Sets the base address used for the local words +: set-base-address ( addr - ) + TO local-base-address +; + + +\ Sets the first local variable's value +: Local0! ( x - ) + 0 CELLS get-base-address + ! +; + +\ Sets the second local variable's value +: Local1! ( x - ) + 1 CELLS get-base-address + ! +; + +\ Sets the third local variable's value +: Local2! ( x - ) + 2 CELLS get-base-address + ! +; + +\ Sets the fourth local variable's value +: Local3! ( x - ) + 3 CELLS get-base-address + ! +; + +\ Sets the fifth local variable's value +: Local4! ( x - ) + 4 CELLS get-base-address + ! +; + +\ Sets the sixth local variable's value +: Local5! ( x - ) + 5 CELLS get-base-address + ! +; + +\ Sets the seventh local variable's value +: Local6! ( x - ) + 6 CELLS get-base-address + ! +; + +\ Sets the eighth local variable's value +: Local7! ( x - ) + 7 CELLS get-base-address + ! +; + +\ Sets the ninth local variable's value +: Local8! ( x - ) + 8 CELLS get-base-address + ! +; + +\ Sets the tenth local variable's value +: Local9! ( x - ) + 9 CELLS get-base-address + ! +; + +\ Sets the eleventh local variable's value +: Local10! ( x - ) + 10 CELLS get-base-address + ! +; + +\ Sets the twelfth local variable's value +: Local11! ( x - ) + 11 CELLS get-base-address + ! +; + + +\ **** Calculates the needed amount of memory for local variables **** +0 value variableCount +: calculate-needed-memory ( - n ) + 0 TO variableCount + >in @ \ Keep track of where the pointer was + + begin + parse-word + 0= if \ If there is no more text to parse + drop + true + else + dup " ;" comp + 0= if \ If the semicolon is encountered + drop \ Drop the duplicated address + false + else + " }" comp + 0= if \ If '}' character is encountered + true \ End loop because '}' marks end of local variables + else + variableCount 1 + TO variableCount + false + then + then + then + until + + >in ! \ Reset the pointer + variableCount CELLS +; + + +\ **** allocates the memory for local variables **** +: allocate-memory ( n - addr ) + alloc-mem dup 0= if + drop + cr cr 10 spaces abort" Failed to allocate memory for local variables!" cr cr + then +; + + + +\ Declares the size of the local variable table +48 CONSTANT #local-table-elements + +\ Declare the local variable table +#local-table-elements ARRAY local-variable-table + +\ Keeps track of end of array +0 VALUE #filled-local-table-elements + +\ Clears the local variable table +: init-local-table ( - ) + + \ Free all the dynamically allocated memory + #filled-local-table-elements 0 ?do + I 3 + local-variable-table @ ( addr ) + free-mem ( ) + 4 +loop + + 0 local-variable-table #local-table-elements erase + 0 TO #filled-local-table-elements +; + +\ Adds a local variable symbol to the local variable table +: add-local ( addr len order initflag - ) + depth 4 < if + cr ." The stack needs at least 4 values to add a local variable." cr + exit + then + + \ Add to the end of the table + #filled-local-table-elements 0 + local-variable-table ! \ initflag + #filled-local-table-elements 1 + local-variable-table ! \ order + #filled-local-table-elements 2 + local-variable-table ! \ len + #filled-local-table-elements 3 + local-variable-table ! \ addr + + \ Allocate memory for the symbol + #filled-local-table-elements 2 + local-variable-table @ ( length ) + alloc-mem ( memaddr ) + dup ( memaddr memaddr ) + dup ( memaddr memaddr memaddr ) + + \ Called only when memaddr = 0 + 0= if ( memaddr memaddr ) + cr ." Failed to allocate memory in add-local!" cr ( memaddr memaddr ) + then + + \ Copy local variable name to a safe location + #filled-local-table-elements 3 + local-variable-table @ ( memaddr memaddr addr ) + swap ( memaddr addr memaddr ) + #filled-local-table-elements 2 + local-variable-table @ ( memaddr addr memaddr length ) + move ( memaddr ) + #filled-local-table-elements 3 + local-variable-table ! ( ) + + \ Increment #filled-local-table-elements + #filled-local-table-elements 4 + TO #filled-local-table-elements +; + +\ Prints the local variable table +: print-local-table + + #filled-local-table-elements 0= if + cr ." No variables loaded" cr + exit + then + + #filled-local-table-elements 0 ?do + cr ." Variable name: " + I 3 + local-variable-table @ + I 2 + local-variable-table @ + type + + ." Order: " + I 1 + local-variable-table @ . + + ." Init Flag: " + I 0 + local-variable-table @ . + 4 +loop +; + +\ Finds a local variable symbol in the local variable table +\ Returns its order or -1 on failure +: get-order ( addr len - order ) + \ If the address and length are missing + depth 2 < if + cr ." Address and length are required on the stack to use get-order!" cr + -1 throw \ Ends execution + then + + #filled-local-table-elements 0 ?do + over ( addr len addr ) + I 3 + ( addr len addr addrindex ) + local-variable-table @ ( addr len addr addr1 ) + 2 pick ( addr len addr addr1 len ) + + \ Check if lengths of two strings are the same length + dup ( addr len addr addr1 len len ) + I 2 + local-variable-table @ ( addr len addr addr1 len len len1) + = if ( addr len addr addr1 len ) \ If lengths are equal + comp ( addr len flag) + 0= if ( addr len flag ) \ If the symbol is found + 2drop ( ) + I 1 + local-variable-table @ ( order ) + unloop + exit + then + + else \ If the lengths are different + 3drop ( addr len ) + then + + \ Increment the index by 4 + 4 +loop + 2drop ( addr len - ) + -1 \ Returns -1 for the order if the symbol is not found +; + + +\ **** read the local variables in the input stream **** +0 VALUE use-top-stack-value +0 VALUE index +0 VALUE local-variable-memory + +: read-local-variables ( "char" - ) + 0 TO index + true TO use-top-stack-value + + begin + parse-word ( addr len ) + dup ( addr len len ) + 0> ( addr len flag ) + while ( addr len ) + 2dup ( addr len addr len ) + drop ( addr len addr ) + " }" ( addr len addr addr len ) + comp ( addr len flag ) + 0= if ( addr len ) \ If end of local variables + drop ( addr ) + drop ( ) + exit ( ) + then + + 2dup ( addr len addr len ) + drop ( addr len addr ) + " ;" ( addr len addr addr len ) + comp ( addr len flag ) + 0= ( addr len flag ) + + if ( addr len ) \ If not using top stack value for local variables + false TO use-top-stack-value ( addr len ) + 2drop ( ) + else \ Add local variable to table + index use-top-stack-value ( addr len order use-top-stack-value ) + add-local ( ) + index 1 + TO index \ Increment index + then + + repeat + drop ( addr ) + drop ( ) +; + + +\ Sets the stack size +1000 CONSTANT max-stack-size + +\ Declare the local stack +max-stack-size ARRAY local-stack + +\ Declare the stack top pointer +0 VALUE local-stack-top + +\ Adds to the top of the local stack +: push-local-stack ( x - L:x ) + local-stack-top max-stack-size 1 - > + if + cr ." Local stack overflow!" cr + max-stack-size TO local-stack-top \ Sets local-stack-top back to the max size + then + local-stack-top local-stack ! ( x - ) + local-stack-top 1 + TO local-stack-top +; + + +\ Removes the top local stack value and places it into the data stack +: pop-local-stack ( L:x - x ) + local-stack-top 1 - TO local-stack-top \ Decrement local-stack-top + local-stack-top 0< if \ If popping too many items + cr ." Local stack underflow!" cr + 0 TO local-stack-top \ Sets local-stack-top back to zero + abort + then + local-stack-top local-stack @ +; + + +\ ***** sets up local variables ****** +: { ( -- ) + init-local-table + calculate-needed-memory ( memorySize ) + allocate-memory ( memorySize - addr ) + TO local-variable-memory ( ) + read-local-variables ( ) + TRUE TO using-locals + + \ Add code to the current definition + + \ Saves the old base address + postpone get-base-address + postpone push-local-stack + + \ Sets the base address to this definition's reserved memory + local-variable-memory + postpone literal + postpone set-base-address + + \ Add code to initialize the variables if needed + 0 #filled-local-table-elements 4 - ?do + I 0 + local-variable-table @ ( flag ) \ Get the init flag + true ( flag true ) + = ( flag1 ) + if + I 4 / ( variable number ) + case + 0 of ['] Local0! , endof + 1 of ['] Local1! , endof + 2 of ['] Local2! , endof + 3 of ['] Local3! , endof + 4 of ['] Local4! , endof + 5 of ['] Local5! , endof + 6 of ['] Local6! , endof + 7 of ['] Local7! , endof + 8 of ['] Local8! , endof + 9 of ['] Local9! , endof + 10 of ['] Local10! , endof + 11 of ['] Local11! , endof + + cr ." Can't save to local variable! " cr + exit + + endcase + then + -4 +loop + +; immediate \ Declares this word as a compiler directive + + + +\ Sets values for local variables +: -> ( - ) + parse-word ( addr len ) + get-order ( order ) + dup ( order order ) + -1 = ( order flag ) + + if \ If the symbol isn't found + cr ." Symbol is not a local variable! " cr + drop ( ) + exit + then + + case + 0 of ['] Local0! , endof + 1 of ['] Local1! , endof + 2 of ['] Local2! , endof + 3 of ['] Local3! , endof + 4 of ['] Local4! , endof + 5 of ['] Local5! , endof + 6 of ['] Local6! , endof + 7 of ['] Local7! , endof + 8 of ['] Local8! , endof + 9 of ['] Local9! , endof + 10 of ['] Local10! , endof + 11 of ['] Local11! , endof + + cr ." Can't save to local variable! " cr + exit + + endcase + +; immediate + + +\ Returns the first local variable's value +: Local0@ + 0 CELLS get-base-address + @ +; + +\ Returns the second local variable's value +: Local1@ + 1 CELLS get-base-address + @ +; + +\ Returns the third local variable's value +: Local2@ + 2 CELLS get-base-address + @ +; + +\ Returns the fourth local variable's value +: Local3@ + 3 CELLS get-base-address + @ +; + +\ Returns the fifth local variable's value +: Local4@ + 4 CELLS get-base-address + @ +; + +\ Returns the sixth local variable's value +: Local5@ + 5 CELLS get-base-address + @ +; + +\ Returns the seventh local variable's value +: Local6@ + 6 CELLS get-base-address + @ +; + +\ Returns the eighth local variable's value +: Local7@ + 7 CELLS get-base-address + @ +; + +\ Returns the ninth local variable's value +: Local8@ + 8 CELLS get-base-address + @ +; + +\ Returns the tenth local variable's value +: Local9@ + 9 CELLS get-base-address + @ +; + +\ Returns the eleventh local variable's value +: Local10@ + 10 CELLS get-base-address + @ +; + +\ Returns the twelfth local variable's value +: Local11@ + 11 CELLS get-base-address + @ +; + + +\ Determines if a symbol is a local variable +\ Returns true if the symbol is a local variable, false otherwise +: LFIND ( addr len - flag ) + depth 2 < if \ If the address and length are not on the stack + exit + then + + get-order ( addr len - n ) + dup ( n n1 ) + -1 = if ( n ) \ If the symbol isn't a local variable + drop ( ) + false ( flag ) + + else \ If the symbol is a local variable + case ( n ) + 0 of ['] Local0@ , endof + 1 of ['] Local1@ , endof + 2 of ['] Local2@ , endof + 3 of ['] Local3@ , endof + 4 of ['] Local4@ , endof + 5 of ['] Local5@ , endof + 6 of ['] Local6@ , endof + 7 of ['] Local7@ , endof + 8 of ['] Local8@ , endof + 9 of ['] Local9@ , endof + 10 of ['] Local10@ , endof + 11 of ['] Local11@ , endof + + \ Default case + cr ." Could not compile local variable!" cr + TRUE ( flag ) + exit + + endcase + + ." compiled " \ Display this text when entering a local variable symbol + true ( flag ) + then +; + + +\ Redefine colon to clean up after { +: ; + using-locals TRUE = + if + FALSE TO using-locals + postpone pop-local-stack + postpone set-base-address + then + postpone ; +; immediate + +' lfind is lfind-defer \ Makes lfind work in INTERPRET \ No newline at end of file -- 1.7.5.4
On 16/09/12 22:12, Programmingkid wrote: Hi John, Apologies for the delay, but here are my notes from spending some time looking at this patch.
This patch has been improved from the last patch. Local variable code now is in its own file. The Array word has also been greatly simplified.
Signed-off-by: John Arbuckle<programmingkidx@gmail.com>
--- forth/bootstrap/interpreter.fs | 51 +++- forth/util/build.xml | 1 + forth/util/locals.fs | 531 ++++++++++++++++++++++++++++++++++++++++ 3 files changed, 569 insertions(+), 14 deletions(-) create mode 100644 forth/util/locals.fs
diff --git a/forth/bootstrap/interpreter.fs b/forth/bootstrap/interpreter.fs index 5187058..9221cdc 100644 --- a/forth/bootstrap/interpreter.fs +++ b/forth/bootstrap/interpreter.fs @@ -40,26 +40,20 @@ \ 7.3.9.2.4 Miscellaneous dictionary \
-\ interpreter. This word checks whether the interpreted word -\ is a word in dictionary or a number. It honours compile mode -\ and immediate/compile-only words.
-: interpret - 0>in ! - begin - parse-word dup 0> \ was there a word at all? - while - $find +\ Most of the old version of interpret +: old-interpret ( addr len -- ) + $find if dup flags? 0<> state @ 0= or if execute else - , \ compile mode&& !immediate + , \ Compile mode&& !immediate then - else \ word is not known. maybe it's a number + else \ Word is not known. maybe it's a number 2dup $number if - span @>in ! \ if we encountered an error, don't continue parsing + span @>in ! \ If we encountered an error, don't continue parsing type 3a emit -13 throw else @@ -70,9 +64,38 @@ depth 0< if -4 throw then rdepth 200>= if -5 throw then rdepth 0< if -6 throw then
This section of the patch makes cosmetic changes, as well as functional changes, which makes following the diff more difficult. If you want to change layout, please do this as a separate patch/commit.
+; + + +Defer lfind-defer +false VALUE using-locals + +\ The refactored interpret - supports local variables +: interpret ( -- ) + 0>in ! + begin + parse-word ( addr len ) + dup ( addr len len1 ) + 0> ( addr len flag ) \ Was there a word at all? + while ( addr len ) + using-locals true = IF ( addr len ) \ If local variables are being used + 2dup ( addr len addr1 len1 ) + lfind-defer ( addr len flag ) + not IF ( addr len ) \ If symbol is not a local variable + old-interpret ( ) + ELSE \ Else clean up the stack + 2drop ( ) + THEN + + ELSE \ If not using local variables + old-interpret ( addr len -- ) + THEN + repeat - 2drop - ; + 2drop \ Removes the addr len pair if the loop ends at the WHILE word +; + +
I really dislike that you've had to make changes to interpret here - should it not be possible to get the { and } words to lookups in a separate dictionary rather than having to hack the main interpret word?
: refill ( -- ) ib #ib @ expect 0>in ! ; diff --git a/forth/util/build.xml b/forth/util/build.xml index 4839d2c..d10f35a 100644 --- a/forth/util/build.xml +++ b/forth/util/build.xml @@ -11,6 +11,7 @@ <dictionary name="openbios" target="forth"> <object source="util.fs"/> <object source="pci.fs"/> +<object source="locals.fs"/> <!-- We don't want/need these at the moment <object source="apic.fs"/> --> diff --git a/forth/util/locals.fs b/forth/util/locals.fs new file mode 100644 index 0000000..22a6f55 --- /dev/null +++ b/forth/util/locals.fs @@ -0,0 +1,531 @@ +\ File: locals.fs +\ Description: Adds local variable support to OpenBIOS. This is Apple's local variable specification. + + +\ Creates an array variable +: ARRAY ( cellCount -- ) + + \ Compile-time behavior + CREATE CELLS ALLOT ( cellCount -- ) \ Creates and initializes the instance + + \ Run-time behavior + DOES> ( index addr ) + + SWAP CELLS + ( index addr -- addr1 ) \ Calculates address to return +;
Another stylistic point - OpenBIOS tends to use lower case rather than upper for expressing words, so I'd recommend changing these to lower case.
+ +\ Declare the local-base-address VALUE +0 VALUE local-base-address + +\ Returns the base address used for the local words +: get-base-address ( - addr ) + local-base-address +; + +\ Sets the base address used for the local words +: set-base-address ( addr - ) + TO local-base-address +; + + +\ Sets the first local variable's value +: Local0! ( x - ) + 0 CELLS get-base-address + ! +; + +\ Sets the second local variable's value +: Local1! ( x - ) + 1 CELLS get-base-address + ! +; + +\ Sets the third local variable's value +: Local2! ( x - ) + 2 CELLS get-base-address + ! +; + +\ Sets the fourth local variable's value +: Local3! ( x - ) + 3 CELLS get-base-address + ! +; + +\ Sets the fifth local variable's value +: Local4! ( x - ) + 4 CELLS get-base-address + ! +; + +\ Sets the sixth local variable's value +: Local5! ( x - ) + 5 CELLS get-base-address + ! +; + +\ Sets the seventh local variable's value +: Local6! ( x - ) + 6 CELLS get-base-address + ! +; + +\ Sets the eighth local variable's value +: Local7! ( x - ) + 7 CELLS get-base-address + ! +; + +\ Sets the ninth local variable's value +: Local8! ( x - ) + 8 CELLS get-base-address + ! +; + +\ Sets the tenth local variable's value +: Local9! ( x - ) + 9 CELLS get-base-address + ! +; + +\ Sets the eleventh local variable's value +: Local10! ( x - ) + 10 CELLS get-base-address + ! +; + +\ Sets the twelfth local variable's value +: Local11! ( x - ) + 11 CELLS get-base-address + ! +;
Eeek. Is there not a better way of getting this information from a linked list/struct? Words to manage both of these are already in OpenBIOS.
+ + +\ **** Calculates the needed amount of memory for local variables **** +0 value variableCount +: calculate-needed-memory ( - n ) + 0 TO variableCount + >in @ \ Keep track of where the pointer was + + begin + parse-word + 0= if \ If there is no more text to parse + drop + true + else + dup " ;" comp
It seems that some implementations of local variables use | as well as ; to mark the end of stack words - could you do the same here?
+ 0= if \ If the semicolon is encountered + drop \ Drop the duplicated address + false + else + " }" comp
I'm not sure this should be a string check - should not the compile time execution of the } word be able to handle this?
+ 0= if \ If '}' character is encountered + true \ End loop because '}' marks end of local variables + else + variableCount 1 + TO variableCount + false + then + then + then + until + + >in ! \ Reset the pointer + variableCount CELLS +; + + +\ **** allocates the memory for local variables **** +: allocate-memory ( n - addr ) + alloc-mem dup 0= if + drop + cr cr 10 spaces abort" Failed to allocate memory for local variables!" cr cr + then +; + + + +\ Declares the size of the local variable table +48 CONSTANT #local-table-elements + +\ Declare the local variable table +#local-table-elements ARRAY local-variable-table + +\ Keeps track of end of array +0 VALUE #filled-local-table-elements + +\ Clears the local variable table +: init-local-table ( - ) + + \ Free all the dynamically allocated memory + #filled-local-table-elements 0 ?do + I 3 + local-variable-table @ ( addr ) + free-mem ( ) + 4 +loop + + 0 local-variable-table #local-table-elements erase + 0 TO #filled-local-table-elements +; + +\ Adds a local variable symbol to the local variable table +: add-local ( addr len order initflag - ) + depth 4< if + cr ." The stack needs at least 4 values to add a local variable." cr + exit + then + + \ Add to the end of the table + #filled-local-table-elements 0 + local-variable-table ! \ initflag + #filled-local-table-elements 1 + local-variable-table ! \ order + #filled-local-table-elements 2 + local-variable-table ! \ len + #filled-local-table-elements 3 + local-variable-table ! \ addr + + \ Allocate memory for the symbol + #filled-local-table-elements 2 + local-variable-table @ ( length ) + alloc-mem ( memaddr ) + dup ( memaddr memaddr ) + dup ( memaddr memaddr memaddr ) + + \ Called only when memaddr = 0 + 0= if ( memaddr memaddr ) + cr ." Failed to allocate memory in add-local!" cr ( memaddr memaddr ) + then + + \ Copy local variable name to a safe location + #filled-local-table-elements 3 + local-variable-table @ ( memaddr memaddr addr ) + swap ( memaddr addr memaddr ) + #filled-local-table-elements 2 + local-variable-table @ ( memaddr addr memaddr length ) + move ( memaddr ) + #filled-local-table-elements 3 + local-variable-table ! ( ) + + \ Increment #filled-local-table-elements + #filled-local-table-elements 4 + TO #filled-local-table-elements +; + +\ Prints the local variable table +: print-local-table + + #filled-local-table-elements 0= if + cr ." No variables loaded" cr + exit + then + + #filled-local-table-elements 0 ?do + cr ." Variable name: " + I 3 + local-variable-table @ + I 2 + local-variable-table @ + type + + ." Order: " + I 1 + local-variable-table @ . + + ." Init Flag: " + I 0 + local-variable-table @ . + 4 +loop +; + +\ Finds a local variable symbol in the local variable table +\ Returns its order or -1 on failure +: get-order ( addr len - order ) + \ If the address and length are missing + depth 2< if + cr ." Address and length are required on the stack to use get-order!" cr + -1 throw \ Ends execution + then + + #filled-local-table-elements 0 ?do + over ( addr len addr ) + I 3 + ( addr len addr addrindex ) + local-variable-table @ ( addr len addr addr1 ) + 2 pick ( addr len addr addr1 len ) + + \ Check if lengths of two strings are the same length + dup ( addr len addr addr1 len len ) + I 2 + local-variable-table @ ( addr len addr addr1 len len len1) + = if ( addr len addr addr1 len ) \ If lengths are equal + comp ( addr len flag) + 0= if ( addr len flag ) \ If the symbol is found + 2drop ( ) + I 1 + local-variable-table @ ( order ) + unloop + exit + then + + else \ If the lengths are different + 3drop ( addr len ) + then + + \ Increment the index by 4 + 4 +loop + 2drop ( addr len - ) + -1 \ Returns -1 for the order if the symbol is not found +; + + +\ **** read the local variables in the input stream **** +0 VALUE use-top-stack-value +0 VALUE index +0 VALUE local-variable-memory + +: read-local-variables ( "char" - ) + 0 TO index + true TO use-top-stack-value + + begin + parse-word ( addr len ) + dup ( addr len len ) + 0> ( addr len flag ) + while ( addr len ) + 2dup ( addr len addr len ) + drop ( addr len addr ) + " }" ( addr len addr addr len ) + comp ( addr len flag ) + 0= if ( addr len ) \ If end of local variables + drop ( addr ) + drop ( ) + exit ( ) + then + + 2dup ( addr len addr len ) + drop ( addr len addr ) + " ;" ( addr len addr addr len ) + comp ( addr len flag ) + 0= ( addr len flag ) + + if ( addr len ) \ If not using top stack value for local variables + false TO use-top-stack-value ( addr len ) + 2drop ( ) + else \ Add local variable to table + index use-top-stack-value ( addr len order use-top-stack-value ) + add-local ( ) + index 1 + TO index \ Increment index + then + + repeat + drop ( addr ) + drop ( ) +; + + +\ Sets the stack size +1000 CONSTANT max-stack-size + +\ Declare the local stack +max-stack-size ARRAY local-stack + +\ Declare the stack top pointer +0 VALUE local-stack-top + +\ Adds to the top of the local stack +: push-local-stack ( x - L:x ) + local-stack-top max-stack-size 1 -> + if + cr ." Local stack overflow!" cr + max-stack-size TO local-stack-top \ Sets local-stack-top back to the max size + then + local-stack-top local-stack ! ( x - ) + local-stack-top 1 + TO local-stack-top +; + + +\ Removes the top local stack value and places it into the data stack +: pop-local-stack ( L:x - x ) + local-stack-top 1 - TO local-stack-top \ Decrement local-stack-top + local-stack-top 0< if \ If popping too many items + cr ." Local stack underflow!" cr + 0 TO local-stack-top \ Sets local-stack-top back to zero + abort + then + local-stack-top local-stack @ +; + + +\ ***** sets up local variables ****** +: { ( -- ) + init-local-table + calculate-needed-memory ( memorySize ) + allocate-memory ( memorySize - addr ) + TO local-variable-memory ( ) + read-local-variables ( ) + TRUE TO using-locals + + \ Add code to the current definition + + \ Saves the old base address + postpone get-base-address + postpone push-local-stack + + \ Sets the base address to this definition's reserved memory + local-variable-memory + postpone literal + postpone set-base-address + + \ Add code to initialize the variables if needed + 0 #filled-local-table-elements 4 - ?do + I 0 + local-variable-table @ ( flag ) \ Get the init flag + true ( flag true ) + = ( flag1 ) + if + I 4 / ( variable number ) + case + 0 of ['] Local0! , endof + 1 of ['] Local1! , endof + 2 of ['] Local2! , endof + 3 of ['] Local3! , endof + 4 of ['] Local4! , endof + 5 of ['] Local5! , endof + 6 of ['] Local6! , endof + 7 of ['] Local7! , endof + 8 of ['] Local8! , endof + 9 of ['] Local9! , endof + 10 of ['] Local10! , endof + 11 of ['] Local11! , endof + + cr ." Can't save to local variable! " cr + exit + + endcase + then + -4 +loop + +; immediate \ Declares this word as a compiler directive + + + +\ Sets values for local variables +: -> ( - ) + parse-word ( addr len ) + get-order ( order ) + dup ( order order ) + -1 = ( order flag ) + + if \ If the symbol isn't found + cr ." Symbol is not a local variable! " cr + drop ( ) + exit + then + + case + 0 of ['] Local0! , endof + 1 of ['] Local1! , endof + 2 of ['] Local2! , endof + 3 of ['] Local3! , endof + 4 of ['] Local4! , endof + 5 of ['] Local5! , endof + 6 of ['] Local6! , endof + 7 of ['] Local7! , endof + 8 of ['] Local8! , endof + 9 of ['] Local9! , endof + 10 of ['] Local10! , endof + 11 of ['] Local11! , endof + + cr ." Can't save to local variable! " cr + exit + + endcase + +; immediate + + +\ Returns the first local variable's value +: Local0@ + 0 CELLS get-base-address + @ +; + +\ Returns the second local variable's value +: Local1@ + 1 CELLS get-base-address + @ +; + +\ Returns the third local variable's value +: Local2@ + 2 CELLS get-base-address + @ +; + +\ Returns the fourth local variable's value +: Local3@ + 3 CELLS get-base-address + @ +; + +\ Returns the fifth local variable's value +: Local4@ + 4 CELLS get-base-address + @ +; + +\ Returns the sixth local variable's value +: Local5@ + 5 CELLS get-base-address + @ +; + +\ Returns the seventh local variable's value +: Local6@ + 6 CELLS get-base-address + @ +; + +\ Returns the eighth local variable's value +: Local7@ + 7 CELLS get-base-address + @ +; + +\ Returns the ninth local variable's value +: Local8@ + 8 CELLS get-base-address + @ +; + +\ Returns the tenth local variable's value +: Local9@ + 9 CELLS get-base-address + @ +; + +\ Returns the eleventh local variable's value +: Local10@ + 10 CELLS get-base-address + @ +; + +\ Returns the twelfth local variable's value +: Local11@ + 11 CELLS get-base-address + @ +;
Eeek again. Is there really no way of getting the nth variable directly from a struct rather than having to duplicate this code 11 times? Also: where are the LocalX@ words defined? Are they part of the Apple local variables spec?
+ +\ Determines if a symbol is a local variable +\ Returns true if the symbol is a local variable, false otherwise +: LFIND ( addr len - flag ) + depth 2< if \ If the address and length are not on the stack + exit + then + + get-order ( addr len - n ) + dup ( n n1 ) + -1 = if ( n ) \ If the symbol isn't a local variable + drop ( ) + false ( flag ) + + else \ If the symbol is a local variable + case ( n ) + 0 of ['] Local0@ , endof + 1 of ['] Local1@ , endof + 2 of ['] Local2@ , endof + 3 of ['] Local3@ , endof + 4 of ['] Local4@ , endof + 5 of ['] Local5@ , endof + 6 of ['] Local6@ , endof + 7 of ['] Local7@ , endof + 8 of ['] Local8@ , endof + 9 of ['] Local9@ , endof + 10 of ['] Local10@ , endof + 11 of ['] Local11@ , endof + + \ Default case + cr ." Could not compile local variable!" cr + TRUE ( flag ) + exit + + endcase + + ." compiled " \ Display this text when entering a local variable symbol + true ( flag ) + then +; + + +\ Redefine colon to clean up after { +: ; + using-locals TRUE = + if + FALSE TO using-locals + postpone pop-local-stack + postpone set-base-address + then + postpone ; +; immediate + +' lfind is lfind-defer \ Makes lfind work in INTERPRET \ No newline at end of file
I think that this is definitely an improvement on your first patch. However, I think it still needs some work before it is ready for commit. Things I think need to be looked at are: - Styling Make sure words are in lower case to match the rest of OpenBIOS. - Changes to the interpret word I really think it should be possible to add local variable support without having to change the interpret word - LocalX@ words As mentioned above, I think it must be possible to get this information from a struct rather than having to duplicate the words. Having a look through bootstrap.fs, there are already many useful words that could be use to maintain your own dictionaries without having to reinvent your own storage above. In fact, it seems that if you were to use these existing functions you could eliminate a large proportion of your patch. I would suggest for a next iteration that you make use of these existing words and existing dictionaries, and you should find as a side-effect your patch size goes down considerably and you should be able to get by without altering interpret. ATB, Mark.
participants (2)
-
Mark Cave-Ayland -
Programmingkid