1
2
3
4
5
6
7
8
9
10
11
12
13
14
15
16
17
18
19
20
21
22
23
24
25
26
27
28
29
30
31
32
33
34
35
36
37
38
39
40
41
42
43
44
45
46
47
48
49
50
51
52
53
54
55
56
57
58
59
60
61
62
63
64
65
66
67
68
69
70
71
72
73
74
75
76
77
78
79
80
81
82
83
84
85
86
87
88
89
90
91
92
93
94
95
96
97
98
99
100
101
102
103
104
105
106
107
108
109
110
111
112
113
114
115
116
117
118
119
120
121
122
123
124
125
126
127
128
129
130
131
132
133
134
135
136
137
138
139
140
141
142
143
144
145
146
147
148
149
150
151
152
153
154
155
156
157
158
159
160
161
162
163
164
165
166
167
168
169
170
171
172
173
174
175
176
177
178
179
180
181
182
183
184
185
186
187
188
189
190
191
192
|
\ *****************************************************************************
\ * 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 ;
|
