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
;
This patch has been improved from the last patch. Local variable code now is in its own file. The Array word has also been greatly simplified.
Signed-off-by: John Arbuckle <programmingkidx(a)gmail.com>
---
forth/bootstrap/interpreter.fs | 51 +++-
forth/util/build.xml | 1 +
forth/util/locals.fs | 531 ++++++++++++++++++++++++++++++++++++++++
3 files changed, 569 insertions(+), 14 deletions(-)
create mode 100644 forth/util/locals.fs
diff --git a/forth/bootstrap/interpreter.fs b/forth/bootstrap/interpreter.fs
index 5187058..9221cdc 100644
--- a/forth/bootstrap/interpreter.fs
+++ b/forth/bootstrap/interpreter.fs
@@ -40,26 +40,20 @@
\ 7.3.9.2.4 Miscellaneous dictionary
\
-\ interpreter. This word checks whether the interpreted word
-\ is a word in dictionary or a number. It honours compile mode
-\ and immediate/compile-only words.
-: interpret
- 0 >in !
- begin
- parse-word dup 0> \ was there a word at all?
- while
- $find
+\ Most of the old version of interpret
+: old-interpret ( addr len -- )
+ $find
if
dup flags? 0<> state @ 0= or if
execute
else
- , \ compile mode && !immediate
+ , \ Compile mode && !immediate
then
- else \ word is not known. maybe it's a number
+ else \ Word is not known. maybe it's a number
2dup $number
if
- span @ >in ! \ if we encountered an error, don't continue parsing
+ span @ >in ! \ If we encountered an error, don't continue parsing
type 3a emit
-13 throw
else
@@ -70,9 +64,38 @@
depth 0< if -4 throw then
rdepth 200 >= if -5 throw then
rdepth 0< if -6 throw then
+;
+
+
+Defer lfind-defer
+false VALUE using-locals
+
+\ The refactored interpret - supports local variables
+: interpret ( -- )
+ 0 >in !
+ begin
+ parse-word ( addr len )
+ dup ( addr len len1 )
+ 0> ( addr len flag ) \ Was there a word at all?
+ while ( addr len )
+ using-locals true = IF ( addr len ) \ If local variables are being used
+ 2dup ( addr len addr1 len1 )
+ lfind-defer ( addr len flag )
+ not IF ( addr len ) \ If symbol is not a local variable
+ old-interpret ( )
+ ELSE \ Else clean up the stack
+ 2drop ( )
+ THEN
+
+ ELSE \ If not using local variables
+ old-interpret ( addr len -- )
+ THEN
+
repeat
- 2drop
- ;
+ 2drop \ Removes the addr len pair if the loop ends at the WHILE word
+;
+
+
: refill ( -- )
ib #ib @ expect 0 >in ! ;
diff --git a/forth/util/build.xml b/forth/util/build.xml
index 4839d2c..d10f35a 100644
--- a/forth/util/build.xml
+++ b/forth/util/build.xml
@@ -11,6 +11,7 @@
<dictionary name="openbios" target="forth">
<object source="util.fs"/>
<object source="pci.fs"/>
+ <object source="locals.fs"/>
<!-- We don't want/need these at the moment
<object source="apic.fs"/>
-->
diff --git a/forth/util/locals.fs b/forth/util/locals.fs
new file mode 100644
index 0000000..22a6f55
--- /dev/null
+++ b/forth/util/locals.fs
@@ -0,0 +1,531 @@
+\ File: locals.fs
+\ Description: Adds local variable support to OpenBIOS. This is Apple's local variable specification.
+
+
+\ Creates an array variable
+: ARRAY ( cellCount -- )
+
+ \ Compile-time behavior
+ CREATE CELLS ALLOT ( cellCount -- ) \ Creates and initializes the instance
+
+ \ Run-time behavior
+ DOES> ( index addr )
+
+ SWAP CELLS + ( index addr -- addr1 ) \ Calculates address to return
+;
+
+
+\ Declare the local-base-address VALUE
+0 VALUE local-base-address
+
+\ Returns the base address used for the local words
+: get-base-address ( - addr )
+ local-base-address
+;
+
+\ Sets the base address used for the local words
+: set-base-address ( addr - )
+ TO local-base-address
+;
+
+
+\ Sets the first local variable's value
+: Local0! ( x - )
+ 0 CELLS get-base-address + !
+;
+
+\ Sets the second local variable's value
+: Local1! ( x - )
+ 1 CELLS get-base-address + !
+;
+
+\ Sets the third local variable's value
+: Local2! ( x - )
+ 2 CELLS get-base-address + !
+;
+
+\ Sets the fourth local variable's value
+: Local3! ( x - )
+ 3 CELLS get-base-address + !
+;
+
+\ Sets the fifth local variable's value
+: Local4! ( x - )
+ 4 CELLS get-base-address + !
+;
+
+\ Sets the sixth local variable's value
+: Local5! ( x - )
+ 5 CELLS get-base-address + !
+;
+
+\ Sets the seventh local variable's value
+: Local6! ( x - )
+ 6 CELLS get-base-address + !
+;
+
+\ Sets the eighth local variable's value
+: Local7! ( x - )
+ 7 CELLS get-base-address + !
+;
+
+\ Sets the ninth local variable's value
+: Local8! ( x - )
+ 8 CELLS get-base-address + !
+;
+
+\ Sets the tenth local variable's value
+: Local9! ( x - )
+ 9 CELLS get-base-address + !
+;
+
+\ Sets the eleventh local variable's value
+: Local10! ( x - )
+ 10 CELLS get-base-address + !
+;
+
+\ Sets the twelfth local variable's value
+: Local11! ( x - )
+ 11 CELLS get-base-address + !
+;
+
+
+\ **** Calculates the needed amount of memory for local variables ****
+0 value variableCount
+: calculate-needed-memory ( - n )
+ 0 TO variableCount
+ >in @ \ Keep track of where the pointer was
+
+ begin
+ parse-word
+ 0= if \ If there is no more text to parse
+ drop
+ true
+ else
+ dup " ;" comp
+ 0= if \ If the semicolon is encountered
+ drop \ Drop the duplicated address
+ false
+ else
+ " }" comp
+ 0= if \ If '}' character is encountered
+ true \ End loop because '}' marks end of local variables
+ else
+ variableCount 1 + TO variableCount
+ false
+ then
+ then
+ then
+ until
+
+ >in ! \ Reset the pointer
+ variableCount CELLS
+;
+
+
+\ **** allocates the memory for local variables ****
+: allocate-memory ( n - addr )
+ alloc-mem dup 0= if
+ drop
+ cr cr 10 spaces abort" Failed to allocate memory for local variables!" cr cr
+ then
+;
+
+
+
+\ Declares the size of the local variable table
+48 CONSTANT #local-table-elements
+
+\ Declare the local variable table
+#local-table-elements ARRAY local-variable-table
+
+\ Keeps track of end of array
+0 VALUE #filled-local-table-elements
+
+\ Clears the local variable table
+: init-local-table ( - )
+
+ \ Free all the dynamically allocated memory
+ #filled-local-table-elements 0 ?do
+ I 3 + local-variable-table @ ( addr )
+ free-mem ( )
+ 4 +loop
+
+ 0 local-variable-table #local-table-elements erase
+ 0 TO #filled-local-table-elements
+;
+
+\ Adds a local variable symbol to the local variable table
+: add-local ( addr len order initflag - )
+ depth 4 < if
+ cr ." The stack needs at least 4 values to add a local variable." cr
+ exit
+ then
+
+ \ Add to the end of the table
+ #filled-local-table-elements 0 + local-variable-table ! \ initflag
+ #filled-local-table-elements 1 + local-variable-table ! \ order
+ #filled-local-table-elements 2 + local-variable-table ! \ len
+ #filled-local-table-elements 3 + local-variable-table ! \ addr
+
+ \ Allocate memory for the symbol
+ #filled-local-table-elements 2 + local-variable-table @ ( length )
+ alloc-mem ( memaddr )
+ dup ( memaddr memaddr )
+ dup ( memaddr memaddr memaddr )
+
+ \ Called only when memaddr = 0
+ 0= if ( memaddr memaddr )
+ cr ." Failed to allocate memory in add-local!" cr ( memaddr memaddr )
+ then
+
+ \ Copy local variable name to a safe location
+ #filled-local-table-elements 3 + local-variable-table @ ( memaddr memaddr addr )
+ swap ( memaddr addr memaddr )
+ #filled-local-table-elements 2 + local-variable-table @ ( memaddr addr memaddr length )
+ move ( memaddr )
+ #filled-local-table-elements 3 + local-variable-table ! ( )
+
+ \ Increment #filled-local-table-elements
+ #filled-local-table-elements 4 + TO #filled-local-table-elements
+;
+
+\ Prints the local variable table
+: print-local-table
+
+ #filled-local-table-elements 0= if
+ cr ." No variables loaded" cr
+ exit
+ then
+
+ #filled-local-table-elements 0 ?do
+ cr ." Variable name: "
+ I 3 + local-variable-table @
+ I 2 + local-variable-table @
+ type
+
+ ." Order: "
+ I 1 + local-variable-table @ .
+
+ ." Init Flag: "
+ I 0 + local-variable-table @ .
+ 4 +loop
+;
+
+\ Finds a local variable symbol in the local variable table
+\ Returns its order or -1 on failure
+: get-order ( addr len - order )
+ \ If the address and length are missing
+ depth 2 < if
+ cr ." Address and length are required on the stack to use get-order!" cr
+ -1 throw \ Ends execution
+ then
+
+ #filled-local-table-elements 0 ?do
+ over ( addr len addr )
+ I 3 + ( addr len addr addrindex )
+ local-variable-table @ ( addr len addr addr1 )
+ 2 pick ( addr len addr addr1 len )
+
+ \ Check if lengths of two strings are the same length
+ dup ( addr len addr addr1 len len )
+ I 2 + local-variable-table @ ( addr len addr addr1 len len len1)
+ = if ( addr len addr addr1 len ) \ If lengths are equal
+ comp ( addr len flag)
+ 0= if ( addr len flag ) \ If the symbol is found
+ 2drop ( )
+ I 1 + local-variable-table @ ( order )
+ unloop
+ exit
+ then
+
+ else \ If the lengths are different
+ 3drop ( addr len )
+ then
+
+ \ Increment the index by 4
+ 4 +loop
+ 2drop ( addr len - )
+ -1 \ Returns -1 for the order if the symbol is not found
+;
+
+
+\ **** read the local variables in the input stream ****
+0 VALUE use-top-stack-value
+0 VALUE index
+0 VALUE local-variable-memory
+
+: read-local-variables ( "char" - )
+ 0 TO index
+ true TO use-top-stack-value
+
+ begin
+ parse-word ( addr len )
+ dup ( addr len len )
+ 0> ( addr len flag )
+ while ( addr len )
+ 2dup ( addr len addr len )
+ drop ( addr len addr )
+ " }" ( addr len addr addr len )
+ comp ( addr len flag )
+ 0= if ( addr len ) \ If end of local variables
+ drop ( addr )
+ drop ( )
+ exit ( )
+ then
+
+ 2dup ( addr len addr len )
+ drop ( addr len addr )
+ " ;" ( addr len addr addr len )
+ comp ( addr len flag )
+ 0= ( addr len flag )
+
+ if ( addr len ) \ If not using top stack value for local variables
+ false TO use-top-stack-value ( addr len )
+ 2drop ( )
+ else \ Add local variable to table
+ index use-top-stack-value ( addr len order use-top-stack-value )
+ add-local ( )
+ index 1 + TO index \ Increment index
+ then
+
+ repeat
+ drop ( addr )
+ drop ( )
+;
+
+
+\ Sets the stack size
+1000 CONSTANT max-stack-size
+
+\ Declare the local stack
+max-stack-size ARRAY local-stack
+
+\ Declare the stack top pointer
+0 VALUE local-stack-top
+
+\ Adds to the top of the local stack
+: push-local-stack ( x - L:x )
+ local-stack-top max-stack-size 1 - >
+ if
+ cr ." Local stack overflow!" cr
+ max-stack-size TO local-stack-top \ Sets local-stack-top back to the max size
+ then
+ local-stack-top local-stack ! ( x - )
+ local-stack-top 1 + TO local-stack-top
+;
+
+
+\ Removes the top local stack value and places it into the data stack
+: pop-local-stack ( L:x - x )
+ local-stack-top 1 - TO local-stack-top \ Decrement local-stack-top
+ local-stack-top 0< if \ If popping too many items
+ cr ." Local stack underflow!" cr
+ 0 TO local-stack-top \ Sets local-stack-top back to zero
+ abort
+ then
+ local-stack-top local-stack @
+;
+
+
+\ ***** sets up local variables ******
+: { ( -- )
+ init-local-table
+ calculate-needed-memory ( memorySize )
+ allocate-memory ( memorySize - addr )
+ TO local-variable-memory ( )
+ read-local-variables ( )
+ TRUE TO using-locals
+
+ \ Add code to the current definition
+
+ \ Saves the old base address
+ postpone get-base-address
+ postpone push-local-stack
+
+ \ Sets the base address to this definition's reserved memory
+ local-variable-memory
+ postpone literal
+ postpone set-base-address
+
+ \ Add code to initialize the variables if needed
+ 0 #filled-local-table-elements 4 - ?do
+ I 0 + local-variable-table @ ( flag ) \ Get the init flag
+ true ( flag true )
+ = ( flag1 )
+ if
+ I 4 / ( variable number )
+ case
+ 0 of ['] Local0! , endof
+ 1 of ['] Local1! , endof
+ 2 of ['] Local2! , endof
+ 3 of ['] Local3! , endof
+ 4 of ['] Local4! , endof
+ 5 of ['] Local5! , endof
+ 6 of ['] Local6! , endof
+ 7 of ['] Local7! , endof
+ 8 of ['] Local8! , endof
+ 9 of ['] Local9! , endof
+ 10 of ['] Local10! , endof
+ 11 of ['] Local11! , endof
+
+ cr ." Can't save to local variable! " cr
+ exit
+
+ endcase
+ then
+ -4 +loop
+
+; immediate \ Declares this word as a compiler directive
+
+
+
+\ Sets values for local variables
+: -> ( - )
+ parse-word ( addr len )
+ get-order ( order )
+ dup ( order order )
+ -1 = ( order flag )
+
+ if \ If the symbol isn't found
+ cr ." Symbol is not a local variable! " cr
+ drop ( )
+ exit
+ then
+
+ case
+ 0 of ['] Local0! , endof
+ 1 of ['] Local1! , endof
+ 2 of ['] Local2! , endof
+ 3 of ['] Local3! , endof
+ 4 of ['] Local4! , endof
+ 5 of ['] Local5! , endof
+ 6 of ['] Local6! , endof
+ 7 of ['] Local7! , endof
+ 8 of ['] Local8! , endof
+ 9 of ['] Local9! , endof
+ 10 of ['] Local10! , endof
+ 11 of ['] Local11! , endof
+
+ cr ." Can't save to local variable! " cr
+ exit
+
+ endcase
+
+; immediate
+
+
+\ Returns the first local variable's value
+: Local0@
+ 0 CELLS get-base-address + @
+;
+
+\ Returns the second local variable's value
+: Local1@
+ 1 CELLS get-base-address + @
+;
+
+\ Returns the third local variable's value
+: Local2@
+ 2 CELLS get-base-address + @
+;
+
+\ Returns the fourth local variable's value
+: Local3@
+ 3 CELLS get-base-address + @
+;
+
+\ Returns the fifth local variable's value
+: Local4@
+ 4 CELLS get-base-address + @
+;
+
+\ Returns the sixth local variable's value
+: Local5@
+ 5 CELLS get-base-address + @
+;
+
+\ Returns the seventh local variable's value
+: Local6@
+ 6 CELLS get-base-address + @
+;
+
+\ Returns the eighth local variable's value
+: Local7@
+ 7 CELLS get-base-address + @
+;
+
+\ Returns the ninth local variable's value
+: Local8@
+ 8 CELLS get-base-address + @
+;
+
+\ Returns the tenth local variable's value
+: Local9@
+ 9 CELLS get-base-address + @
+;
+
+\ Returns the eleventh local variable's value
+: Local10@
+ 10 CELLS get-base-address + @
+;
+
+\ Returns the twelfth local variable's value
+: Local11@
+ 11 CELLS get-base-address + @
+;
+
+
+\ Determines if a symbol is a local variable
+\ Returns true if the symbol is a local variable, false otherwise
+: LFIND ( addr len - flag )
+ depth 2 < if \ If the address and length are not on the stack
+ exit
+ then
+
+ get-order ( addr len - n )
+ dup ( n n1 )
+ -1 = if ( n ) \ If the symbol isn't a local variable
+ drop ( )
+ false ( flag )
+
+ else \ If the symbol is a local variable
+ case ( n )
+ 0 of ['] Local0@ , endof
+ 1 of ['] Local1@ , endof
+ 2 of ['] Local2@ , endof
+ 3 of ['] Local3@ , endof
+ 4 of ['] Local4@ , endof
+ 5 of ['] Local5@ , endof
+ 6 of ['] Local6@ , endof
+ 7 of ['] Local7@ , endof
+ 8 of ['] Local8@ , endof
+ 9 of ['] Local9@ , endof
+ 10 of ['] Local10@ , endof
+ 11 of ['] Local11@ , endof
+
+ \ Default case
+ cr ." Could not compile local variable!" cr
+ TRUE ( flag )
+ exit
+
+ endcase
+
+ ." compiled " \ Display this text when entering a local variable symbol
+ true ( flag )
+ then
+;
+
+
+\ Redefine colon to clean up after {
+: ;
+ using-locals TRUE =
+ if
+ FALSE TO using-locals
+ postpone pop-local-stack
+ postpone set-base-address
+ then
+ postpone ;
+; immediate
+
+' lfind is lfind-defer \ Makes lfind work in INTERPRET
\ No newline at end of file
--
1.7.5.4
The existing code in hfsp_volume.c tries to locate the alternate volume header
at the block vol->maxblocks - 2. Currently for unwrapped HFS+ volumes,
vol->maxblocks is never set from the main volume header once it is located and
so it tries to find the backup volume at the (dummy) block 3 which inevitably
fails.
On a secondary note until towards the end of the function, volume_open()
assumes the block size is 512 bytes. Therefore once we determine the size of
the volume from the main volume header in blocks, we need to convert it from
the block size indicated in the volume header to a fixed 512 byte block
size in order for the alternate volume header to be located correctly.
Signed-off-by: Mark Cave-Ayland <mark.cave-ayland(a)ilande.co.uk>
---
openbios-devel/fs/hfsplus/hfsp_volume.c | 13 +++++++++++--
1 file changed, 11 insertions(+), 2 deletions(-)
diff --git a/openbios-devel/fs/hfsplus/hfsp_volume.c b/openbios-devel/fs/hfsplus/hfsp_volume.c
index 802d700..e6d9d60 100644
--- a/openbios-devel/fs/hfsplus/hfsp_volume.c
+++ b/openbios-devel/fs/hfsplus/hfsp_volume.c
@@ -171,7 +171,9 @@ volume_read_wrapper(volume * vol, hfsp_vh* vh)
UInt16 signature;
char buf[vol->blksize];
char *p = buf;
-
+ int ret;
+ UInt64 vol_size;
+
if( volume_readinbuf(vol, buf, 2) ) // Wrapper or volume header starts here
return -1;
@@ -202,7 +204,14 @@ volume_read_wrapper(volume * vol, hfsp_vh* vh)
}
else if( signature == HFSP_VOLHEAD_SIG) { /* Native HFS+ volume */
p = buf; // Restore to begin of block
- return volume_readbuf(vh, p);
+ ret = volume_readbuf(vh, p);
+ if( !ret ) {
+ /* When reading the initial partition we must use 512 byte blocks */
+ vol_size = vh->blocksize * vh->total_blocks;
+ vol->maxblocks = vol_size / HFSP_BLOCKSZ;
+ }
+
+ return ret;
} else
HFSP_ERROR(-1, "Neither Wrapper nor native HFS+ volume header found");
fail:
--
1.7.10.4
Is there a way to make QEMU not use 100% of the CPU time when OpenBIOS is just at the console? My guess is OpenBIOS is in some kind of loop, polling the keyboard for events, when it should probably be interrupt based. Anybody have a clue as to what we need to change?
The get-time word is a word that is used to obtain the current time. It is used on Apple's Open Firmware.
signed-off-by: John Arbuckle <programmingkidx(a)gmail.com>
---
forth/system/main.fs | 21 +++++++++++++++++++++
1 files changed, 21 insertions(+), 0 deletions(-)
diff --git a/forth/system/main.fs b/forth/system/main.fs
index 122ab1f..6867cf3 100644
--- a/forth/system/main.fs
+++ b/forth/system/main.fs
@@ -58,3 +58,24 @@ variable DIAG-list
outer-interpreter
;
+
+\ Returns the time ( -- second minute hour day month year )
+: get-time
+ " get-time" ( addr len )
+ " rtc" open-dev ( addr len device )
+ dup ( addr len device device )
+
+ 0= if \ if the real-time clock isn't available
+ cr
+ 3drop ( )
+ true ( flag )
+ abort" Sorry but get-time isn't available for your system. "
+ then
+
+ dup ( addr len device device )
+ >R ( addr len device ) ( R: device )
+ $call-method ( addr len device -- ) ( R: device )
+ R> ( device ) ( R: )
+ close-dev ( device -- )
+;
+
--
1.7.5.4
On Sep 20, 2012, at 1:32 PM, openbios-request(a)openbios.org wrote:
> Message: 4
> Date: Tue, 18 Sep 2012 16:31:40 +0100
> From: Mark Cave-Ayland <mark.cave-ayland(a)ilande.co.uk>
> To: openbios(a)openbios.org
> Cc: Mark Cave-Ayland <mark.cave-ayland(a)ilande.co.uk>
> Subject: [OpenBIOS] [PATCH 3/3] Add initial implementation of "dir"
> word for HFS+ filesystems.
> Message-ID:
> <1347982300-14648-3-git-send-email-mark.cave-ayland(a)ilande.co.uk>
>
> Signed-off-by: Mark Cave-Ayland <mark.cave-ayland(a)ilande.co.uk>
> ---
> openbios-devel/fs/hfsplus/hfsp_fs.c | 140 ++++++++++++++++++++++++++++++++++-
> 1 file changed, 136 insertions(+), 4 deletions(-)
>
> diff --git a/openbios-devel/fs/hfsplus/hfsp_fs.c b/openbios-devel/fs/hfsplus/hfsp_fs.c
> index 83e4d8d..4cc6ddc 100644
> --- a/openbios-devel/fs/hfsplus/hfsp_fs.c
> +++ b/openbios-devel/fs/hfsplus/hfsp_fs.c
> @@ -437,14 +437,146 @@ hfsp_files_volume_name( hfsp_info_t *mi )
> PUSH(pointer2cell(volname));
From the output you shown us, it looks like the patch works. Those were the files that were on the image file I sent you. I wanted to test it out myself but I couldn't apply your patch. Probably something I did wrong. I suggest applying the patches. They look good.
On Sep 20, 2012, at 1:32 PM, openbios-request(a)openbios.org wrote:
> Okay I've got it - looks like volume_open() currently gets confused when
> trying to open a volume where the block size is not 512 bytes (in the
> case of your CD image it is 4096 bytes). I have now implemented a basic
> dir word (patch to follow shortly) which gives the following output
> against your image:
>
>
> Welcome to OpenBIOS v1.0 built on Sep 18 2012 15:11
>
> 0 > dir cd:2,\
> 6148 2012-09-11 13:41:40 .DS_Store
> 0 2012-09-11 13:41:20 .fseventsd\
> 0 2012-09-11 13:41:20 .HFS+ Private Directory Data?\
> 0 2012-09-11 13:42:08 .TemporaryItems\
> 0 2012-09-11 13:41:20 .Trashes\
> 0 2012-09-11 13:41:40 Folder 1\
> 0 2012-09-11 13:41:44 Folder 2\
> 29 2012-09-11 13:42:08 readme.txt
> 0 2012-09-11 13:41:20 HFS+ Private Data\
> ok
> 0 > dir cd:2,\.fseventsd
> 294 2012-09-11 13:42:57 0000000007c7a66b
> 36 2012-09-11 13:41:20 fseventsd-uuid
> ok
> 0 > dir cd:2,\Folder 1
> (Empty folder)
> ok
> 0 > dir cd:2,\Folder 2
> (Empty folder)
> ok
> 0 > dir cd:2,\Folder 3
> Unable to locate path \Folder 3 on filesystem
> ok
>
>
> Note that we don't (yet) do autolocation of partitions which is why the
> cd:2 notation is needed to manually point towards the second partition
> on the CD. Please test and let me know how you get on with your original
> Apple CD.
>
>
> ATB,
>
> Mark.
Thank you so much for finally fixing this word. I will test out the patch in a couple of days.
I want to access the time in OpenBIOS. Is there a word to do this already? If not, is there a way to access the time directly from the clock on QEMU using the Macintosh target?