![[BACK]](/cvsweb/icons/back.gif){kind=icon}
Return to device.fs CVS log ![[TXT]](/cvsweb/icons/text.gif){kind=icon}
![[DIR]](/cvsweb/icons/dir.gif){kind=icon}
Up to [Qemu by Fabrice Bellard] / qemu / roms / openbios / forth / device|
Return to device.fs CVS log | Up to [Qemu by Fabrice Bellard] / qemu / roms / openbios / forth / device |
1.1 ! root 1: \ tag: Package creation and deletion ! 2: \ ! 3: \ this code implements IEEE 1275-1994 ! 4: \ ! 5: \ Copyright (C) 2003, 2004 Samuel Rydh ! 6: \ ! 7: \ See the file "COPYING" for further information about ! 8: \ the copyright and warranty status of this work. ! 9: \ ! 10: ! 11: variable device-tree ! 12: ! 13: \ make defined words globally visible ! 14: \ ! 15: : external ( -- ) ! 16: active-package ?dup if ! 17: >dn.methods @ set-current ! 18: then ! 19: ; ! 20: ! 21: \ make the private wordlist active (not an OF word) ! 22: \ ! 23: : private ( -- ) ! 24: active-package ?dup if ! 25: >r ! 26: forth-wordlist r@ >dn.methods @ r@ >dn.priv-methods @ 3 set-order ! 27: r> >dn.priv-methods @ set-current ! 28: then ! 29: ; ! 30: ! 31: \ set activate package and make the world visible package wordlist ! 32: \ the current one. ! 33: \ ! 34: : active-package! ( phandle -- ) ! 35: dup to active-package ! 36: \ locally defined words are not available ! 37: ?dup if ! 38: forth-wordlist over >dn.methods @ 2 set-order ! 39: >dn.methods @ set-current ! 40: else ! 41: forth-wordlist dup 1 set-order set-current ! 42: then ! 43: ; ! 44: ! 45: ! 46: \ new-device ( -- ) ! 47: \ ! 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. ! 56: ! 57: : new-device ( -- ) ! 58: align-tree dev-node.size alloc-tree >r ! 59: active-package ! 60: dup r@ >dn.parent ! ! 61: ! 62: \ ( parent ) hook up at the end of the peer list ! 63: ?dup if ! 64: >dn.child ! 65: begin dup @ while @ >dn.peer repeat ! 66: r@ swap ! ! 67: else ! 68: \ we are the root node! ! 69: r@ to device-tree ! 70: then ! 71: ! 72: \ ( -- ) fill in device node stuff ! 73: inst-node.size r@ >dn.isize ! ! 74: ! 75: \ create two wordlists ! 76: wordlist r@ >dn.methods ! ! 77: wordlist r@ >dn.priv-methods ! ! 78: ! 79: \ initialize template data ! 80: r@ >dn.itemplate ! 81: r@ over >in.device-node ! ! 82: my-self over >in.my-parent ! ! 83: ! 84: \ make it the active package and current instance ! 85: to my-self ! 86: r@ active-package! ! 87: ! 88: \ swtich to public wordlist ! 89: external ! 90: r> drop ! 91: ; ! 92: ! 93: \ helpers for finish-device (OF does not actually define words ! 94: \ for device node deletion) ! 95: ! 96: : (delete-device) \ ( phandle ) ! 97: >r ! 98: r@ >dn.parent @ ! 99: ?dup if ! 100: >dn.child \ ( &first-child ) ! 101: begin dup @ r@ <> while @ >dn.peer repeat ! 102: r@ >dn.peer @ swap ! ! 103: else ! 104: \ root node ! 105: 0 to device-tree ! 106: then ! 107: ! 108: \ XXX: free any memory related to this node. ! 109: \ we could have a list with free device-node headers... ! 110: r> drop ! 111: ; ! 112: ! 113: : delete-device \ ( phandle ) ! 114: >r ! 115: \ first, get rid of any children ! 116: begin r@ >dn.child @ dup while ! 117: (delete-device) ! 118: repeat ! 119: drop ! 120: ! 121: \ then free this node ! 122: r> (delete-device) ! 123: ; ! 124: ! 125: \ finish-device ( -- ) ! 126: \ ! 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. ! 136: ! 137: : finish-device \ ( -- ) ! 138: my-self ! 139: dup >in.device-node @ >r ! 140: >in.my-parent @ to my-self ! 141: ! 142: ( -- ) ! 143: r@ >dn.parent @ active-package! ! 144: s" name" r@ get-package-property if ! 145: \ delete the node (and any children) ! 146: r@ delete-device ! 147: else ! 148: 2drop ! 149: \ node OK ! 150: then ! 151: r> drop ! 152: ; ! 153: ! 154: ! 155: \ helper function which creates and initializes an instance. ! 156: \ open is not called. The current instance is not changed. ! 157: \ ! 158: : create-instance ( phandle -- ihandle|0 ) ! 159: dup >dn.isize @ ['] alloc-mem catch if 2drop 0 exit then ! 160: >r ! 161: \ we need to save the size in order to be able to release it properly ! 162: dup >dn.isize @ r@ >in.alloced-size ! ! 163: ! 164: \ clear memory (we only need to clear the head; all other data is copied) ! 165: r@ inst-node.size 0 fill ! 166: ! 167: ( phandle R: ihandle ) ! 168: ! 169: \ instantiate data ! 170: dup >dn.methods @ r@ instance-init ! 171: dup >dn.priv-methods @ r@ instance-init ! 172: ! 173: \ instantiate ! 174: dup >dn.itemplate r@ inst-node.size move ! 175: r@ r@ >in.instance-data ! ! 176: my-self r@ >in.my-parent ! ! 177: drop ! 178: ! 179: r> ! 180: ; ! 181: ! 182: \ helper function which tears down and frees an instance ! 183: : destroy-instance ( ihandle ) ! 184: ?dup if ! 185: \ free arguments ! 186: dup >in.arguments 2@ free-mem ! 187: \ and the instance block ! 188: dup >in.alloced-size @ ! 189: free-mem ! 190: then ! 191: ;
This archive runs on limited infrastructure. Preserving old code on modern bandwidth. Automated agents are requested to crawl responsibly.