![[BACK]](/cvsweb/icons/back.gif){kind=icon}
Return to devices.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 / admin|
Return to devices.fs CVS log | Up to [Qemu by Fabrice Bellard] / qemu / roms / openbios / forth / admin |
1.1 ! root 1: \ tag: device tree administration ! 2: \ ! 3: \ this code implements IEEE 1275-1994 ! 4: \ ! 5: \ Copyright (C) 2003 Samuel Rydh ! 6: \ Copyright (C) 2003-2006 Stefan Reinauer ! 7: \ ! 8: \ See the file "COPYING" for further information about ! 9: \ the copyright and warranty status of this work. ! 10: \ ! 11: ! 12: ! 13: \ 7.4.11.1 Device alias ! 14: ! 15: : devalias ( "{alias-name}< >{device-specifier}<cr>" -- ) ! 16: ; ! 17: ! 18: : nvalias ( "alias-name< >device-specifier<cr>" -- ) ! 19: ; ! 20: ! 21: : $nvalias ( name-str name-len dev-str dev-len -- ) ! 22: ; ! 23: ! 24: : nvunalias ( "alias-name< >" -- ) ! 25: ; ! 26: ! 27: : $nvunalias ( name-str name-len -- ) ! 28: ; ! 29: ! 30: ! 31: \ 7.4.11.2 Device tree browsing ! 32: ! 33: : dev ( "<spaces>device-specifier" -- ) ! 34: bl parse ! 35: find-device ! 36: ; ! 37: ! 38: : cd ! 39: dev ! 40: ; ! 41: ! 42: \ find-device ( dev-str dev-len -- ) ! 43: \ implemented in pathres.fs ! 44: ! 45: : device-end ( -- ) ! 46: 0 active-package! ! 47: ; ! 48: ! 49: \ Open selected device node and make it the current instance ! 50: \ section H.8 errata: pre OpenFirmware, but Sun OBP compatible ! 51: : select-dev ( -- ) ! 52: open-dev dup 0= abort" failed opening parent." ! 53: dup to my-self ! 54: ihandle>phandle active-package! ! 55: ; ! 56: ! 57: \ Close current node, deselect active package and current instance, ! 58: \ leaving no instance selected ! 59: \ section H.8 errata: pre OpenFirmware, but Sun OBP compatible ! 60: : unselect-dev ( -- ) ! 61: my-self close-dev ! 62: device-end ! 63: 0 to my-self ! 64: ; ! 65: ! 66: : begin-package ( arg-str arg-len reg-str reg-len dev-str dev-len -- ) ! 67: select-dev ! 68: new-device ! 69: set-args ! 70: ; ! 71: ! 72: : end-package ( -- ) ! 73: finish-device ! 74: unselect-dev ! 75: ; ! 76: ! 77: : ?active-package ( -- phandle ) ! 78: active-package dup 0= abort" no active device" ! 79: ; ! 80: ! 81: \ ------------------------------------------------------- ! 82: \ path handling ! 83: \ ------------------------------------------------------- ! 84: ! 85: \ used if parent lacks an encode-unit method ! 86: : def-encode-unit ( unitaddr ... ) ! 87: pocket tohexstr ! 88: ; ! 89: ! 90: : get-encode-unit-xt ( phandle.parent -- xt ) ! 91: >dn.parent @ ! 92: " encode-unit" rot find-method ! 93: 0= if ['] def-encode-unit then ! 94: ; ! 95: ! 96: : get-nodename ( phandle -- str len ) ! 97: " name" rot get-package-property if " <noname>" else 1- then ! 98: ; ! 99: ! 100: \ helper, return the node name in the format 'cpus@addr' ! 101: : pnodename ( phandle -- str len ) ! 102: dup get-nodename rot ! 103: dup " reg" rot get-package-property if drop exit then rot ! 104: ! 105: \ set active-package and clear my-self (decode-phys needs this) ! 106: my-self >r 0 to my-self ! 107: active-package >r ! 108: dup active-package! ! 109: ! 110: ( name len prop len phandle ) ! 111: get-encode-unit-xt ! 112: ! 113: ( name len prop len xt ) ! 114: depth >r >r ! 115: decode-phys r> execute ! 116: r> -rot >r >r depth! 3drop ! 117: ! 118: ( name len R: len str ) ! 119: r> r> " @" ! 120: here 20 + \ abuse dictionary for temporary storage ! 121: tmpstrcat >r ! 122: 2swap r> tmpstrcat drop ! 123: pocket tmpstrcpy drop ! 124: ! 125: r> active-package! ! 126: r> to my-self ! 127: ; ! 128: ! 129: : inodename ( ihandle -- str len ) ! 130: my-self over to my-self >r ! 131: ihandle>phandle get-nodename ! 132: ! 133: \ nonzero unit number? ! 134: false >r ! 135: depth >r my-unit r> 1+ ! 136: begin depth over > while ! 137: swap 0<> if r> drop true >r then ! 138: repeat ! 139: drop ! 140: ! 141: \ if not... check for presence of "reg" property ! 142: r> ?dup 0= if ! 143: " reg" my-self ihandle>phandle get-package-property ! 144: if false else 2drop true then ! 145: then ! 146: ! 147: ( name len print-unit-flag ) ! 148: if ! 149: my-self ihandle>phandle get-encode-unit-xt ! 150: ! 151: ( name len xt ) ! 152: depth >r >r ! 153: my-unit r> execute ! 154: r> -rot >r >r depth! drop ! 155: r> r> ! 156: ( name len str len ) ! 157: here 20 + tmpstrcpy ! 158: " @" rot tmpstrcat drop ! 159: 2swap pocket tmpstrcat drop ! 160: then ! 161: ! 162: \ add :arguments ! 163: my-args dup if ! 164: " :" pocket tmpstrcat drop ! 165: 2swap pocket tmpstrcat drop ! 166: else ! 167: 2drop ! 168: then ! 169: ! 170: r> to my-self ! 171: ; ! 172: ! 173: \ helper, also used by client interface (package-to-path) ! 174: : get-package-path ( phandle -- str len ) ! 175: ?dup 0= if 0 0 then ! 176: ! 177: dup >dn.parent @ 0= if drop " /" exit then ! 178: \ dictionary abused for temporary storage ! 179: >r 0 0 here 40 + ! 180: begin r> dup >dn.parent @ dup >r while ! 181: ( path len tempbuf phandle R: phandle.parent ) ! 182: pnodename rot tmpstrcat ! 183: " /" rot tmpstrcat ! 184: repeat ! 185: r> 3drop ! 186: pocket tmpstrcpy drop ! 187: ; ! 188: ! 189: \ used by client interface (instance-to-path) ! 190: : get-instance-path ( ihandle -- str len ) ! 191: ?dup 0= if 0 0 then ! 192: ! 193: dup ihandle>phandle >dn.parent @ 0= if drop " /" exit then ! 194: ! 195: \ dictionary abused for temporary storage ! 196: >r 0 0 here 40 + ! 197: begin r> dup >in.my-parent @ dup >r while ! 198: ( path len tempbuf ihandle R: ihandle.parent ) ! 199: dup >in.interposed @ 0= if ! 200: inodename rot tmpstrcat ! 201: " /" rot tmpstrcat ! 202: else ! 203: drop ! 204: then ! 205: repeat ! 206: r> 3drop ! 207: pocket tmpstrcpy drop ! 208: ; ! 209: ! 210: \ used by client interface (instance-to-interposed-path) ! 211: : get-instance-interposed-path ( ihandle -- str len ) ! 212: ?dup 0= if 0 0 then ! 213: ! 214: dup ihandle>phandle >dn.parent @ 0= if drop " /" exit then ! 215: ! 216: \ dictionary abused for temporary storage ! 217: >r 0 0 here 40 + ! 218: begin r> dup >in.my-parent @ dup >r while ! 219: ( path len tempbuf ihandle R: ihandle.parent ) ! 220: dup >r inodename rot tmpstrcat ! 221: r> >in.interposed @ if " /%" else " /" then ! 222: rot tmpstrcat ! 223: repeat ! 224: r> 3drop ! 225: pocket tmpstrcpy drop ! 226: ; ! 227: ! 228: : pwd ( -- ) ! 229: ?active-package get-package-path type ! 230: ; ! 231: ! 232: : ls ( -- ) ! 233: cr ! 234: ?active-package >dn.child @ ! 235: begin dup while ! 236: dup u. dup pnodename type cr ! 237: >dn.peer @ ! 238: repeat ! 239: drop ! 240: ; ! 241: ! 242: ! 243: \ ------------------------------------------- ! 244: \ property printing ! 245: \ ------------------------------------------- ! 246: ! 247: : .p-string? ( data len -- true | data len false ) ! 248: \ no trailing zero? ! 249: 2dup + 1- c@ if 0 exit then ! 250: ! 251: swap >r 0 ! 252: \ count zeros and detect unprintable characters? ! 253: over 1- begin 1- dup 0>= while ! 254: dup r@ + c@ ! 255: ( len zerocnt n ch ) ! 256: ! 257: ?dup 0= if ! 258: swap 1+ swap ! 259: else ! 260: dup 1b <= swap 80 >= or ! 261: if 2drop r> swap 0 exit then ! 262: then ! 263: repeat drop r> -rot ! 264: ( data len zerocnt ) ! 265: ! 266: \ simple string ! 267: 0= if ! 268: ascii " emit 1- type ascii " emit true exit ! 269: then ! 270: ! 271: \ make sure there are no double zeros (except possibly at the end) ! 272: 2dup over + swap ! 273: ( data len end ptr ) ! 274: begin 2dup <> while ! 275: dup c@ 0= if ! 276: 2dup 1+ <> if 2drop false exit then ! 277: then ! 278: dup cstrlen 1+ + ! 279: repeat ! 280: 2drop ! 281: ! 282: ." {" ! 283: 0 -rot over + swap ! 284: \ multistring ( cnt end ptr ) ! 285: begin 2dup <> while ! 286: rot dup if ." , " then 1+ -rot ! 287: dup cstrlen 2dup ! 288: ascii " emit type ascii " emit ! 289: 1+ + ! 290: repeat ! 291: ." }" ! 292: 3drop true ! 293: ; ! 294: ! 295: : .p-int? ( data len -- 1 | data len 0 ) ! 296: dup 4 <> if false exit then ! 297: decode-int -rot 2drop true swap ! 298: dup 0>= if . exit then ! 299: dup -ff < if u. exit then ! 300: . ! 301: ; ! 302: ! 303: \ Print a number zero-padded ! 304: : 0.r ( u minlen -- ) ! 305: 0 swap <# 1 ?do # loop #s #> type ! 306: ; ! 307: ! 308: : .p-bytes? ( data len -- 1 | data len 0 ) ! 309: ." -- " dup . ." : " ! 310: swap >r 0 ! 311: begin 2dup > while ! 312: dup r@ + c@ ! 313: ( len n ch ) ! 314: ! 315: 2 0.r space ! 316: 1+ ! 317: repeat ! 318: 2drop r> drop 1 ! 319: ; ! 320: ! 321: \ this function tries to heuristically determine the data format ! 322: : (.property) ( data len -- ) ! 323: dup 0= if 2drop ." <empty>" exit then ! 324: ! 325: .p-string? if exit then ! 326: .p-int? if exit then ! 327: .p-bytes? if exit then ! 328: 2drop ." <unimplemented type>" ! 329: ; ! 330: ! 331: \ Print the value of a property in "reg" format ! 332: : .p-reg ( #acells #scells data len -- ) ! 333: 2dup + -rot ( #acells #scells data+len data len ) ! 334: >r >r -rot ( data+len #acells #scells R: len data ) ! 335: 4 * swap 4 * dup r> r> ( data+len #sbytes #abytes #abytes data len ) ! 336: bounds ( data+len #sbytes #abytes #abytes data+len data ) ?do ! 337: dup 0= if 2 spaces then \ start of "size" part ! 338: 2dup <> if \ non-first byte in row ! 339: dup 3 and 0= if space then \ make numbers more readable ! 340: then ! 341: i c@ 2 0.r \ print byte ! 342: 1- 3dup nip + 0= if \ end of row ! 343: 3 pick i 1+ > if \ non-last byte ! 344: cr \ start new line ! 345: d# 26 spaces \ indentation ! 346: then ! 347: drop dup \ update counter ! 348: then ! 349: loop ! 350: 3drop drop ! 351: ; ! 352: ! 353: \ Return the number of cells per physical address ! 354: : .p-translations-#pacells ( -- #cells ) ! 355: " /" find-package if ! 356: " #address-cells" rot get-package-property if ! 357: 1 ! 358: else ! 359: decode-int nip nip 1 max ! 360: then ! 361: else ! 362: 1 ! 363: then ! 364: ; ! 365: ! 366: \ Return the number of cells per translation entry ! 367: : .p-translations-#cells ( -- #cells ) ! 368: [IFDEF] CONFIG_PPC ! 369: my-#acells 3 * ! 370: .p-translations-#pacells + ! 371: [ELSE] ! 372: my-#acells 3 * ! 373: [THEN] ! 374: ; ! 375: ! 376: \ Set up column offsets ! 377: : .p-translations-cols ( -- col1 ... coln #cols ) ! 378: .p-translations-#cells 4 * ! 379: [IFDEF] CONFIG_PPC ! 380: 4 - ! 381: dup 4 - ! 382: dup .p-translations-#pacells 4 * - ! 383: 3 ! 384: [ELSE] ! 385: my-#acells 4 * - ! 386: dup my-#scells 4 * - ! 387: 2 ! 388: [THEN] ! 389: ; ! 390: ! 391: \ Print the value of the MMU translations property ! 392: : .p-translations ( data len -- ) ! 393: >r >r .p-translations-cols r> r> ( col1 ... coln #cols data len ) ! 394: 2dup + -rot ( col1 ... coln #cols data+len data len ) ! 395: >r >r .p-translations-#cells 4 * dup r> r> ! 396: ( col1 ... coln #cols data+len #bytes #bytes len data ) ! 397: bounds ( col1 ... coln #cols data+len #bytes #bytes data+len data ) ?do ! 398: 3 pick 4 + 4 ?do \ check all defined columns ! 399: i pick over = if ! 400: 2 spaces \ start new column ! 401: then ! 402: loop ! 403: 2dup <> if \ non-first byte in row ! 404: dup 3 and 0= if space then \ make numbers more readable ! 405: then ! 406: i c@ 2 0.r \ print byte ! 407: 1- dup 0= if \ end of row ! 408: 2 pick i 1+ > if \ non-last byte ! 409: cr \ start new line ! 410: d# 26 spaces \ indentation ! 411: then ! 412: drop dup \ update counter ! 413: then ! 414: loop ! 415: 2drop drop 0 ?do drop loop ! 416: ; ! 417: ! 418: \ This function hardwires data formats to particular node properties ! 419: : (.property-by-name) ( name-str name-len data len -- ) ! 420: 2over " reg" strcmp 0= if ! 421: my-#acells my-#scells 2swap .p-reg ! 422: 2drop exit ! 423: then ! 424: ! 425: active-package get-nodename " memory" strcmp 0= if ! 426: 2over " available" strcmp 0= if ! 427: my-#acells my-#scells 2swap .p-reg ! 428: 2drop exit ! 429: then ! 430: then ! 431: " /chosen" find-dev if ! 432: " mmu" rot get-package-property 0= if ! 433: decode-int nip nip ihandle>phandle active-package = if ! 434: 2over " available" strcmp 0= if ! 435: my-#acells my-#scells 1 max 2swap .p-reg ! 436: 2drop exit ! 437: then ! 438: 2over " translations" strcmp 0= if ! 439: .p-translations ! 440: 2drop exit ! 441: then ! 442: then ! 443: then ! 444: then ! 445: ! 446: 2swap 2drop ( data len ) ! 447: (.property) ! 448: ; ! 449: ! 450: : .properties ( -- ) ! 451: ?active-package dup >r if ! 452: 0 0 ! 453: begin ! 454: r@ next-property ! 455: while ! 456: cr 2dup dup -rot type ! 457: begin ." " 1+ dup d# 26 >= until drop ! 458: 2dup ! 459: 2dup active-package get-package-property drop ! 460: ( name-str name-len data len ) ! 461: (.property-by-name) ! 462: repeat ! 463: then ! 464: r> drop ! 465: cr ! 466: ; ! 467: ! 468: ! 469: \ 7.4.11 Device tree ! 470: ! 471: : print-dev ( phandle -- phandle ) ! 472: dup u. ! 473: dup get-package-path type ! 474: dup " device_type" rot get-package-property if ! 475: cr ! 476: else ! 477: ." (" decode-string type ." )" cr 2drop ! 478: then ! 479: ; ! 480: ! 481: : show-sub-devs ( subtree-phandle -- ) ! 482: print-dev ! 483: >dn.child @ ! 484: begin dup while ! 485: dup recurse ! 486: >dn.peer @ ! 487: repeat ! 488: drop ! 489: ; ! 490: ! 491: : show-all-devs ( -- ) ! 492: active-package ! 493: cr " /" find-device ! 494: ?active-package show-sub-devs ! 495: active-package! ! 496: ; ! 497: ! 498: ! 499: : show-devs ( "{device-specifier}<cr>" -- ) ! 500: active-package ! 501: cr " /" find-device ! 502: linefeed parse find-device ! 503: ?active-package show-sub-devs ! 504: active-package! ! 505: ; ! 506: ! 507: ! 508: ! 509: \ 7.4.11.3 Device probing ! 510: ! 511: : probe-all ( -- ) ! 512: ;
This archive runs on limited infrastructure. Preserving old code on modern bandwidth. Automated agents are requested to crawl responsibly.