OpenBIOS August 2012

openbios@openbios.org

13 participants
26 discussions

by Programmingkid

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 ;

8 years, 9 months

Re: [OpenBIOS] [Qemu-ppc] FreeBSD powerpc issue

by Alexander Graf

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 >

8 years, 12 months

Fwd: [PATCH] Adds local variable support to OpenBIOS.

by Programmingkid

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.

9 years

Re: [OpenBIOS] [PATCH] Adds local variable support to OpenBIOS.

by Programmingkid

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

9 years

[PATCH] Adds local variable support to OpenBIOS.

by Programmingkid

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

9 years

[PATCH] Adds local variable support to OpenBIOS.

by Programmingkid

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

9 years

[PATCH] Alters INTERPRET to be able to handle local variables.

by Programmingkid

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

9 years

Re: [OpenBIOS] C's continue statement in Forth?

by Programmingkid

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.

9 years

Re: [OpenBIOS] Local variable support

by Programmingkid

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.

9 years

Location for local variable code

by Programmingkid

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?

9 years