![[BACK]](/cvsweb/icons/back.gif){kind=icon}
Return to property.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 property.fs CVS log | Up to [Qemu by Fabrice Bellard] / qemu / roms / openbios / forth / device |
1.1 ! root 1: \ tag: Property management ! 2: \ ! 3: \ this code implements IEEE 1275-1994 ch. 5.3.5 ! 4: \ ! 5: \ Copyright (C) 2003 Stefan Reinauer ! 6: \ ! 7: \ See the file "COPYING" for further information about ! 8: \ the copyright and warranty status of this work. ! 9: \ ! 10: ! 11: \ small helpers.. these should go elsewhere. ! 12: : bigendian? ! 13: 10 here ! here c@ 10 <> ! 14: ; ! 15: ! 16: : l!-be ( val addr ) ! 17: 3 bounds swap do ! 18: dup ff and i c! ! 19: 8 rshift ! 20: -1 +loop ! 21: drop ! 22: ; ! 23: ! 24: : l@-be ( addr ) ! 25: 0 swap 4 bounds do ! 26: i c@ swap 8 << or ! 27: loop ! 28: ; ! 29: ! 30: \ allocate n bytes for device tree information ! 31: \ until I know where to put this, I put it in the ! 32: \ dictionary. ! 33: ! 34: : alloc-tree ( n -- addr ) ! 35: dup >r \ save len ! 36: here swap allot ! 37: dup r> 0 fill \ clear memory ! 38: ; ! 39: ! 40: : align-tree ( -- ) ! 41: null-align ! 42: ; ! 43: ! 44: : no-active true abort" no active package." ; ! 45: ! 46: \ ! 47: \ 5.3.5 Property management ! 48: \ ! 49: ! 50: \ Helper function ! 51: : find-property ( name len phandle -- &&prop|0 ) ! 52: >dn.properties ! 53: begin ! 54: dup @ ! 55: while ! 56: dup @ >prop.name @ ( name len prop propname ) ! 57: 2over comp0 ( name len prop equal? ) ! 58: 0= if nip nip exit then ! 59: >prop.next @ ! 60: repeat ! 61: ( name len false ) ! 62: 3drop false ! 63: ; ! 64: ! 65: \ From package (5.3.4.1) ! 66: : next-property ! 67: ( previous-str previous-len phandle -- false | name-str name-len true ) ! 68: >r ! 69: 2dup 0= swap 0= or if ! 70: 2drop r> >dn.properties @ ! 71: else ! 72: r> find-property dup if @ then ! 73: ?dup if >prop.next @ then ! 74: then ! 75: ! 76: ?dup if ! 77: >prop.name @ dup cstrlen true ! 78: ( phandle name-str name-len true ) ! 79: else ! 80: false ! 81: then ! 82: ; ! 83: ! 84: ! 85: \ ! 86: \ 5.3.5.4 Property value access ! 87: \ ! 88: ! 89: \ Return value for name string property in package phandle. ! 90: : get-package-property ! 91: ( name-str name-len phandle -- true | prop-addr prop-len false ) ! 92: find-property ?dup if ! 93: @ dup >prop.addr @ ! 94: swap >prop.len @ ! 95: false ! 96: else ! 97: true ! 98: then ! 99: ; ! 100: ! 101: \ Return value for given property in the current instance or its parents. ! 102: : get-inherited-property ! 103: ( name-str name-len -- true | prop-addr prop-len false ) ! 104: my-self ! 105: begin ! 106: ?dup ! 107: while ! 108: dup >in.device-node @ ( str len ihandle phandle ) ! 109: 2over rot find-property ?dup if ! 110: @ ! 111: ( str len ihandle prop ) ! 112: nip nip nip ( prop ) ! 113: dup >prop.addr @ swap >prop.len @ ! 114: false ! 115: exit ! 116: then ! 117: ( str len ihandle ) ! 118: >in.my-parent @ ! 119: repeat ! 120: 2drop ! 121: true ! 122: ; ! 123: ! 124: \ Return value for given property in this package. ! 125: : get-my-property ( name-str name-len -- true | prop-addr prop-len false ) ! 126: my-self >in.device-node @ ( -- phandle ) ! 127: get-package-property ! 128: ; ! 129: ! 130: ! 131: \ ! 132: \ 5.3.5.2 Property array decoding ! 133: \ ! 134: ! 135: : decode-int ( prop-addr1 prop-len1 -- prop-addr2 prop-len2 n ) ! 136: dup 0> if ! 137: dup 4 min >r ( addr1 len1 R:minlen ) ! 138: over r@ + swap ( addr1 addr2 len1 R:minlen ) ! 139: r> - ( addr1 addr2 len2 ) ! 140: rot l@-be ! 141: else ! 142: 0 ! 143: then ! 144: ; ! 145: ! 146: \ HELPER: get #address-cell value (from parent) ! 147: \ Legal values are 1..4 (we may optionally support longer addresses) ! 148: : my-#acells ( -- #address-cells ) ! 149: my-self ?dup if >in.device-node @ else active-package then ! 150: ?dup if >dn.parent @ then ! 151: ?dup if ! 152: " #address-cells" rot get-package-property if 2 exit then ! 153: \ we don't have to support more than 4 (and 0 is illegal) ! 154: decode-int nip nip 4 min 1 max ! 155: else ! 156: 2 ! 157: then ! 158: ; ! 159: ! 160: \ HELPER: get #size-cells value (from parent) ! 161: : my-#scells ( -- #size-cells ) ! 162: my-self ?dup if >in.device-node @ else active-package then ! 163: ?dup if >dn.parent @ then ! 164: ?dup if ! 165: " #size-cells" rot get-package-property if 1 exit then ! 166: decode-int nip nip ! 167: else ! 168: 1 ! 169: then ! 170: ; ! 171: ! 172: : decode-string ( prop-addr1 prop-len1 -- prop-addr2 prop-len2 str len ) ! 173: dup 0> if ! 174: 2dup bounds \ check property for 0 bytes ! 175: 0 -rot \ initial string len is 0 ! 176: do ! 177: i c@ 0= if ! 178: leave ! 179: then ! 180: 1+ ! 181: loop ( prop-addr1 prop-len1 len ) ! 182: 1+ rot >r ( prop-len1 len R: prop-addr1 ) ! 183: over min 2dup - ( prop-len1 nlen prop-len2 R: prop-addr1 ) ! 184: r@ 2 pick + ( prop-len1 nlen prop-len2 prop-addr2 ) ! 185: >r >r >r ( R: prop-addr1 prop-addr2 prop-len2 nlen ) ! 186: drop ! 187: r> r> r> ( nlen prop-len2 prop-addr2 ) ! 188: -rot swap ( prop-addr2 prop-len2 nlen ) ! 189: r> swap ( prop-addr2 prop-len2 str len ) ! 190: else ! 191: 0 0 ! 192: then ! 193: ; ! 194: ! 195: : decode-bytes ( addr1 len1 #bytes -- addr len2 addr1 #bytes ) ! 196: tuck - ( addr1 #bytes len2 ) ! 197: r> 2dup + ( addr1 #bytes addr2 ) ( R: len2 ) ! 198: r> 2swap ! 199: ; ! 200: ! 201: : decode-phys ! 202: ( prop-addr1 prop-len1 -- prop-addr2 prop-len2 phys.lo ... phys.hi ) ! 203: my-#acells 0 ?do ! 204: decode-int r> r> rot >r >r >r ! 205: loop ! 206: my-#acells 0 ?do ! 207: r> r> r> -rot >r >r ! 208: loop ! 209: ; ! 210: ! 211: ! 212: \ ! 213: \ 5.3.5.1 Property array encoding ! 214: \ ! 215: ! 216: : encode-int ( n -- prop-addr prop-len ) ! 217: /l alloc-tree tuck l!-be /l ! 218: ; ! 219: ! 220: : encode-string ( str len -- prop-addr prop-len ) ! 221: \ we trust len here. should probably check string? ! 222: tuck char+ alloc-tree ( len str prop-addr ) ! 223: tuck 3 pick move ( len prop-addr ) ! 224: swap 1+ ! 225: ; ! 226: ! 227: : encode-bytes ( data-addr data-len -- prop-addr prop-len ) ! 228: tuck alloc-tree ( len str prop-addr ) ! 229: tuck 3 pick move ! 230: swap ! 231: ; ! 232: ! 233: : encode+ ( prop-addr1 prop-len1 prop-addr2 prop-len2 -- prop-addr3 prop-len3 ) ! 234: nip + ! 235: ; ! 236: ! 237: : encode-phys ( phys.lo ... phys.hi -- prop-addr prop-len ) ! 238: encode-int my-#acells 1- 0 ?do ! 239: rot encode-int encode+ ! 240: loop ! 241: ; ! 242: ! 243: defer sbus-intr>cpu ( sbus-intr# -- cpu-intr# ) ! 244: : (sbus-intr>cpu) ." No SBUS present on this machine." cr ; ! 245: ['] (sbus-intr>cpu) to sbus-intr>cpu ! 246: ! 247: ! 248: \ ! 249: \ 5.3.5.3 Property declaration ! 250: \ ! 251: ! 252: : (property) ( prop-addr prop-len name-str name-len dnode -- ) ! 253: >r 2dup r@ ! 254: align-tree ! 255: find-property ?dup if ! 256: \ If a property with that property name already exists in the ! 257: \ package in which the property would be created, replace its ! 258: \ value with the new value. ! 259: @ r> drop \ don't need the device node anymore. ! 260: -rot 2drop tuck \ drop property name ! 261: >prop.len ! \ overwrite old values ! 262: >prop.addr ! ! 263: exit ! 264: then ! 265: ! 266: ( prop-addr prop-len name-str name-len R: dn ) ! 267: prop-node.size alloc-tree ! 268: dup >prop.next off ! 269: ! 270: dup r> >dn.properties ! 271: begin dup @ while @ >prop.next repeat ! ! 272: >r ! 273: ! 274: ( prop-addr prop-len name-str name-len R: prop ) ! 275: ! 276: \ create copy of property name ! 277: dup char+ alloc-tree ! 278: dup >r swap move r> ! 279: ( prop-addr prop-len new-name R: prop ) ! 280: r@ >prop.name ! ! 281: r@ >prop.len ! ! 282: r> >prop.addr ! ! 283: align-tree ! 284: ; ! 285: ! 286: : property ( prop-addr prop-len name-str name-len -- ) ! 287: my-self ?dup if ! 288: >in.device-node @ ! 289: else ! 290: active-package ! 291: then ! 292: dup if ! 293: (property) ! 294: else ! 295: no-active ! 296: then ! 297: ; ! 298: ! 299: : (delete-property) ( name len dnode -- ) ! 300: find-property ?dup if ! 301: dup @ >prop.next @ swap ! ! 302: \ maybe we should try to reclaim the space? ! 303: then ! 304: ; ! 305: ! 306: : delete-property ( name-str name-len -- ) ! 307: active-package ?dup if ! 308: (delete-property) ! 309: else ! 310: 2drop ! 311: then ! 312: ; ! 313: ! 314: \ Create the "name" property; value is indicated string. ! 315: : device-name ( str len -- ) ! 316: encode-string " name" property ! 317: ; ! 318: ! 319: \ Create "device_type" property, value is indicated string. ! 320: : device-type ( str len -- ) ! 321: encode-string " device_type" property ! 322: ; ! 323: ! 324: \ Create the "reg" property with the given values. ! 325: : reg ( phys.lo ... phys.hi size -- ) ! 326: >r ( phys.lo ... phys.hi ) encode-phys ( addr len ) ! 327: r> ( addr1 len1 size ) encode-int ( addr1 len1 addr2 len2 ) ! 328: encode+ ( addr len ) ! 329: " reg" property ! 330: ; ! 331: ! 332: \ Create the "model" property; value is indicated string. ! 333: : model ( str len -- ) ! 334: encode-string " model" property ! 335: ;
This archive runs on limited infrastructure. Preserving old code on modern bandwidth. Automated agents are requested to crawl responsibly.