1 \ tag: Package creation and deletion
3 \ this code implements IEEE 1275-1994
5 \ Copyright (C) 2003, 2004 Samuel Rydh
7 \ See the file "COPYING" for further information about
8 \ the copyright and warranty status of this work.
13 \ make defined words globally visible
16 active-package ?dup if
17 >dn.methods @ set-current
21 \ make the private wordlist active (not an OF word)
24 active-package ?dup if
26 forth-wordlist r@ >dn.methods @ r@ >dn.priv-methods @ 3 set-order
27 r> >dn.priv-methods @ set-current
31 \ set activate package and make the world visible package wordlist
34 : active-package! ( phandle -- )
36 \ locally defined words are not available
38 forth-wordlist over >dn.methods @ 2 set-order
39 >dn.methods @ set-current
41 forth-wordlist dup 1 set-order set-current
48 \ Start new package, as child of active package.
49 \ Create a new device node as a child of the active package and make the
50 \ new node the active package. Create a new instance and make it the current
51 \ instance; the instance that invoked new-device becomes the parent instance
52 \ of the new instance.
53 \ Subsequently, newly defined Forth words become the methods of the new node
54 \ and newly defined data items (such as types variable, value, buffer:, and
55 \ defer) are allocated and stored within the new instance.
58 align-tree dev-node.size alloc-tree >r
62 \ ( parent ) hook up at the end of the peer list
65 begin dup @ while @ >dn.peer repeat
68 \ we are the root node!
72 \ ( -- ) fill in device node stuff
73 inst-node.size r@ >dn.isize !
75 \ create two wordlists
76 wordlist r@ >dn.methods !
77 wordlist r@ >dn.priv-methods !
79 \ initialize template data
81 r@ over >in.device-node !
82 my-self over >in.my-parent !
84 \ make it the active package and current instance
88 \ swtich to public wordlist
93 \ helpers for finish-device (OF does not actually define words
94 \ for device node deletion)
96 : (delete-device) \ ( phandle )
100 >dn.child \ ( &first-child )
101 begin dup @ r@ <> while @ >dn.peer repeat
108 \ XXX: free any memory related to this node.
109 \ we could have a list with free device-node headers...
113 : delete-device \ ( phandle )
115 \ first, get rid of any children
116 begin r@ >dn.child @ dup while
121 \ then free this node
125 \ finish-device ( -- )
127 \ Finish this package, set active package to parent.
128 \ Complete a device node that was created by new-device, as follows: If the
129 \ device node has no "name" property, remove the device node from the device
130 \ tree. Otherwise, save the current values of the current instance's
131 \ initialized data items within the active package for later use in
132 \ initializing the data items of instances created from that node. In any
133 \ case, destroy the current instance, make its parent instance the current
134 \ instance, and select the parent node of the device node just completed,
135 \ making the parent node the active package again.
137 : finish-device \ ( -- )
139 dup >in.device-node @ >r
140 >in.my-parent @ to my-self
143 r@ >dn.parent @ active-package!
144 s" name" r@ get-package-property if
145 \ delete the node (and any children)
155 \ helper function which creates and initializes an instance.
156 \ open is not called. The current instance is not changed.
158 : create-instance ( phandle -- ihandle|0 )
159 dup >dn.isize @ ['] alloc-mem catch if 2drop 0 exit then
161 \ we need to save the size in order to be able to release it properly
162 dup >dn.isize @ r@ >in.alloced-size !
164 \ clear memory (we only need to clear the head; all other data is copied)
165 r@ inst-node.size 0 fill
167 ( phandle R: ihandle )
170 dup >dn.methods @ r@ instance-init
171 dup >dn.priv-methods @ r@ instance-init
174 dup >dn.itemplate r@ inst-node.size move
175 r@ r@ >in.instance-data !
176 my-self r@ >in.my-parent !
182 \ helper function which tears down and frees an instance
183 : destroy-instance ( ihandle )
186 dup >in.arguments 2@ free-mem
187 \ and the instance block
188 dup >in.alloced-size @
193 \ Redefine to word so that statements of the form "0 to active-package"
194 \ are supported for bootloaders that require it
197 dup ['] active-package = if