![[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.