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
193
194
195
196
197
198
199
200
201
202
203
204
205
206
207
208
209
210
211
212
213
214
215
216
217
218
219
220
221
222
223
224
225
226
227
228
229
230
231
232
233
234
235
236
237
238
239
240
241
242
243
244
245
246
247
248
249
250
251
252
253
254
255
256
257
258
259
260
261
262
263
264
265
266
267
268
269
270
271
272
273
274
275
276
277
278
279
280
281
282
283
284
285
286
287
|
\ tag: Package access.
\
\ this code implements IEEE 1275-1994 ch. 5.3.4
\
\ Copyright (C) 2003 Stefan Reinauer
\
\ See the file "COPYING" for further information about
\ the copyright and warranty status of this work.
\
\ variable last-package 0 last-package !
\ 0 value active-package
: current-device active-package ;
\
\ 5.3.4.1 Open/Close packages (part 1)
\
\ 0 value my-self ( -- ihandle )
: ?my-self
my-self dup 0= abort" no current instance."
;
: my-parent ( -- ihandle )
?my-self >in.my-parent @
;
: ihandle>non-interposed-phandle ( ihandle -- phandle )
begin dup >in.interposed @ while
>in.my-parent @
repeat
>in.device-node @
;
: ihandle>phandle ( ihandle -- phandle )
>in.device-node @
;
\ next-property
\ defined in property.c
: peer ( phandle -- phandle.sibling )
?dup if
>dn.peer @
else
device-tree @
then
;
: child ( phandle.parent -- phandle.child )
\ Assume phandle == 0 indicates root node (not documented but similar
\ behaviour to "peer"). Used by some versions of Solaris (e.g. 9).
?dup if else device-tree @ then
>dn.child @
;
\
\ 5.3.4.2 Call methods from other packages
\
: find-method ( method-str method-len phandle -- false | xt true )
\ should we search the private wordlist too? I don't think so...
>dn.methods @ find-wordlist if
true
else
2drop false
then
;
: call-package ( ... xt ihandle -- ??? )
my-self >r
to my-self
execute
r> to my-self
;
: $call-method ( ... method-str method-len ihandle -- ??? )
dup >r >in.device-node @ find-method if
r> call-package
else
-21 throw
then
;
: $call-parent ( ... method-str method-len -- ??? )
my-parent $call-method
;
\
\ 5.3.4.1 Open/Close packages (part 2)
\
\ find-dev ( dev-str dev-len -- false | phandle true )
\ find-rel-dev ( dev-str dev-len phandle -- false | phandle true )
\
\ These function works just like find-device but without
\ any side effects (or exceptions).
\
defer find-dev
: find-rel-dev ( dev-str dev-len phandle -- false | phandle true )
active-package >r active-package!
find-dev
r> active-package!
;
: find-package ( name-str name-len -- false | phandle true )
\ Locate the support package named by name string.
\ If the package can be located, return its phandle and true; otherwise,
\ return false.
\ Interpret the name in name string relative to the "packages" device node.
\ If there are multiple packages with the same name (within the "packages"
\ node), return the phandle for the most recently created one.
\ This does the full path resolution stuff (including
\ alias expansion. If we don't want that, then we should just
\ iterade the children of /packages.
" /packages" find-dev 0= if 2drop false exit then
find-rel-dev 0= if false exit then
true
;
: open-package ( arg-str arg-len phandle -- ihandle | 0 )
\ Open the package indicated by phandle.
\ Create an instance of the package identified by phandle, save in that
\ instance the instance-argument specified by arg-string and invoke the
\ package's open method.
\ Return the instance handle ihandle of the new instance, or 0 if the package
\ could not be opened. This could occur either because that package has no
\ open method, or because its open method returned false, indicating an error.
\ The parent instance of the new instance is the instance that invoked
\ open-package. The current instance is not changed.
create-instance dup 0= if
3drop 0 exit
then
>r
\ clone arg-str
strdup r@ >in.arguments 2!
\ open the package
" open" r@ ['] $call-method catch if 3drop false then
if
r>
else
r> destroy-instance false
then
;
: $open-package ( arg-str arg-len name-str name-len -- ihandle | 0 )
\ Open the support package named by name string.
find-package if
open-package
else
2drop false
then
;
: close-package ( ihandle -- )
\ Close the instance identified by ihandle by calling the package's close
\ method and then destroying the instance.
dup " close" rot ['] $call-method catch if 3drop then
destroy-instance
;
\
\ 5.3.4.3 Get local arguments
\
: my-address ( -- phys.lo ... )
?my-self >in.device-node @
>dn.probe-addr
my-#acells tuck /l* + swap 1- 0
?do
/l - dup l@ swap
loop
drop
;
: my-space ( -- phys.hi )
?my-self >in.device-node @
>dn.probe-addr @
;
: my-unit ( -- phys.lo ... phys.hi )
?my-self >in.my-unit
my-#acells tuck /l* + swap 0 ?do
/l - dup l@ swap
loop
drop
;
: my-args ( -- arg-str arg-len )
?my-self >in.arguments 2@
;
\ char is not included. If char is not found, then R-len is zero
: left-parse-string ( str len char -- R-str R-len L-str L-len )
left-split
;
\ parse ints "hi,...,lo" separated by comma
: parse-ints ( str len num -- val.lo .. val.hi )
-rot 2 pick -rot
begin
rot 1- -rot 2 pick 0>=
while
( num n str len )
2dup ascii , strchr ?dup if
( num n str len p )
1+ -rot
2 pick 2 pick - ( num n p str len len1+1 )
dup -rot - ( num n p str len1+1 len2 )
-rot 1- ( num n p len2 str len1 )
else
0 0 2swap
then
$number if 0 then >r
repeat
3drop
( num )
begin 1- dup 0>= while r> swap repeat
drop
;
: parse-2int ( str len -- val.lo val.hi )
2 parse-ints
;
\
\ 5.3.4.4 Mapping tools
\
: map-low ( phys.lo ... size -- virt )
my-space swap s" map-in" $call-parent
;
: free-virtual ( virt size -- )
over s" address" get-my-property 0= if
decode-int -rot 2drop = if
s" address" delete-property
then
else
drop
then
s" map-out" $call-parent
;
\ Deprecated functions (required for compatibility with older loaders)
variable package-stack-pos 0 package-stack-pos !
create package-stack 8 cells allot
: push-package ( phandle -- )
\ Throw an error if we attempt to push a full stack
package-stack-pos @ 8 >= if
." cannot push-package onto full stack" cr
-99 throw
then
active-package
package-stack-pos @ /n * package-stack + !
package-stack-pos @ 1 + package-stack-pos !
active-package!
;
: pop-package ( -- )
\ Throw an error if we attempt to pop an empty stack
package-stack-pos @ 0 = if
." cannot pop-package from empty stack" cr
-99 throw
then
package-stack-pos @ 1 - package-stack-pos !
package-stack-pos @ /n * package-stack + @
active-package!
;
|