6 " client-services" device-name
8 active-package to ciface-ph
10 \ -------------------------------------------------------------
12 \ -------------------------------------------------------------
16 variable callback-function
18 : ?phandle ( phandle -- phandle )
19 dup 0= if ." NULL phandle" -1 throw then
21 : ?ihandle ( ihandle -- ihandle )
22 dup 0= if ." NULL ihandle" -2 throw then
25 \ copy and null terminate return string
26 : ci-strcpy ( buf buflen str len -- len )
28 ( str buf buflen buflen R: len )
30 ( str buf n buflen R: len )
42 " /chosen" find-device
44 " mmu" active-package get-package-property 0= if
45 decode-int nip nip to mmu-ih
48 " memory" active-package get-package-property 0= if
49 decode-int nip nip to memory-ih
55 ." <" dup cstrlen dup 20 < if type else 2drop ." BAD" then ." >"
58 : phandle-exists? ( phandle -- found? )
60 begin iterate-tree ?dup while
61 ( found? find-ph current-ph )
69 \ -------------------------------------------------------------
71 \ -------------------------------------------------------------
75 \ -------------------------------------------------------------
76 \ 6.3.2.1 Client interface
77 \ -------------------------------------------------------------
79 \ returns -1 if missing
80 : test ( name -- 0|-1 )
81 dup cstrlen ciface-ph find-method
82 if drop 0 else -1 then
85 \ -------------------------------------------------------------
87 \ -------------------------------------------------------------
93 : getproplen ( name phandle -- len|-1 )
95 ?phandle get-package-property
99 : getprop ( buflen buf name phandle -- size|-1 )
100 \ detect phandle == -1
105 \ return -1 if phandle is 0 (MacOS actually does this)
106 ?dup 0= if drop 2drop -1 exit then
109 ?phandle get-package-property if 2drop -1 exit then
110 ( buflen buf prop proplen )
112 ( prop buf buflen proplen )
116 \ 1 OK, 0 no more prop, -1 prev invalid
117 : nextprop ( buf prev phandle -- 1|0|-1 )
119 dup 0= if 0 else dup cstrlen then
121 ( buf prev prev_len )
123 \ verify that prev exists (overkill...)
125 2dup r@ get-package-property if
134 ( buf prev prev_len )
137 ( buf name name_len )
138 dup 1+ -rot ci-strcpy drop 1
146 : setprop ( len buf name phandle -- size )
148 >r >r swap encode-bytes \ ( prop-addr prop-len R: phandle name )
154 : finddevice ( dev_spec -- phandle|-1 )
156 \ ." FIND-DEVICE " 2dup type
157 find-dev 0= if -1 then
161 : instance-to-package ( ihandle -- phandle )
162 ?ihandle ihandle>phandle
165 : package-to-path ( buflen buf phandle -- length )
166 \ XXX improve error checking
167 dup 0= if 3drop -1 exit then
170 ( buf buflen str len )
174 : canon ( buflen buf dev_specifier -- len )
175 dup cstrlen find-dev if
176 ( buflen buf phandle )
183 : instance-to-path ( buflen buf ihandle -- length )
184 \ XXX improve error checking
185 dup 0= if 3drop -1 exit then
188 \ ." INSTANCE: " 2dup type cr dup .
189 ( buf buflen str len )
193 : instance-to-interposed-path ( buflen buf ihandle -- length )
194 \ XXX improve error checking
195 dup 0= if 3drop -1 exit then
197 get-instance-interposed-path
198 ( buf buflen str len )
202 : call-method ( ihandle method -- xxxx catch-result )
203 dup 0= if ." call of null method" -1 exit then
206 \ ." call-method " 2dup type cr
207 rot ?ihandle ['] $call-method catch dup if
208 \ not necessary an error but very useful for debugging...
209 ." call-method " r@ dup cstrlen type ." : exception " dup . cr
215 \ -------------------------------------------------------------
217 \ -------------------------------------------------------------
219 : open ( dev_spec -- ihandle|0 )
223 : close ( ihandle -- )
227 : read ( len addr ihandle -- actual )
229 dup ihandle>phandle " read" rot find-method
230 if swap call-package else 3drop -1 then
233 : write ( len addr ihandle -- actual )
235 dup ihandle>phandle " write" rot find-method
236 if swap call-package else 3drop -1 then
239 : seek ( pos_lo pos_hi ihandle -- status )
240 dup ihandle>phandle " seek" rot find-method
241 if swap call-package else 3drop -1 then
245 \ -------------------------------------------------------------
247 \ -------------------------------------------------------------
249 : claim ( align size virt -- baseaddr|-1 )
251 ciface-ph " cif-claim" rot find-method
252 if execute else 3drop -1 then
255 : release ( size virt -- )
257 ciface-ph " cif-release" rot find-method
258 if execute else 2drop -1 then
261 \ -------------------------------------------------------------
262 \ 6.3.2.5 Control transfer
263 \ -------------------------------------------------------------
265 : boot ( bootspec -- )
273 \ exit ( -- ) is defined later (clashes with builtin exit)
275 : chain ( virt size entry args len -- )
279 \ -------------------------------------------------------------
280 \ 6.3.2.6 User interface
281 \ -------------------------------------------------------------
283 : interpret ( xxx cmdstring -- ??? catch-reult )
285 \ ." INTERPRETE: --- " 2dup type
286 ['] evaluate catch dup if
287 \ this is not necessary an error...
288 ." interpret: exception " dup . ." caught" cr
290 \ Force back to interpret state on error, otherwise the next call to
291 \ interpret gets confused if the error occurred in compile mode
297 : set-callback ( newfunc -- oldfunc )
303 \ : set-symbol-lookup ( sym-to-value -- value-to-sym ) ;
306 \ -------------------------------------------------------------
308 \ -------------------------------------------------------------
310 : milliseconds ( -- ms )
314 \ -------------------------------------------------------------
316 \ -------------------------------------------------------------
318 : start-cpu ( xxx xxx xxx --- )
319 ." Start CPU unimplemented" cr
323 \ -------------------------------------------------------------
325 \ -------------------------------------------------------------
330 \ Execute (exit) hook if one exists
340 : test-method ( cstring-method phandle -- missing? )
343 \ Check for incorrect phandle
344 dup phandle-exists? false = if
348 find-method 0= if -1 else drop 0 then
355 \ -------------------------------------------------------------
357 \ -------------------------------------------------------------
359 : client-iface ( [args] name len -- [args] -1 | [rets] 0 )
360 ciface-ph find-method 0= if -1 exit then
362 cr ." Unexpected client interface exception: " . -2 cr exit
367 : client-call-iface ( [args] name len -- [args] -1 | [rets] 0 )
368 ciface-ph find-method 0= if -1 exit then