1 20 value ciface-ph 3 4dev /openprom/ 5new-device 6" client-services" device-name 7 8active-package to ciface-ph 9 10\ ------------------------------------------------------------- 11\ private stuff 12\ ------------------------------------------------------------- 13 14private 15 16variable callback-function 17 18: ?phandle ( phandle -- phandle ) 19 dup 0= if ." NULL phandle" -1 throw then 20; 21: ?ihandle ( ihandle -- ihandle ) 22 dup 0= if ." NULL ihandle" -2 throw then 23; 24 25\ copy and null terminate return string 26: ci-strcpy ( buf buflen str len -- len ) 27 >r -rot dup 28 ( str buf buflen buflen R: len ) 29 r@ min swap 30 ( str buf n buflen R: len ) 31 over > if 32 ( str buf n ) 33 2dup + 0 swap c! 34 then 35 move r> 36; 37 380 value memory-ih 390 value mmu-ih 40 41:noname ( -- ) 42 " /chosen" find-device 43 44 " mmu" active-package get-package-property 0= if 45 decode-int nip nip to mmu-ih 46 then 47 48 " memory" active-package get-package-property 0= if 49 decode-int nip nip to memory-ih 50 then 51 device-end 52; SYSTEM-initializer 53 54: safetype 55 ." <" dup cstrlen dup 20 < if type else 2drop ." BAD" then ." >" 56; 57 58: phandle-exists? ( phandle -- found? ) 59 false swap 0 60 begin iterate-tree ?dup while 61 ( found? find-ph current-ph ) 62 over over = if 63 rot drop true -rot 64 then 65 repeat 66 drop 67; 68 69\ ------------------------------------------------------------- 70\ public interface 71\ ------------------------------------------------------------- 72 73external 74 75\ ------------------------------------------------------------- 76\ 6.3.2.1 Client interface 77\ ------------------------------------------------------------- 78 79\ returns -1 if missing 80: test ( name -- 0|-1 ) 81 dup cstrlen ciface-ph find-method 82 if drop 0 else -1 then 83; 84 85\ ------------------------------------------------------------- 86\ 6.3.2.2 Device tree 87\ ------------------------------------------------------------- 88 89: peer peer ; 90: child child ; 91: parent parent ; 92 93: getproplen ( name phandle -- len|-1 ) 94 over cstrlen swap 95 ?phandle get-package-property 96 if -1 else nip then 97; 98 99: getprop ( buflen buf name phandle -- size|-1 ) 100 \ detect phandle == -1 101 dup -1 = if 102 2drop 2drop -1 exit 103 then 104 105 \ return -1 if phandle is 0 (MacOS actually does this) 106 ?dup 0= if drop 2drop -1 exit then 107 108 over cstrlen swap 109 ?phandle get-package-property if 2drop -1 exit then 110 ( buflen buf prop proplen ) 111 >r swap rot r> 112 ( prop buf buflen proplen ) 113 dup >r min move r> 114; 115 116\ 1 OK, 0 no more prop, -1 prev invalid 117: nextprop ( buf prev phandle -- 1|0|-1 ) 118 >r 119 dup 0= if 0 else dup cstrlen then 120 121 ( buf prev prev_len ) 122 123 \ verify that prev exists (overkill...) 124 dup if 125 2dup r@ get-package-property if 126 r> 2drop drop 127 0 swap c! 128 -1 exit 129 else 130 2drop 131 then 132 then 133 134 ( buf prev prev_len ) 135 136 r> next-property if 137 ( buf name name_len ) 138 dup 1+ -rot ci-strcpy drop 1 139 else 140 ( buf ) 141 0 swap c! 142 0 143 then 144; 145 146: setprop ( len buf name phandle -- size ) 147 3 pick >r 148 >r >r swap encode-bytes \ ( prop-addr prop-len R: phandle name ) 149 r> dup cstrlen r> 150 (property) 151 r> 152; 153 154: finddevice ( dev_spec -- phandle|-1 ) 155 dup cstrlen 156 \ ." FIND-DEVICE " 2dup type 157 find-dev 0= if -1 then 158 \ ." -- " dup . cr 159; 160 161: instance-to-package ( ihandle -- phandle ) 162 ?ihandle instance-to-package 163; 164 165: package-to-path ( buflen buf phandle -- length ) 166 \ XXX improve error checking 167 dup 0= if 3drop -1 exit then 168 >r swap r> 169 get-package-path 170 ( buf buflen str len ) 171 ci-strcpy 172; 173 174: canon ( buflen buf dev_specifier -- len ) 175 dup cstrlen find-dev if 176 ( buflen buf phandle ) 177 package-to-path 178 else 179 2drop -1 180 then 181; 182 183: instance-to-path ( buflen buf ihandle -- length ) 184 \ XXX improve error checking 185 dup 0= if 3drop -1 exit then 186 >r swap r> 187 get-instance-path 188 \ ." INSTANCE: " 2dup type cr dup . 189 ( buf buflen str len ) 190 ci-strcpy 191; 192 193: instance-to-interposed-path ( buflen buf ihandle -- length ) 194 \ XXX improve error checking 195 dup 0= if 3drop -1 exit then 196 >r swap r> 197 get-instance-interposed-path 198 ( buf buflen str len ) 199 ci-strcpy 200; 201 202: call-method ( ihandle method -- xxxx catch-result ) 203 dup 0= if ." call of null method" -1 exit then 204 dup >r 205 dup cstrlen 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 210 then 211 r> drop 212; 213 214 215\ ------------------------------------------------------------- 216\ 6.3.2.3 Device I/O 217\ ------------------------------------------------------------- 218 219: open ( dev_spec -- ihandle|0 ) 220 dup cstrlen open-dev 221; 222 223: close ( ihandle -- ) 224 close-dev 225; 226 227: read ( len addr ihandle -- actual ) 228 >r swap r> 229 dup ihandle>phandle " read" rot find-method 230 if swap call-package else 3drop -1 then 231; 232 233: write ( len addr ihandle -- actual ) 234 >r swap r> 235 dup ihandle>phandle " write" rot find-method 236 if swap call-package else 3drop -1 then 237; 238 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 242; 243 244 245\ ------------------------------------------------------------- 246\ 6.3.2.4 Memory 247\ ------------------------------------------------------------- 248 249: claim ( align size virt -- baseaddr|-1 ) 250 -rot swap 251 ciface-ph " cif-claim" rot find-method 252 if execute else 3drop -1 then 253; 254 255: release ( size virt -- ) 256 swap 257 ciface-ph " cif-release" rot find-method 258 if execute else 2drop -1 then 259; 260 261\ ------------------------------------------------------------- 262\ 6.3.2.5 Control transfer 263\ ------------------------------------------------------------- 264 265: boot ( bootspec -- ) 266 ." BOOT" 267; 268 269: enter ( -- ) 270 ." ENTER" 271; 272 273\ exit ( -- ) is defined later (clashes with builtin exit) 274 275: chain ( virt size entry args len -- ) 276 ." CHAIN" 277; 278 279\ ------------------------------------------------------------- 280\ 6.3.2.6 User interface 281\ ------------------------------------------------------------- 282 283: interpret ( xxx cmdstring -- ??? catch-reult ) 284 dup cstrlen 285 \ ." INTERPRETE: --- " 2dup type 286 ['] evaluate catch dup if 287 \ this is not necessary an error... 288 ." interpret: exception " dup . ." caught" cr 289 290 \ Force back to interpret state on error, otherwise the next call to 291 \ interpret gets confused if the error occurred in compile mode 292 0 state ! 293 then 294 \ ." --- " cr 295; 296 297: set-callback ( newfunc -- oldfunc ) 298 callback-function @ 299 swap 300 callback-function ! 301; 302 303\ : set-symbol-lookup ( sym-to-value -- value-to-sym ) ; 304 305 306\ ------------------------------------------------------------- 307\ 6.3.2.7 Time 308\ ------------------------------------------------------------- 309 310: milliseconds ( -- ms ) 311 get-msecs 312; 313 314\ ------------------------------------------------------------- 315\ arch? 316\ ------------------------------------------------------------- 317 318: start-cpu ( xxx xxx xxx --- ) 319 ." Start CPU unimplemented" cr 320 3drop 321; 322 323\ ------------------------------------------------------------- 324\ special 325\ ------------------------------------------------------------- 326 327: exit ( -- ) 328 ." EXIT" 329 330 \ Execute (exit) hook if one exists 331 s" (exit)" $find if 332 execute 333 else 334 2drop 335 then 336 337 outer-interpreter 338; 339 340: test-method ( cstring-method phandle -- missing? ) 341 swap dup cstrlen rot 342 343 \ Check for incorrect phandle 344 dup phandle-exists? false = if 345 -1 throw 346 then 347 348 find-method 0= if -1 else drop 0 then 349; 350 351[IFDEF] CONFIG_SPARC64 352 353: SUNW,power-off ( -- ) 354 power-off 355; 356 357[THEN] 358 359finish-device 360device-end 361 362 363\ ------------------------------------------------------------- 364\ entry point 365\ ------------------------------------------------------------- 366 367: client-iface ( [args] name len -- [args] -1 | [rets] 0 ) 368 ciface-ph find-method 0= if -1 exit then 369 catch ?dup if 370 cr ." Unexpected client interface exception: " . -2 cr exit 371 then 372 0 373; 374 375: client-call-iface ( [args] name len -- [args] -1 | [rets] 0 ) 376 ciface-ph find-method 0= if -1 exit then 377 execute 378 0 379; 380