The following code is for the use of local variables in OpenBIOS. I was able to successfully make a word that used local variables. The work isn't complete. There is still work to be done with the INTERPRET word. The LFIND word has be implemented in the INTERPRET word for local variables to be recognized during the compile state. I just need a C-like CONTINUE word to go back to the start of a loop to fix all my problems with INTERPRET. Maybe someone knows a better way of adding LFIND to INTERPRET.
I would appreciate any comments, suggestions, or advice for the following code.
\ Creates an array variable
: ARRAY ( cellCount - )
DEPTH 0= IF
CR ." Please specify an array size." CR
EXIT
THEN
\ Compile-time behavior
CREATE CELL * ALLOT \ creates and initializes the instance
DOES>
\ Run-time behavior
DEPTH 2 < IF
CR ." Please specify an index number." CR
drop \ removes the address of the array instance
-1 throw \ stop normal execution after error
THEN
SWAP CELL * + \ Calculates address to return
; immediate
\ Declare the local-base-address VALUE
0 VALUE local-base-address
\ returns the base address used for the local words
: getBaseAddress ( - addr )
local-base-address
;
\ sets the base address used for the local words
: setBaseAddress ( addr - )
TO local-base-address
;
\ Sets the first local variable's value
: Local0! ( x - )
0 CELL * getBaseAddress + !
;
\ Sets the second local variable's value
: Local1! ( x - )
1 CELL * getBaseAddress + !
;
\ Sets the third local variable's value
: Local2! ( x - )
2 CELL * getBaseAddress + !
;
\ Sets the fourth local variable's value
: Local3! ( x - )
3 CELL * getBaseAddress + !
;
\ Sets the fifth local variable's value
: Local4! ( x - )
4 CELL * getBaseAddress + !
;
\ Sets the sixth local variable's value
: Local5! ( x - )
5 CELL * getBaseAddress + !
;
\ Sets the seventh local variable's value
: Local6! ( x - )
6 CELL * getBaseAddress + !
;
\ Sets the eighth local variable's value
: Local7! ( x - )
7 CELL * getBaseAddress + !
;
\ Sets the ninth local variable's value
: Local8! ( x - )
8 CELL * getBaseAddress + !
;
\ Sets the tenth local variable's value
: Local9! ( x - )
9 CELL * getBaseAddress + !
;
\ Sets the eleventh local variable's value
: Local10! ( x - )
10 CELL * getBaseAddress + !
;
\ Sets the twelfth local variable's value
: Local11! ( x - )
11 CELL * getBaseAddress + !
;
\ **** Calculates the needed amount of memory for local variables ****
0 value variableCount
: calculateNeededMemory ( "char" - 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 CELL *
;
\ **** allocates the memory for local variables ****
: allocateMemory ( 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 localTableSize
\ Declare the local variable table
localTableSize ARRAY localVariableTable
\ Keeps track of end of array
0 VALUE arrayCount
\ gets the number of records in the local variable table
: getLocalRecordCount
arrayCount 4 /
;
\ Clears the local variable table
: initLocalTable ( - )
\ free all the dynamically allocated memory
arrayCount 0 ?do
I 3 + localVariableTable @ ( addr )
free-mem ( )
4 +loop
0 localVariableTable localTableSize erase
0 TO arrayCount
;
\ Adds a local variable symbol to the local variable table
: addLocal ( 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 table
arrayCount 0 + localVariableTable ! \ initflag
arrayCount 1 + localVariableTable ! \ order
arrayCount 2 + localVariableTable ! \ len
arrayCount 3 + localVariableTable ! \ addr
\ allocate memory for the symbol
arrayCount 2 + localVariableTable @ ( length )
alloc-mem ( memaddr )
dup ( memaddr memaddr )
dup ( memaddr memaddr memaddr )
\ called only when memaddr = 0
0= ( memaddr memaddr flag )
if
cr ." Failed to allocate memory in addLocal!" cr ( memaddr memaddr )
then
\ copy local variable name to a safe location
arrayCount 3 + localVariableTable @ ( memaddr memaddr addr )
swap ( memaddr addr memaddr )
arrayCount 2 + localVariableTable @ ( memaddr addr memaddr length )
move ( memaddr )
arrayCount 3 + localVariableTable ! ( )
\ increment arrayCount
arrayCount 4 + TO arrayCount
;
\ prints the local variable table
: printLocalTable
arrayCount 0= if
cr ." No variables loaded" cr
exit
then
arrayCount 0 ?do
cr ." Variable name: "
I 3 + localVariableTable @
I 2 + localVariableTable @
type
." Order: "
I 1 + localVariableTable @ .
." Init Flag: "
I 0 + localVariableTable @ .
4
+loop
;
\ Finds a local variable symbol in the local variable table
\ Returns its order or -1 on failure
: getOrder ( addr len - order )
\ if the address and length are missing
depth 2 < if
cr ." Address and length are required on the stack to use getOrder!" cr
-1 throw \ ends execution
then
arrayCount 0 ?do
over ( addr len addr )
I 3 + ( addr len addr addrindex )
localVariableTable @ ( addr len addr addr1 )
2 pick ( addr len addr addr1 len )
comp ( addr len n )
0= ( addr len flag )
if \ if the symbol is found
2drop ( addr len - )
I 1 + localVariableTable @
unloop
exit
then
4 \ increment the index by 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 useTopStackValue
0 VALUE index
0 VALUE localVariableMemory
: readLocalVariables ( "char" - )
0 TO index
true TO useTopStackValue
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= ( addr len flag )
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 useTopStackValue ( addr len )
else \ add local variable to table
index useTopStackValue ( addr len order useTopStackValue )
addLocal ( )
index 1 + TO index \ increment index
then
repeat
drop ( addr )
drop ( )
;
\ FALSE VALUE usingLocals \ not needed because it is in the interpreter.fs file
\ declare the local stack
1000 ARRAY localStack
\ declare the stack top pointer
0 VALUE localStackTop
\ Adds to the top of the local stack
: pushLocalStack ( x - L:x )
localStackTop localStack ! ( x - )
localStackTop 1 + TO localStackTop
;
\ Removes the top local stack value and places it into the data stack
: popLocalStack ( L:x - x )
localStackTop localStack @
localStackTop 1 - TO localStackTop
;
12 CONSTANT localVariableLimit
\ ***** sets up local variables ******
: { ( "char" - )
initLocalTable
\ localVariableLimit CELL * ( memorySize )
calculateNeededMemory ( memorySize )
allocateMemory ( memorySize - addr )
TO localVariableMemory ( )
readLocalVariables ( )
TRUE TO usingLocals
\ add code to the current definition
\ saves the old base address
postpone getBaseAddress
postpone pushLocalStack
\ sets the base address to this definition's reserved memory
localVariableMemory
postpone literal
postpone setBaseAddress
\ add code to initialize the variables if needed
arrayCount 0 ?do
I 0 + localVariableTable @ ( 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 )
getOrder ( 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@
CELL 0 * getBaseAddress + @
;
\ returns the second local variable's value
: Local1@
CELL 1 * getBaseAddress + @
;
\ returns the third local variable's value
: Local2@
CELL 2 * getBaseAddress + @
;
\ returns the fourth local variable's value
: Local3@
CELL 3 * getBaseAddress + @
;
\ returns the fifth local variable's value
: Local4@
CELL 4 * getBaseAddress + @
;
\ returns the sixth local variable's value
: Local5@
CELL 5 * getBaseAddress + @
;
\ returns the seventh local variable's value
: Local6@
CELL 6 * getBaseAddress + @
;
\ returns the eighth local variable's value
: Local7@
CELL 7 * getBaseAddress + @
;
\ returns the ninth local variable's value
: Local8@
CELL 8 * getBaseAddress + @
;
\ returns the tenth local variable's value
: Local9@
CELL 9 * getBaseAddress + @
;
\ returns the eleventh local variable's value
: Local10@
CELL 10 * getBaseAddress + @
;
\ returns the twelfth local variable's value
: Local11@
CELL 11 * getBaseAddress + @
;
\ determines if a symbol is a local variable
: LFIND ( addr len - )
depth 2 < if \ if the address and length are not on the stack
exit
then
2dup ( addr len addr len )
getOrder ( addr len addr len - addr len n )
dup ( addr len n - addr len n n )
-1 = if \ if the symbol isn't a local variable
drop ( addr len n - addr len )
else \ if the symbol is a local variable
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
\ default case
2drop ( addr len - )
cr ." Could not compile local variable!" cr
TRUE
exit
endcase
2drop ( addr len - )
." compiled" \ display this text when entering a local variable symbol
FALSE
then
;
\ Redefine colon to clean up after {
: ;
usingLocals TRUE =
if
FALSE TO usingLocals
postpone popLocalStack
postpone setBaseAddress
then
postpone ;
; immediate
' lfind is mydefer \ makes lfind work in INTERPRET
\ ************ OVERWRITE THESE WORDS IN interpreter.fs ***************
Defer mydefer
: interpret
0 >in !
begin
parse-word dup 0> \ was there a word at all?
while
usingLocals if
mydefer
\ need to add a code to continue to the next iteration right here
then
$find
if
dup flags? 0<> state @ 0= or if
execute
else
, \ compile mode && !immediate
then
else \ word is not known. maybe it's a number
2dup $number
if
span @ >in ! \ if we encountered an error, don't continue parsing
type 3a emit
-13 throw
else
-rot 2drop 1 handle-lit
then
then
depth 200 >= if -3 throw then
depth 0< if -4 throw then
rdepth 200 >= if -5 throw then
rdepth 0< if -6 throw then
repeat
2drop
;
: print-status ( exception -- )
space
?dup if
dup sys-debug \ system debug hook
case
-1 of s" Aborted." type endof
-2 of s" Aborted." type endof
-3 of s" Stack Overflow." type 0 depth! endof
-4 of s" Stack Underflow." type 0 depth! endof
-5 of s" Return Stack Overflow." type endof
-6 of s" Return Stack Underflow." type endof
-13 of s" undefined word." type endof
-15 of s" out of memory." type endof
-21 of s" undefined method." type endof
-22 of s" no such device." type endof
-100 of endof \ local variable being used
dup s" Exception #" type .
0 state !
endcase
else
state @ 0= if
s" ok"
else
s" compiled"
then
type
then
cr
;
On 25.08.2012, at 03:05, Blue Swirl <blauwirbel(a)gmail.com> wrote:
> On Sat, Aug 25, 2012 at 9:47 AM, Andreas TObler <andreast(a)fgznet.ch> wrote:
>> On 08/25/12 11:00, Blue Swirl wrote:
>>>
>>> On Fri, Aug 24, 2012 at 9:45 PM, Andreas Tobler <andreast(a)fgznet.ch>
>>> wrote:
>>>>
>>>> Hello,
>>>>
>>>> I'm trying to get FreeBSD powerpc running with qemu.
>>>> So far it loads the fbsd loader and the loader loads the kernel.
>>>> The kernel starts booting but it hangs in an endless loop. It tries to
>>>> print
>>>> out a fatal_trap but it looks like the 'of' doesn't work properly
>>>> (anymore?)
>>>> at this stage.
>>>>
>>>> I have a remote debugger attached to the kernel and I can see where it
>>>> hangs. But I can not figure out what caused the fatal trap here.
>>>>
>>>> An 'info registers' in qemu shows the srr0=fff025a4, this, as I
>>>> understand,
>>>> points to of_client_callback from OpenBIOS. (objdump -dS
>>>> openbios-qemu.nostrip gives me this.)
>>>>
>>>> qemu is on 1.1.90, iow, a git snapshot from yesterday with OpenBIOS from
>>>> 19th of aug.
>>>>
>>>> Is there a possibilty to 'debug' the OpenBIOS somehow?
>>>
>>>
>>> CCing OpenBIOS list too.
>>>
>>> We have a built-in debugger in OpenBIOS (maybe not well documented).
>>> Then there's DEBUG_CIF in libopenbios/client.c and it should be
>>> possible to add debugging print statements to forth/system/ciface.fs
>>> too.
>>
>>
>> Oh, thank you. I'll take a look when I'm back on the machine.
>>
>>
>>>> I'm not sure whether it is a kernel issue or an OpenBIOS issue.
>>>
>>>
>>> The problem could be that there's a MMU fault when the kernel calls
>>> OpenBIOS, maybe because OpenBIOS is no longer mapped (MMU disabled?)
>>> and then the above debugging would not help.
>>
>>
>> Hm, from the FreeBSD kernel code view, I passed several 'of' calls to read
>> the memory regions etc. to map memory. That said, OB is working fine for the
>> start.
>> I'm not sure where it happens, the fault above. It might be when I start to
>> call 'of' again after I have started the MMU on the FreeBSD kernel side.
>>
>> So, to my understanding, you say it might be an MMU fault, that OB is no
>> longer mapped? Who would be the responsible for this mapping, the FreeBSD
>> kernel or OB?
>
> Assuming that SRR0 is the fault address (I'm not so familiar with
> PPC),
SRR0 is the fault IP. So if the fault at hand is an instruction fetch fault, yes, that would be the address at fault. If it's a data fault you would have to check DAR for the address it faults in.
It might also help to boot the guest with -d in_asm,cpu,int and check out /tmp/qemu.log afterwards. Search for the IP that faulted and see why exactly it did.
Alex
> since it's pointing to the low level entry point this could make
> sense.
>
> At least on Sparc, the kernel should save the original MMU mappings
> and restore them on point of entry to OpenBIOS. Alternatively, you
> could try to arrange the code so that after you take control of MMU,
> OpenBIOS is not used anymore. For example, Linux builds an internal
> model of the Open Firmware tree and does not use the OF calls for OF
> tree lookup after the initial probe. I'd suppose NetBSD and OpenBSD
> kernel code could be used for reference since they work on PPC (real
> machines at least, I haven't tried on QEMU).
>
>>
>> Thanks a lot!
>> Andreas
>
On Aug 28, 2012, at 2:50 AM, openbios-request(a)openbios.org wrote:
> Message: 1
> Date: Mon, 27 Aug 2012 21:18:08 -0400
> From: Tarl Neustaedter <tarl-b2(a)tarl.net>
> To: The OpenBIOS Mailinglist <openbios(a)openbios.org>
> Subject: Re: [OpenBIOS] [PATCH] Adds local variable support to
> OpenBIOS.
> Message-ID: <503C1C50.408(a)tarl.net>
> Content-Type: text/plain; charset=ISO-8859-1; format=flowed
>
> [...]
>
>
>>>
>>> And don't use CamelCase.
>>
>> Is this some official naming convention, or your own taste?
>
> In general (at least in the 1275 world), Forth is case-insensitive. The
> rare cases where it is made case sensitive (there are a couple in Sun's
> Openboot - see dropins.src) make use of mixed case very painful. The
> general standard is that methods and variables are lower case, defined
> constants and structure offsets are upper case. In some code, even they
> are lower case.
>
> Mixed-case is generally confined to comments.
Are you saying my-variable is better than myVariable?
>
>>> Factor this? You shouldn't ever use a variable that is used as a temp
>>> inside a word.
>>
>> I'm not sure why you suggest this. It is just such a pain having to
>> deal with the stack.
>
> Because using a global variable gets you in trouble in recursion or when
> the same code is called at alarm level. As for stack being a pain, yes,
> that's forth. Stack manipulation as a way of life. Personally, I prefer
> "2over nip" rather than "2 pick" :-)
How do global variables get you in trouble in recursion? Do you have an example?
I am not familiar with this alarm level. Could you explain what it is?
>
>>>> +48 CONSTANT localTableSize
>>>> +
>>>> +\ Declare the local variable table
>>>> +localTableSize ARRAY localVariableTable
>>>
>>> You have 48 but can only access 12?
>>
>> That is four fields per local variable: 48 / 4 = 12.
>
> At a minimum, any derived constants should be derived explicitly. Like:
>
> 12 constant #local-variables \ Feels right. If you need more, add
> more code after Locals11.
> 4 constant /local-variable \ Datastructures require four cells
> #local-variables /local-variable * constant locals-table-size \ Size in
> cells, not bytes.
>
> Ah. That points out another convention. When mashing together multiple
> words for a method or variable name, we tend to use dashes as separators
> (and please, don't use underscores. There is someone I know who *mixes*
> underscores and dashes in variable names!). Another is that sizes of
> things are usually /object (such as /n, /l, ...) and counts of objects
> are usually #object.
Ok. Sounds reasonable.
>
>>
>>>
>>>> +: getLocalRecordCount
>>>> +arrayCount 4 /
>>>> +;
>>>
>>> Oh. Use a struct?
>>
>> The little documentation on struct I found did not indicate it was a
>> better replacement for Array.
>
> Struct will allow you define what the four separate words used in each
> local variable entry are used for. If you use structs, I'd expect to see
> something like:
>
> struct
> /n field >LOCAL-INIT
> /n field >LOCAL-ORDER
> /n field >LOCAL-LEN
> /n field >LOCAL-ADDR
> constant /local-variable
> 12 constant #local-variables
> /local-variable #local-variables constant locals-table-size
>
> Note that the above provides the table size in bytes, rather than cells.
>
> To use the above (assuming you are still using alloc-mem), you'd see
> something like:
>
> locals-table-size alloc-mem ( table )
> #local-variables 0 do ( table )
> i /local-variable * ( table entry )
> 0 over >LOCAL-INIT ! ( table entry )
> 0 over >LOCAL-ORDER ! ( table entry )
> 0 over >LOCAL-LEN ! ( table entry )
> 0 swap >LOCAL-ADDR ! ( table )
> loop ( table )
That looks very unfriendly. There is no way I am using structs.
On Aug 27, 2012, at 4:44 PM, openbios-request(a)openbios.org wrote:
> Message: 4
> Date: Mon, 27 Aug 2012 22:35:40 +0200
> From: Segher Boessenkool <segher(a)kernel.crashing.org>
> To: The OpenBIOS Mailinglist <openbios(a)openbios.org>
> Subject: Re: [OpenBIOS] [PATCH] Adds local variable support to
> OpenBIOS.
> Message-ID: <F74BFA60-0824-49A9-B592-D6862E0ACFB7(a)kernel.crashing.org>
> Content-Type: text/plain; charset=US-ASCII; delsp=yes; format=flowed
>
> Let me comment on the code, independently of if I think using local
> var names is a good idea at all.
>
>> + DEPTH 0= IF
>> + CR ." Please specify an array size." CR
>> + EXIT
>> + THEN
>
> You shouldn't blindly continue when you detect an error; use ABORT
> instead, or ABORT" since you want to print something.
Thanks for catching this. It has been corrected.
>
> Don't check stack depth, it is useless. It doesn't work when you
> forgot to pass a parameter but there is other stuff on the stack
> already (the common case). Your check also doesn't work if there
> is a negative number of parameters on the stack (the next most
> common case...)
>
> Just kill this part.
I don't think ignoring all possible error situations is better than handing a few of them.
>
>> + CREATE CELL * ALLOT \ creates and initializes the instance
>
> CELL * is CELLS (which is a standard Forth word, CELL is not).
Thanks for letting me know about CELL. I have changed them all to CELLS
>
>> + DEPTH 2 < IF
>> + CR ." Please specify an index number." CR
>> + drop \ removes the address of the array instance
>> + -1 throw \ stop normal execution after error
>> + THEN
>
> -1 THROW is ABORT
> Same thing here, just kill this code.
The error handling makes the word more user friendly. Having it fail and leaving the user clueless why doesn't sound right.
>
>> +; immediate
>
> Defining words should not be immediate in most cases, including here.
>
>> +\ Declare the local-base-address VALUE
>> +0 VALUE local-base-address
>> +
>> +\ returns the base address used for the local words
>> +: getBaseAddress ( - addr )
>> + local-base-address
>> +;
>
> : really-get-base-address getBaseAddress ;
> : really-really-get-base-address really-get-base-address ;
>
> And don't use CamelCase.
Is this some official naming convention, or your own taste?
>
>> +\ Sets the first local variable's value
>> +: Local0! ( x - )
>> + 0 CELL * getBaseAddress + !
>> +;
>
> You can do something smarter than this...
>
>> +\ Sets the twelfth local variable's value
>> +: Local11! ( x - )
>> + 11 CELL * getBaseAddress + !
>> +;
>
> ...why stop at 11?
As far as I know, Apple's code only uses two local variables at most. I figured 12 local variables per word should be enough.
>
>> +: calculateNeededMemory ( "char" - 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 CELL *
>> +;
>
> Factor this? You shouldn't ever use a variable that is used as a temp
> inside a word.
I'm not sure why you suggest this. It is just such a pain having to deal with the stack.
>
>> +: allocateMemory ( n - addr )
>> + alloc-mem dup 0= if
>> + drop
>> + cr cr 10 spaces abort" Failed to allocate memory for local
>> variables!" cr cr
>> + then
>> +;
>
> alloc-mem is way too slow to be used on every function call. Statically
> allocate a locals stack, or put it on an existing stack, or something
> like that.
I agree. That is why it is only used at compile time.
>
>> +\ Declares the size of the local variable table
>> +48 CONSTANT localTableSize
>> +
>> +\ Declare the local variable table
>> +localTableSize ARRAY localVariableTable
>
> You have 48 but can only access 12?
That is four fields per local variable: 48 / 4 = 12.
>
>> +: getLocalRecordCount
>> + arrayCount 4 /
>> +;
>
> Oh. Use a struct?
The little documentation on struct I found did not indicate it was a better replacement for Array.
>
> I'll stop here. There are two good ways to implement locals (or
> anything else, really): 1) Make it _simple_: you can do locals
> in about 20 or 30 lines of code. 60 is fine, too. 2) Make it
> efficient: don't allocate from a heap, don't run much code on
> the hot paths. This will be much smaller code as well, but
> perhaps trickier to understand.
What is a hot path?
>
> Segher
Here is the patch for local variable support. I have made several improvements to the code using the feedback I received.
Signed-off-by: John Arbuckle <programmingkidx(a)gmail.com>.
---
forth/bootstrap/interpreter.fs | 42 ++-
forth/util/util.fs | 567 ++++++++++++++++++++++++++++++++++++++++
2 files changed, 597 insertions(+), 12 deletions(-)
diff --git a/forth/bootstrap/interpreter.fs b/forth/bootstrap/interpreter.fs
index 5187058..3be9f0c 100644
--- a/forth/bootstrap/interpreter.fs
+++ b/forth/bootstrap/interpreter.fs
@@ -40,16 +40,9 @@
\ 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
+: oldInterpret
+ $find
if
dup flags? 0<> state @ 0= or if
execute
@@ -70,9 +63,34 @@
depth 0< if -4 throw then
rdepth 200 >= if -5 throw then
rdepth 0< if -6 throw then
- repeat
+;
+
+
+Defer mydefer
+false VALUE usingLocals
+
+\ The refactored interpret - supports local variables
+: interpret
+ 0 >in !
+ begin
+ parse-word dup 0> ( addr len flag ) \ was there a word at all?
+ while ( addr len )
+
+ usingLocals true = if ( addr len ) \ if local variables are being used
+ mydefer ( addr len flag )
+ not if ( ) \ if symbol is not a local variable
+ oldInterpret
+ then
+
+ else \ if not using local variables
+ oldInterpret
+ then
+
+ repeat
2drop
- ;
+;
+
+
: refill ( -- )
ib #ib @ expect 0 >in ! ;
diff --git a/forth/util/util.fs b/forth/util/util.fs
index 6f549bf..3f5bb21 100644
--- a/forth/util/util.fs
+++ b/forth/util/util.fs
@@ -93,3 +93,570 @@
2dup " tell" is-relay
2drop
;
+
+
+\ -------------------------------------------------------------------------
+\ Local Variable Support
+\ -------------------------------------------------------------------------
+
+\ Creates an array variable
+: ARRAY ( cellCount - )
+ DEPTH 0< IF
+ CR ." Please specify an array size." CR
+ abort
+ THEN
+
+ \ Compile-time behavior
+ CREATE CELLS ALLOT \ creates and initializes the instance
+
+ DOES>
+
+ \ Run-time behavior
+ DEPTH 2 < IF
+ CR ." Please specify an index number." CR
+ drop \ removes the address of the array instance
+ -1 throw \ stop normal execution after error
+ THEN
+
+ SWAP CELLS + \ Calculates address to return
+; immediate
+
+
+\ Declare the local-base-address VALUE
+0 VALUE local-base-address
+
+\ returns the base address used for the local words
+: getBaseAddress ( - addr )
+ local-base-address
+;
+
+\ sets the base address used for the local words
+: setBaseAddress ( addr - )
+ TO local-base-address
+;
+
+
+\ Sets the first local variable's value
+: Local0! ( x - )
+ 0 CELLS getBaseAddress + !
+;
+
+\ Sets the second local variable's value
+: Local1! ( x - )
+ 1 CELLS getBaseAddress + !
+;
+
+\ Sets the third local variable's value
+: Local2! ( x - )
+ 2 CELLS getBaseAddress + !
+;
+
+\ Sets the fourth local variable's value
+: Local3! ( x - )
+ 3 CELLS getBaseAddress + !
+;
+
+\ Sets the fifth local variable's value
+: Local4! ( x - )
+ 4 CELLS getBaseAddress + !
+;
+
+\ Sets the sixth local variable's value
+: Local5! ( x - )
+ 5 CELLS getBaseAddress + !
+;
+
+\ Sets the seventh local variable's value
+: Local6! ( x - )
+ 6 CELLS getBaseAddress + !
+;
+
+\ Sets the eighth local variable's value
+: Local7! ( x - )
+ 7 CELLS getBaseAddress + !
+;
+
+\ Sets the ninth local variable's value
+: Local8! ( x - )
+ 8 CELLS getBaseAddress + !
+;
+
+\ Sets the tenth local variable's value
+: Local9! ( x - )
+ 9 CELLS getBaseAddress + !
+;
+
+\ Sets the eleventh local variable's value
+: Local10! ( x - )
+ 10 CELLS getBaseAddress + !
+;
+
+\ Sets the twelfth local variable's value
+: Local11! ( x - )
+ 11 CELLS getBaseAddress + !
+;
+
+
+\ **** Calculates the needed amount of memory for local variables ****
+0 value variableCount
+: calculateNeededMemory ( "char" - 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 ****
+: allocateMemory ( 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 localTableSize
+
+\ Declare the local variable table
+localTableSize ARRAY localVariableTable
+
+\ Keeps track of end of array
+0 VALUE arrayCount
+
+\ gets the number of records in the local variable table
+: getLocalRecordCount
+ arrayCount 4 /
+;
+
+\ Clears the local variable table
+: initLocalTable ( - )
+
+ \ free all the dynamically allocated memory
+ arrayCount 0 ?do
+ I 3 + localVariableTable @ ( addr )
+ free-mem ( )
+ 4 +loop
+
+ 0 localVariableTable localTableSize erase
+ 0 TO arrayCount
+;
+
+\ Adds a local variable symbol to the local variable table
+: addLocal ( 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 table
+ arrayCount 0 + localVariableTable ! \ initflag
+ arrayCount 1 + localVariableTable ! \ order
+ arrayCount 2 + localVariableTable ! \ len
+ arrayCount 3 + localVariableTable ! \ addr
+
+ \ allocate memory for the symbol
+ arrayCount 2 + localVariableTable @ ( length )
+ alloc-mem ( memaddr )
+ dup ( memaddr memaddr )
+ dup ( memaddr memaddr memaddr )
+
+ \ called only when memaddr = 0
+ 0= ( memaddr memaddr flag )
+ if
+ cr ." Failed to allocate memory in addLocal!" cr ( memaddr memaddr )
+ then
+
+ \ copy local variable name to a safe location
+ arrayCount 3 + localVariableTable @ ( memaddr memaddr addr )
+ swap ( memaddr addr memaddr )
+ arrayCount 2 + localVariableTable @ ( memaddr addr memaddr length )
+ move ( memaddr )
+ arrayCount 3 + localVariableTable ! ( )
+
+ \ increment arrayCount
+ arrayCount 4 + TO arrayCount
+;
+
+\ prints the local variable table
+: printLocalTable
+
+ arrayCount 0= if
+ cr ." No variables loaded" cr
+ exit
+ then
+
+ arrayCount 0 ?do
+ cr ." Variable name: "
+ I 3 + localVariableTable @
+ I 2 + localVariableTable @
+ type
+
+ ." Order: "
+ I 1 + localVariableTable @ .
+
+ ." Init Flag: "
+ I 0 + localVariableTable @ .
+ 4
+ +loop
+;
+
+\ Finds a local variable symbol in the local variable table
+\ Returns its order or -1 on failure
+: getOrder ( addr len - order )
+ \ if the address and length are missing
+ depth 2 < if
+ cr ." Address and length are required on the stack to use getOrder!" cr
+ -1 throw \ ends execution
+ then
+
+ arrayCount 0 ?do
+ over ( addr len addr )
+ I 3 + ( addr len addr addrindex )
+ localVariableTable @ ( 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 + localVariableTable @ ( addr len addr addr1 len len len1)
+ = ( addr len addr addr1 len flag)
+
+ if \ if lengths are equal
+ comp ( addr len flag)
+ 0= ( addr len flag )
+ if \ if the symbol is found
+ 2drop ( )
+ I 1 + localVariableTable @ ( order )
+ unloop
+ exit
+ then
+
+ else \ if the lengths are different
+ 3drop ( addr len )
+ then
+
+
+ 4 \ increment the index by 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 useTopStackValue
+0 VALUE index
+0 VALUE localVariableMemory
+
+: readLocalVariables ( "char" - )
+ 0 TO index
+ true TO useTopStackValue
+
+ 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= ( addr len flag )
+
+ 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 useTopStackValue ( addr len )
+ 2drop ( )
+ else \ add local variable to table
+ index useTopStackValue ( addr len order useTopStackValue )
+ addLocal ( )
+ index 1 + TO index \ increment index
+ then
+
+ repeat
+ drop ( addr )
+ drop ( )
+;
+
+
+\ FALSE VALUE usingLocals \ not needed because it is in the interpreter.fs file
+
+\ sets the stack size
+1000 CONSTANT maxStackSize
+
+\ declare the local stack
+maxStackSize ARRAY localStack
+
+\ declare the stack top pointer
+0 VALUE localStackTop
+
+\ Adds to the top of the local stack
+: pushLocalStack ( x - L:x )
+ localStackTop maxStackSize 1 - >
+ if
+ cr ." Local stack overflow!" cr
+ maxStackSize TO localStackTop \ sets localStackTop back to the max size
+ then
+ localStackTop localStack ! ( x - )
+ localStackTop 1 + TO localStackTop
+;
+
+
+\ Removes the top local stack value and places it into the data stack
+: popLocalStack ( L:x - x )
+ localStackTop 1 - TO localStackTop
+ localStackTop 0< if \ if popping too many items
+ cr ." Local stack underflow!" cr
+ 0 TO localStackTop \ sets localStackTop back to zero
+ abort
+ then
+ localStackTop localStack @
+;
+
+
+12 CONSTANT localVariableLimit
+\ ***** sets up local variables ******
+: { ( "char" - )
+ initLocalTable
+ \ localVariableLimit CELLS ( memorySize )
+ calculateNeededMemory ( memorySize )
+ allocateMemory ( memorySize - addr )
+ TO localVariableMemory ( )
+ readLocalVariables ( )
+ TRUE TO usingLocals
+
+ \ add code to the current definition
+
+ \ saves the old base address
+ postpone getBaseAddress
+ postpone pushLocalStack
+
+ \ sets the base address to this definition's reserved memory
+ localVariableMemory
+ postpone literal
+ postpone setBaseAddress
+
+ \ add code to initialize the variables if needed
+ 0 arrayCount 4 - ( end start )
+ ?do
+ I 0 + localVariableTable @ ( 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 )
+ getOrder ( 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 getBaseAddress + @
+;
+
+\ returns the second local variable's value
+: Local1@
+ 1 CELLS getBaseAddress + @
+;
+
+\ returns the third local variable's value
+: Local2@
+ 2 CELLS getBaseAddress + @
+;
+
+\ returns the fourth local variable's value
+: Local3@
+ 3 CELLS getBaseAddress + @
+;
+
+\ returns the fifth local variable's value
+: Local4@
+ 4 CELLS getBaseAddress + @
+;
+
+\ returns the sixth local variable's value
+: Local5@
+ 5 CELLS getBaseAddress + @
+;
+
+\ returns the seventh local variable's value
+: Local6@
+ 6 CELLS getBaseAddress + @
+;
+
+\ returns the eighth local variable's value
+: Local7@
+ 7 CELLS getBaseAddress + @
+;
+
+\ returns the ninth local variable's value
+: Local8@
+ 8 CELLS getBaseAddress + @
+;
+
+\ returns the tenth local variable's value
+: Local9@
+ 9 CELLS getBaseAddress + @
+;
+
+\ returns the eleventh local variable's value
+: Local10@
+ 10 CELLS getBaseAddress + @
+;
+
+\ returns the twelfth local variable's value
+: Local11@
+ 11 CELLS getBaseAddress + @
+;
+
+
+\ determines if a symbol is a local variable
+\ returns true if the symbol is a local variable, false otherwise
+: LFIND ( addr len - )
+ depth 2 < if \ if the address and length are not on the stack
+ exit
+ then
+
+ 2dup ( addr len addr len )
+ getOrder ( addr len addr len - addr len n )
+ dup ( addr len n - addr len n n )
+ -1 = if \ if the symbol isn't a local variable
+ drop ( addr len n - addr len )
+ false ( addr len flag )
+
+ else \ if the symbol is a local variable
+ 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
+
+ \ default case
+ 2drop ( addr len - )
+ cr ." Could not compile local variable!" cr
+ TRUE ( addr len flag )
+ exit
+
+ endcase
+
+ 2drop ( addr len - )
+ ." compiled " \ display this text when entering a local variable symbol
+ true ( addr len flag )
+ then
+;
+
+
+\ Redefine colon to clean up after {
+: ;
+ usingLocals TRUE =
+ if
+ FALSE TO usingLocals
+ postpone popLocalStack
+ postpone setBaseAddress
+ then
+ postpone ;
+; immediate
+
+' lfind is mydefer \ makes lfind work in INTERPRET
+
+
--
1.7.5.4
This is the second patch for adding support to OpenBIOS. This adds the bulk of the local variable code to OpenBIOS.
---
forth/util/util.fs | 558 ++++++++++++++++++++++++++++++++++++++++++++++++++++
1 files changed, 558 insertions(+), 0 deletions(-)
diff --git a/forth/util/util.fs b/forth/util/util.fs
index 6f549bf..f55b0be 100644
--- a/forth/util/util.fs
+++ b/forth/util/util.fs
@@ -93,3 +93,561 @@
2dup " tell" is-relay
2drop
;
+
+
+
+\ -------------------------------------------------------------------------
+\ Local Variable Support
+\ -------------------------------------------------------------------------
+
+\ Creates an array variable
+: ARRAY ( cellCount - )
+ DEPTH 0= IF
+ CR ." Please specify an array size." CR
+ EXIT
+ THEN
+
+ \ Compile-time behavior
+ CREATE CELL * ALLOT \ creates and initializes the instance
+
+ DOES>
+
+ \ Run-time behavior
+ DEPTH 2 < IF
+ CR ." Please specify an index number." CR
+ drop \ removes the address of the array instance
+ -1 throw \ stop normal execution after error
+ THEN
+
+ SWAP CELL * + \ Calculates address to return
+; immediate
+
+
+\ Declare the local-base-address VALUE
+0 VALUE local-base-address
+
+\ returns the base address used for the local words
+: getBaseAddress ( - addr )
+ local-base-address
+;
+
+\ sets the base address used for the local words
+: setBaseAddress ( addr - )
+ TO local-base-address
+;
+
+
+\ Sets the first local variable's value
+: Local0! ( x - )
+ 0 CELL * getBaseAddress + !
+;
+
+\ Sets the second local variable's value
+: Local1! ( x - )
+ 1 CELL * getBaseAddress + !
+;
+
+\ Sets the third local variable's value
+: Local2! ( x - )
+ 2 CELL * getBaseAddress + !
+;
+
+\ Sets the fourth local variable's value
+: Local3! ( x - )
+ 3 CELL * getBaseAddress + !
+;
+
+\ Sets the fifth local variable's value
+: Local4! ( x - )
+ 4 CELL * getBaseAddress + !
+;
+
+\ Sets the sixth local variable's value
+: Local5! ( x - )
+ 5 CELL * getBaseAddress + !
+;
+
+\ Sets the seventh local variable's value
+: Local6! ( x - )
+ 6 CELL * getBaseAddress + !
+;
+
+\ Sets the eighth local variable's value
+: Local7! ( x - )
+ 7 CELL * getBaseAddress + !
+;
+
+\ Sets the ninth local variable's value
+: Local8! ( x - )
+ 8 CELL * getBaseAddress + !
+;
+
+\ Sets the tenth local variable's value
+: Local9! ( x - )
+ 9 CELL * getBaseAddress + !
+;
+
+\ Sets the eleventh local variable's value
+: Local10! ( x - )
+ 10 CELL * getBaseAddress + !
+;
+
+\ Sets the twelfth local variable's value
+: Local11! ( x - )
+ 11 CELL * getBaseAddress + !
+;
+
+
+\ **** Calculates the needed amount of memory for local variables ****
+0 value variableCount
+: calculateNeededMemory ( "char" - 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 CELL *
+;
+
+
+\ **** allocates the memory for local variables ****
+: allocateMemory ( 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 localTableSize
+
+\ Declare the local variable table
+localTableSize ARRAY localVariableTable
+
+\ Keeps track of end of array
+0 VALUE arrayCount
+
+\ gets the number of records in the local variable table
+: getLocalRecordCount
+ arrayCount 4 /
+;
+
+\ Clears the local variable table
+: initLocalTable ( - )
+
+ \ free all the dynamically allocated memory
+ arrayCount 0 ?do
+ I 3 + localVariableTable @ ( addr )
+ free-mem ( )
+ 4 +loop
+
+ 0 localVariableTable localTableSize erase
+ 0 TO arrayCount
+;
+
+\ Adds a local variable symbol to the local variable table
+: addLocal ( 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 table
+ arrayCount 0 + localVariableTable ! \ initflag
+ arrayCount 1 + localVariableTable ! \ order
+ arrayCount 2 + localVariableTable ! \ len
+ arrayCount 3 + localVariableTable ! \ addr
+
+ \ allocate memory for the symbol
+ arrayCount 2 + localVariableTable @ ( length )
+ alloc-mem ( memaddr )
+ dup ( memaddr memaddr )
+ dup ( memaddr memaddr memaddr )
+
+ \ called only when memaddr = 0
+ 0= ( memaddr memaddr flag )
+ if
+ cr ." Failed to allocate memory in addLocal!" cr ( memaddr memaddr )
+ then
+
+ \ copy local variable name to a safe location
+ arrayCount 3 + localVariableTable @ ( memaddr memaddr addr )
+ swap ( memaddr addr memaddr )
+ arrayCount 2 + localVariableTable @ ( memaddr addr memaddr length )
+ move ( memaddr )
+ arrayCount 3 + localVariableTable ! ( )
+
+ \ increment arrayCount
+ arrayCount 4 + TO arrayCount
+;
+
+\ prints the local variable table
+: printLocalTable
+
+ arrayCount 0= if
+ cr ." No variables loaded" cr
+ exit
+ then
+
+ arrayCount 0 ?do
+ cr ." Variable name: "
+ I 3 + localVariableTable @
+ I 2 + localVariableTable @
+ type
+
+ ." Order: "
+ I 1 + localVariableTable @ .
+
+ ." Init Flag: "
+ I 0 + localVariableTable @ .
+ 4
+ +loop
+;
+
+\ Finds a local variable symbol in the local variable table
+\ Returns its order or -1 on failure
+: getOrder ( addr len - order )
+ \ if the address and length are missing
+ depth 2 < if
+ cr ." Address and length are required on the stack to use getOrder!" cr
+ -1 throw \ ends execution
+ then
+
+ arrayCount 0 ?do
+ over ( addr len addr )
+ I 3 + ( addr len addr addrindex )
+ localVariableTable @ ( 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 + localVariableTable @ ( addr len addr addr1 len len len1)
+ = ( addr len addr addr1 len flag)
+
+ if \ if lengths are equal
+ comp ( addr len flag)
+ 0= ( addr len flag )
+ if \ if the symbol is found
+ 2drop ( )
+ I 1 + localVariableTable @ ( order )
+ unloop
+ exit
+ then
+
+ else \ if the lengths are different
+ 3drop ( addr len )
+ then
+
+
+ 4 \ increment the index by 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 useTopStackValue
+0 VALUE index
+0 VALUE localVariableMemory
+
+: readLocalVariables ( "char" - )
+ 0 TO index
+ true TO useTopStackValue
+
+ 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= ( addr len flag )
+
+ 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 useTopStackValue ( addr len )
+ 2drop ( )
+ else \ add local variable to table
+ index useTopStackValue ( addr len order useTopStackValue )
+ addLocal ( )
+ index 1 + TO index \ increment index
+ then
+
+ repeat
+ drop ( addr )
+ drop ( )
+;
+
+
+\ FALSE VALUE usingLocals \ not needed because it is in the interpreter.fs file
+
+\ sets the stack size
+1000 CONSTANT maxStackSize
+
+\ declare the local stack
+maxStackSize ARRAY localStack
+
+\ declare the stack top pointer
+0 VALUE localStackTop
+
+\ Adds to the top of the local stack
+: pushLocalStack ( x - L:x )
+ localStackTop localStack ! ( x - )
+ localStackTop 1 + TO localStackTop
+ localStackTop maxStackSize =
+ abort" Local stack overflow!"
+;
+
+
+\ Removes the top local stack value and places it into the data stack
+: popLocalStack ( L:x - x )
+ localStackTop 1 - TO localStackTop
+ localStackTop localStack @
+;
+
+
+12 CONSTANT localVariableLimit
+\ ***** sets up local variables ******
+: { ( "char" - )
+ initLocalTable
+ \ localVariableLimit CELL * ( memorySize )
+ calculateNeededMemory ( memorySize )
+ allocateMemory ( memorySize - addr )
+ TO localVariableMemory ( )
+ readLocalVariables ( )
+ TRUE TO usingLocals
+
+ \ add code to the current definition
+
+ \ saves the old base address
+ postpone getBaseAddress
+ postpone pushLocalStack
+
+ \ sets the base address to this definition's reserved memory
+ localVariableMemory
+ postpone literal
+ postpone setBaseAddress
+
+ \ add code to initialize the variables if needed
+ 0 arrayCount 4 - ( end start )
+ ?do
+ I 0 + localVariableTable @ ( 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 )
+ getOrder ( 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@
+ CELL 0 * getBaseAddress + @
+;
+
+\ returns the second local variable's value
+: Local1@
+ CELL 1 * getBaseAddress + @
+;
+
+\ returns the third local variable's value
+: Local2@
+ CELL 2 * getBaseAddress + @
+;
+
+\ returns the fourth local variable's value
+: Local3@
+ CELL 3 * getBaseAddress + @
+;
+
+\ returns the fifth local variable's value
+: Local4@
+ CELL 4 * getBaseAddress + @
+;
+
+\ returns the sixth local variable's value
+: Local5@
+ CELL 5 * getBaseAddress + @
+;
+
+\ returns the seventh local variable's value
+: Local6@
+ CELL 6 * getBaseAddress + @
+;
+
+\ returns the eighth local variable's value
+: Local7@
+ CELL 7 * getBaseAddress + @
+;
+
+\ returns the ninth local variable's value
+: Local8@
+ CELL 8 * getBaseAddress + @
+;
+
+\ returns the tenth local variable's value
+: Local9@
+ CELL 9 * getBaseAddress + @
+;
+
+\ returns the eleventh local variable's value
+: Local10@
+ CELL 10 * getBaseAddress + @
+;
+
+\ returns the twelfth local variable's value
+: Local11@
+ CELL 11 * getBaseAddress + @
+;
+
+
+\ determines if a symbol is a local variable
+\ returns true if the symbol is a local variable, false otherwise
+: LFIND ( addr len - )
+ depth 2 < if \ if the address and length are not on the stack
+ exit
+ then
+
+ 2dup ( addr len addr len )
+ getOrder ( addr len addr len - addr len n )
+ dup ( addr len n - addr len n n )
+ -1 = if \ if the symbol isn't a local variable
+ drop ( addr len n - addr len )
+ false ( addr len flag )
+
+ else \ if the symbol is a local variable
+ 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
+
+ \ default case
+ 2drop ( addr len - )
+ cr ." Could not compile local variable!" cr
+ TRUE ( addr len flag )
+ exit
+
+ endcase
+
+ 2drop ( addr len - )
+ ." compiled " \ display this text when entering a local variable symbol
+ true ( addr len flag )
+ then
+;
+
+
+\ Redefine colon to clean up after {
+: ;
+ usingLocals TRUE =
+ if
+ FALSE TO usingLocals
+ postpone popLocalStack
+ postpone setBaseAddress
+ then
+ postpone ;
+; immediate
+
+' lfind is mydefer \ makes lfind work in INTERPRET
--
1.7.5.4
I'm new to using git, so if there are any problems with this patch, let me know and I will try to fix it.
This patch is the first of two patches for adding local variable support to OpenBIOS. As you may know, local variable support is required to be able to run Mac OS X in QEMU one day. This and the second patch takes us one step closer to that day.
---
forth/bootstrap/interpreter.fs | 41 +++++++++++++++++++++++++++++----------
1 files changed, 30 insertions(+), 11 deletions(-)
diff --git a/forth/bootstrap/interpreter.fs b/forth/bootstrap/interpreter.fs
index 5187058..486bb03 100644
--- a/forth/bootstrap/interpreter.fs
+++ b/forth/bootstrap/interpreter.fs
@@ -40,16 +40,10 @@
\ 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
+: oldInterpret
+ $find
if
dup flags? 0<> state @ 0= or if
execute
@@ -70,9 +64,34 @@
depth 0< if -4 throw then
rdepth 200 >= if -5 throw then
rdepth 0< if -6 throw then
- repeat
+;
+
+
+Defer mydefer
+false VALUE usingLocals
+
+\ The refactored interpret - supports local variables
+: interpret
+ 0 >in !
+ begin
+ parse-word dup 0> ( addr len flag ) \ was there a word at all?
+ while ( addr len )
+
+ usingLocals true = if ( addr len ) \ if local variables are being used
+ mydefer ( addr len flag )
+ not if ( ) \ if symbol is not a local variable
+ oldInterpret
+ then
+
+ else \ if not using local variables
+ oldInterpret
+ then
+
+ repeat
2drop
- ;
+;
+
+
: refill ( -- )
ib #ib @ expect 0 >in ! ;
--
1.7.5.4
On Aug 25, 2012, at 8:19 AM, openbios-request(a)openbios.org wrote:
>> I was wondering if there is a way to implement C's continue
>> statement in Forth. I have this loop, and some times I only want to
>> execute part of it, and then continue on to the next iteration
>> without finishing the current iteration. Is there any way of doing
>> this in OpenBIOS?
>
> It certainly can be done. But it sounds like you are making a
> word with a very big body; this is not the Forth way. Instead,
> factor your words into smaller words, for example, pull the loop
> body (the part between WHILE and REPEAT) into a separate word.
> It then becomes trivial to do your "continue" (and it will also
> be much more readable!)
>
>> begin
>> \ condition
>> while
>>
>> \ conditional code
>> if
>> CONTINUE \ skip rest of loop
>> then
>>
>> \ rest of loop ...
>>
>> repeat
>
> You don't have anything in here that "increases" the condition
> (increases some counter, follows a pointer, whatever). Typically
> you would have that just before the REPEAT, but your example makes
> it seem you have it between the BEGIN and WHILE. So your code is:
>
> BEGIN cond WHILE smth IF CONTINUE THEN rest REPEAT
>
> which you can write as
>
> BEGIN cond WHILE smth 0= IF rest THEN REPEAT
>
> (and if you do have an "increment" just before the REPEAT, which
> you want to run on CONTINUE, you can put it between the THEN and
> REPEAT in the modified example).
>
> But, let's build a CONTINUE like you described, just for fun.
> Let's look at the structure words you used:
>
> BEGIN ( C: -- dest )
> WHILE ( C: dest -- orig dest )
> REPEAT ( C: orig dest -- )
>
> You want to use your CONTINUE word between WHILE and REPEAT, and
> it should jump back to "dest"; at compile time, it should not drop
> the "dest" from the compilation stack. So its stack diagram is
>
> CONTINUE ( C: orig dest -- orig dest )
>
> or just
>
> CONTINUE ( C: dest -- dest )
>
> For doing an unconditional jump back, there is AGAIN, which is
>
> AGAIN ( C: dest -- )
>
> That eats the dest from the compilation stack though, so we want
> to duplicate it first, using CS-DUP
>
> CS-DUP ( C: dest -- dest dest )
>
> Not every system has that; just make it from CS-PICK, like so:
>
> : CS-DUP 0 CS-PICK ; IMMEDIATE
>
> And then let's do CONTINUE itself:
>
> : CONTINUE CS-DUP POSTPONE AGAIN ; IMMEDIATE
>
> Or you might want a ?CONTINUE which does the equivalent of
> IF CONTINUE THEN:
>
> : ?CONTINUE POSTPONE 0= CS-DUP POSTPONE UNTIL ; IMMEDIATE
>
>
> Hope this helps,
>
>
> Segher
You are right. My code was a little too long, so refactoring it fixed the problem. I guess I was still programming like a C programmer still. Thanks for the help.
On Aug 25, 2012, at 8:19 AM, openbios-request(a)openbios.org wrote:
> On 22/08/12 02:44, Programmingkid wrote:
>
>> The following code is for the use of local variables in OpenBIOS. I was
>> able to successfully make a word that used local variables. The work
>> isn't complete. There is still work to be done with the INTERPRET word.
>> The LFIND word has be implemented in the INTERPRET word for local
>> variables to be recognized during the compile state. I just need a
>> C-like CONTINUE word to go back to the start of a loop to fix all my
>> problems with INTERPRET. Maybe someone knows a better way of adding
>> LFIND to INTERPRET.
>>
>> I would appreciate any comments, suggestions, or advice for the
>> following code.
>
> Interesting work! I think that you may have made this a harder problem
> that it should be though.
>
> When I had a quick look at doing something earlier a while back, I
> noticed that OpenBIOS already has a concept of multiple dictionaries
> with a search order (see dict-list?). My idea for an implementation was
> to intercept docol to create a new dictionary at the top of the
> function, add it to the head of the search list and then add the values
> from the local variable declaration. This is pretty much what happens
> when you "cd" to a particular path in the device tree.
>
> Similarly you can then intercept dosemi from the search list to remove
> the dictionary and clear up. The advantage of this approach is that you
> can use all the in-built dictionary functions to manage your local
> variable words, rather than your current approach which is to
> re-implement this functionality yourself.
>
>
> HTH,
>
> Mark.
I did try at one time to do this, but decided to go the route of imitating how x86 assembly uses local variables.
Given the size of the local variable code I made, I think it would be best to place it all in its own file. Would anyone know how to add a file to OpenBIOS?