Improved node/instance handling.
The INSTANCE keyword can not be used while a node is opened (since it changes
the node>instance field that is also used for allocating the necessary amount
of memory for an instance). Since I experienced some bad and hard-to-debug
crashes when accidentially running into this problem, I now added a proper
error handling to the INSTANCE keyword.
Also improved my-space, my-address and my-unit a little bit so that these
node specific words now can also be used without an active instance.
Signed-off-by: Thomas Huth <thuth@linux.vnet.ibm.com>
diff --git a/slof/fs/instance.fs b/slof/fs/instance.fs
index 03e6662..7f90342 100644
--- a/slof/fs/instance.fs
+++ b/slof/fs/instance.fs
@@ -22,6 +22,8 @@
: (create-instance-var) ( initial-value -- )
get-node ?dup 0= ABORT" Instance word outside device context!"
+ dup node>extending? @ 0=
+ my-self 0<> AND ABORT" INSTANCE word can not be used while node is opened!"
dup node>instance @ ( iv phandle tmp-ihandle )
swap node>instance-size dup @ ( iv tmp-ih *instance-size instance-size )
dup , \ compile current instance ptr
diff --git a/slof/fs/node.fs b/slof/fs/node.fs
index 085cd9d..e747b5e 100644
--- a/slof/fs/node.fs
+++ b/slof/fs/node.fs
@@ -30,6 +30,7 @@
cell FIELD node>addr1
cell FIELD node>addr2
cell FIELD node>addr3
+ cell FIELD node>extending?
END-STRUCT
: find-method ( str len phandle -- false | xt true )
@@ -42,9 +43,17 @@
3000000 CONSTANT space-code-mask
: create-node ( parent -- new )
- max-instance-size alloc-mem dup max-instance-size erase >r
- align wordlist >r wordlist >r
- here 0 , swap , 0 , r> , r> , r> , /instance-header , 0 , 0 , 0 , 0 , ;
+ max-instance-size alloc-mem ( parent instance-mem )
+ dup max-instance-size erase >r ( parent R: instance-mem )
+ align wordlist >r wordlist >r ( parent R: instance-mem wl wl )
+ here ( parent new R: instance-mem wl wl )
+ 0 , swap , 0 , \ Set node>peer, node>parent & node>child
+ r> , r> , \ Set node>properties & node>words to wl
+ r> , /instance-header , \ Set node>instance & node>instance-size
+ FALSE , 0 , \ Set node>space? and node>space
+ 0 , 0 , 0 , \ Set node>addr*
+ TRUE , \ Set node>extending?
+;
: peer node>peer @ ;
: parent node>parent @ ;
@@ -146,15 +155,24 @@
1 > IF r@ node>addr1 @ THEN r> drop ;
: >unit dup >r >address r> >space ;
+: (my-phandle) ( -- phandle )
+ my-self ?dup IF
+ ihandle>phandle
+ ELSE
+ get-node dup 0= ABORT" no active node"
+ THEN
+;
+
: my-space ( -- phys.hi )
- my-self ihandle>phandle >space ;
-: my-address my-self ihandle>phandle >address ;
-: my-unit my-self ihandle>phandle >unit ;
+ (my-phandle) >space
+;
+: my-address (my-phandle) >address ;
+: my-unit (my-phandle) >unit ;
\ Return lower 64 bit of address
: my-unit-64 ( -- phys.lo+1|phys.lo )
my-unit ( phys.lo ... phys.hi )
- my-self ihandle>phandle #address-cells ( phys.lo ... phys.hi #ad-cells )
+ (my-phandle) #address-cells ( phys.lo ... phys.hi #ad-cells )
CASE
1 OF EXIT ENDOF
2 OF lxjoin EXIT ENDOF
@@ -323,9 +341,12 @@
: new-device ( -- )
my-self new-node node>instance @ dup to my-self instance>parent !
get-node my-self instance>node ! ;
+
: finish-device ( -- )
- ( check for "name" property here, delete this node if not there )
- finish-node my-parent my-self max-instance-size free-mem to my-self ;
+ FALSE get-node node>extending? !
+ ( check for "name" property here, delete this node if not there )
+ finish-node my-parent my-self max-instance-size free-mem to my-self
+;
: split ( str len char -- left len right len )
>r 2dup r> findchar IF >r over r@ 2swap r> 1+ /string ELSE 0 0 THEN ;
