| \ ***************************************************************************** |
| \ * Copyright (c) 2004, 2008 IBM Corporation |
| \ * All rights reserved. |
| \ * This program and the accompanying materials |
| \ * are made available under the terms of the BSD License |
| \ * which accompanies this distribution, and is available at |
| \ * http://www.opensource.org/licenses/bsd-license.php |
| \ * |
| \ * Contributors: |
| \ * IBM Corporation - initial implementation |
| \ ****************************************************************************/ |
| |
| |
| \ Properties 5.3.5 |
| |
| \ Words on the property list for a node are actually executable words, |
| \ that return the address and length of the property's data. Special |
| \ nodes like /options can have their properties use specialized code to |
| \ dynamically generate their data; most nodes just use a 2CONSTANT. |
| |
| \ Put the type as byte before the property |
| \ { int = 1, bytes = 2, string = 3 } |
| \ This is used by .properties for pretty print |
| |
| \ Flag for type encoding, encode-* resets, set-property set the flag |
| true value encode-first? |
| |
| : decode-int over >r 4 /string r> 4c@ swap 2swap swap bljoin ; |
| : decode-64 decode-int -rot decode-int -rot 2swap swap lxjoin ; |
| : decode-string ( prop-addr1 prop-len1 -- prop-addr2 prop-len2 str len ) |
| dup 0= IF 2dup EXIT THEN \ string properties with zero length |
| over BEGIN dup c@ 0= IF 1+ -rot swap 2 pick over - rot over - -rot 1- |
| EXIT THEN 1+ AGAIN ; |
| |
| \ Remove a word from a wordlist. |
| : (prune) ( name len head -- ) |
| dup >r (find) ?dup IF r> BEGIN dup @ WHILE 2dup @ = IF |
| >r @ r> ! EXIT THEN @ REPEAT 2drop ELSE r> drop THEN ; |
| : prune ( name len -- ) last (prune) ; |
| |
| : set-property ( data dlen name nlen phandle -- ) |
| true to encode-first? |
| get-current >r node>properties @ set-current |
| 2dup prune $2CONSTANT r> set-current ; |
| : delete-property ( name nlen -- ) |
| get-node get-current >r node>properties @ set-current |
| prune r> set-current ; |
| : property ( data dlen name nlen -- ) get-node set-property ; |
| : get-property ( str len phandle -- true | data dlen false ) |
| ?dup 0= IF cr cr cr ." get-property for " type ." on zero phandle" |
| cr cr true EXIT THEN |
| node>properties @ voc-find dup IF link> execute false ELSE drop true THEN ; |
| : get-package-property ( str len phandle -- true | data dlen false ) |
| get-property ; |
| : get-my-property ( str len -- true | data dlen false ) |
| my-self ihandle>phandle get-property ; |
| : get-parent-property ( str len -- true | data dlen false ) |
| my-parent ihandle>phandle get-property ; |
| |
| : get-inherited-property ( str len -- true | data dlen false ) |
| my-self ihandle>phandle |
| BEGIN |
| 3dup get-property 0= IF |
| \ Property found |
| rot drop rot drop rot drop false EXIT |
| THEN |
| parent dup 0= IF |
| \ Root node has been reached, but property has not been found |
| 3drop true EXIT |
| THEN |
| AGAIN |
| ; |
| |
| \ Print out properties. |
| |
| 20 CONSTANT indent-prop |
| |
| : .prop-int ( str len -- ) |
| space |
| 400 min 0 |
| ?DO |
| i over + dup ( str act-addr act-addr ) |
| c@ 2 0.r 1+ dup c@ 2 0.r 1+ dup c@ 2 0.r 1+ c@ 2 0.r ( str ) |
| i c and c = IF \ check for multipleof 16 bytes |
| cr indent @ indent-prop + 1+ 0 \ linefeed + indent |
| DO |
| space \ print spaces |
| LOOP |
| ELSE |
| space space \ print two spaces |
| THEN |
| 4 +LOOP |
| drop |
| ; |
| |
| : .prop-bytes ( str len -- ) |
| 2dup -4 and .prop-int ( str len ) |
| |
| dup 3 and dup IF ( str len len%4 ) |
| >r -4 and + r> ( str' len%4 ) |
| bounds ( str' str'+len%4 ) |
| DO |
| i c@ 2 0.r \ Print last 3 bytes |
| LOOP |
| ELSE |
| 3drop |
| THEN |
| ; |
| |
| : .prop-string ( str len ) |
| 2dup space type |
| cr indent @ indent-prop + 0 DO space LOOP \ Linefeed |
| .prop-bytes |
| ; |
| |
| : .propbytes ( xt -- ) |
| execute dup |
| IF |
| over cell- @ execute |
| ELSE |
| 2drop |
| THEN |
| ; |
| : .property ( lfa -- ) |
| cr indent @ 0 |
| ?DO |
| space |
| LOOP |
| link> dup >name name>string 2dup type nip ( len ) |
| indent-prop swap - ( xt 20-len ) |
| dup 0< IF drop 0 THEN 0 ( xt number-of-space 0 ) |
| ?DO |
| space |
| LOOP |
| .propbytes |
| ; |
| : (.properties) ( phandle -- ) |
| node>properties @ cell+ @ BEGIN dup WHILE dup .property @ REPEAT drop ; |
| : .properties ( -- ) |
| get-node (.properties) ; |
| |
| : next-property ( str len phandle -- false | str' len' true ) |
| ?dup 0= IF device-tree @ THEN \ XXX: is this line required? |
| node>properties @ |
| >r 2dup 0= swap 0= or IF 2drop r> cell+ ELSE r> voc-find THEN |
| @ dup IF link>name name>string true THEN ; |
| |
| |
| \ encode-* words and all helpers |
| |
| \ Start a encoded property string |
| : encode-start ( -- prop 0 ) |
| ['] .prop-int compile, |
| false to encode-first? |
| here 0 |
| ; |
| |
| : encode-int ( val -- prop prop-len ) |
| encode-first? IF |
| ['] .prop-int compile, \ Execution token for print |
| false to encode-first? |
| THEN |
| here swap lbsplit c, c, c, c, /l |
| ; |
| : encode-bytes ( str len -- prop-addr prop-len ) |
| encode-first? IF |
| ['] .prop-bytes compile, \ Execution token for print |
| false to encode-first? |
| THEN |
| here over 2dup 2>r allot swap move 2r> |
| ; |
| : encode-string ( str len -- prop-addr prop-len ) |
| encode-first? IF |
| ['] .prop-string compile, \ Execution token for print |
| false to encode-first? |
| THEN |
| encode-bytes 0 c, char+ |
| ; |
| |
| : encode+ ( prop1-addr prop1-len prop2-addr prop2-len -- prop-addr prop-len ) |
| nip + ; |
| : encode-int+ encode-int encode+ ; |
| : encode-64 xlsplit encode-int rot encode-int+ ; |
| : encode-64+ encode-64 encode+ ; |
| |
| |
| \ Helpers for common nodes. Should perhaps remove "compatible", as it's |
| \ not typically a single string. |
| : device-name encode-string s" name" property ; |
| : device-type encode-string s" device_type" property ; |
| : model encode-string s" model" property ; |
| : compatible encode-string s" compatible" property ; |