192 lines
5.9 KiB
Forth
192 lines
5.9 KiB
Forth
\ *****************************************************************************
|
|
\ * 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 ;
|