diff options
Diffstat (limited to 'qemu/roms/openbios/forth/device/device.fs')
| -rw-r--r-- | qemu/roms/openbios/forth/device/device.fs | 202 |
1 files changed, 0 insertions, 202 deletions
diff --git a/qemu/roms/openbios/forth/device/device.fs b/qemu/roms/openbios/forth/device/device.fs deleted file mode 100644 index 562c9196e..000000000 --- a/qemu/roms/openbios/forth/device/device.fs +++ /dev/null @@ -1,202 +0,0 @@ -\ tag: Package creation and deletion -\ -\ this code implements IEEE 1275-1994 -\ -\ Copyright (C) 2003, 2004 Samuel Rydh -\ -\ See the file "COPYING" for further information about -\ the copyright and warranty status of this work. -\ - -variable device-tree - -\ make defined words globally visible -\ -: external ( -- ) - active-package ?dup if - >dn.methods @ set-current - then -; - -\ make the private wordlist active (not an OF word) -\ -: private ( -- ) - active-package ?dup if - >r - forth-wordlist r@ >dn.methods @ r@ >dn.priv-methods @ 3 set-order - r> >dn.priv-methods @ set-current - then -; - -\ set activate package and make the world visible package wordlist -\ the current one. -\ -: active-package! ( phandle -- ) - dup to active-package - \ locally defined words are not available - ?dup if - forth-wordlist over >dn.methods @ 2 set-order - >dn.methods @ set-current - else - forth-wordlist dup 1 set-order set-current - then -; - - -\ new-device ( -- ) -\ -\ Start new package, as child of active package. -\ Create a new device node as a child of the active package and make the -\ new node the active package. Create a new instance and make it the current -\ instance; the instance that invoked new-device becomes the parent instance -\ of the new instance. -\ Subsequently, newly defined Forth words become the methods of the new node -\ and newly defined data items (such as types variable, value, buffer:, and -\ defer) are allocated and stored within the new instance. - -: new-device ( -- ) - align-tree dev-node.size alloc-tree >r - active-package - dup r@ >dn.parent ! - - \ ( parent ) hook up at the end of the peer list - ?dup if - >dn.child - begin dup @ while @ >dn.peer repeat - r@ swap ! - else - \ we are the root node! - r@ to device-tree - then - - \ ( -- ) fill in device node stuff - inst-node.size r@ >dn.isize ! - - \ create two wordlists - wordlist r@ >dn.methods ! - wordlist r@ >dn.priv-methods ! - - \ initialize template data - r@ >dn.itemplate - r@ over >in.device-node ! - my-self over >in.my-parent ! - - \ make it the active package and current instance - to my-self - r@ active-package! - - \ swtich to public wordlist - external - r> drop -; - -\ helpers for finish-device (OF does not actually define words -\ for device node deletion) - -: (delete-device) \ ( phandle ) - >r - r@ >dn.parent @ - ?dup if - >dn.child \ ( &first-child ) - begin dup @ r@ <> while @ >dn.peer repeat - r@ >dn.peer @ swap ! - else - \ root node - 0 to device-tree - then - - \ XXX: free any memory related to this node. - \ we could have a list with free device-node headers... - r> drop -; - -: delete-device \ ( phandle ) - >r - \ first, get rid of any children - begin r@ >dn.child @ dup while - (delete-device) - repeat - drop - - \ then free this node - r> (delete-device) -; - -\ finish-device ( -- ) -\ -\ Finish this package, set active package to parent. -\ Complete a device node that was created by new-device, as follows: If the -\ device node has no "name" property, remove the device node from the device -\ tree. Otherwise, save the current values of the current instance's -\ initialized data items within the active package for later use in -\ initializing the data items of instances created from that node. In any -\ case, destroy the current instance, make its parent instance the current -\ instance, and select the parent node of the device node just completed, -\ making the parent node the active package again. - -: finish-device \ ( -- ) - my-self - dup >in.device-node @ >r - >in.my-parent @ to my-self - - ( -- ) - r@ >dn.parent @ active-package! - s" name" r@ get-package-property if - \ delete the node (and any children) - r@ delete-device - else - 2drop - \ node OK - then - r> drop -; - - -\ helper function which creates and initializes an instance. -\ open is not called. The current instance is not changed. -\ -: create-instance ( phandle -- ihandle|0 ) - dup >dn.isize @ ['] alloc-mem catch if 2drop 0 exit then - >r - \ we need to save the size in order to be able to release it properly - dup >dn.isize @ r@ >in.alloced-size ! - - \ clear memory (we only need to clear the head; all other data is copied) - r@ inst-node.size 0 fill - - ( phandle R: ihandle ) - - \ instantiate data - dup >dn.methods @ r@ instance-init - dup >dn.priv-methods @ r@ instance-init - - \ instantiate - dup >dn.itemplate r@ inst-node.size move - r@ r@ >in.instance-data ! - my-self r@ >in.my-parent ! - drop - - r> -; - -\ helper function which tears down and frees an instance -: destroy-instance ( ihandle ) - ?dup if - \ free arguments - dup >in.arguments 2@ free-mem - \ and the instance block - dup >in.alloced-size @ - free-mem - then -; - -\ Redefine to word so that statements of the form "0 to active-package" -\ are supported for bootloaders that require it -: to - ['] ' execute - dup ['] active-package = if - drop active-package! - else - (to-xt) - then -; immediate |