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 ;