| |
| 0 value ciface-ph |
| |
| dev /openprom/ |
| new-device |
| " client-services" device-name |
| |
| active-package to ciface-ph |
| |
| \ ------------------------------------------------------------- |
| \ private stuff |
| \ ------------------------------------------------------------- |
| |
| private |
| |
| variable callback-function |
| |
| : ?phandle ( phandle -- phandle ) |
| dup 0= if ." NULL phandle" -1 throw then |
| ; |
| : ?ihandle ( ihandle -- ihandle ) |
| dup 0= if ." NULL ihandle" -2 throw then |
| ; |
| |
| \ copy and null terminate return string |
| : ci-strcpy ( buf buflen str len -- len ) |
| >r -rot dup |
| ( str buf buflen buflen R: len ) |
| r@ min swap |
| ( str buf n buflen R: len ) |
| over > if |
| ( str buf n ) |
| 2dup + 0 swap c! |
| then |
| move r> |
| ; |
| |
| 0 value memory-ih |
| 0 value mmu-ih |
| |
| :noname ( -- ) |
| " /chosen" find-device |
| |
| " mmu" active-package get-package-property 0= if |
| decode-int nip nip to mmu-ih |
| then |
| |
| " memory" active-package get-package-property 0= if |
| decode-int nip nip to memory-ih |
| then |
| device-end |
| ; SYSTEM-initializer |
| |
| : safetype |
| ." <" dup cstrlen dup 20 < if type else 2drop ." BAD" then ." >" |
| ; |
| |
| : phandle-exists? ( phandle -- found? ) |
| false swap 0 |
| begin iterate-tree ?dup while |
| ( found? find-ph current-ph ) |
| over over = if |
| rot drop true -rot |
| then |
| repeat |
| drop |
| ; |
| |
| \ ------------------------------------------------------------- |
| \ public interface |
| \ ------------------------------------------------------------- |
| |
| external |
| |
| \ ------------------------------------------------------------- |
| \ 6.3.2.1 Client interface |
| \ ------------------------------------------------------------- |
| |
| \ returns -1 if missing |
| : test ( name -- 0|-1 ) |
| dup cstrlen ciface-ph find-method |
| if drop 0 else -1 then |
| ; |
| |
| \ ------------------------------------------------------------- |
| \ 6.3.2.2 Device tree |
| \ ------------------------------------------------------------- |
| |
| : peer peer ; |
| : child child ; |
| : parent parent ; |
| |
| : getproplen ( name phandle -- len|-1 ) |
| over cstrlen swap |
| ?phandle get-package-property |
| if -1 else nip then |
| ; |
| |
| : getprop ( buflen buf name phandle -- size|-1 ) |
| \ detect phandle == -1 |
| dup -1 = if |
| 2drop 2drop -1 exit |
| then |
| |
| \ return -1 if phandle is 0 (MacOS actually does this) |
| ?dup 0= if drop 2drop -1 exit then |
| |
| over cstrlen swap |
| ?phandle get-package-property if 2drop -1 exit then |
| ( buflen buf prop proplen ) |
| >r swap rot r> |
| ( prop buf buflen proplen ) |
| dup >r min move r> |
| ; |
| |
| \ 1 OK, 0 no more prop, -1 prev invalid |
| : nextprop ( buf prev phandle -- 1|0|-1 ) |
| >r |
| dup 0= if 0 else dup cstrlen then |
| |
| ( buf prev prev_len ) |
| |
| \ verify that prev exists (overkill...) |
| dup if |
| 2dup r@ get-package-property if |
| r> 2drop drop |
| 0 swap c! |
| -1 exit |
| else |
| 2drop |
| then |
| then |
| |
| ( buf prev prev_len ) |
| |
| r> next-property if |
| ( buf name name_len ) |
| dup 1+ -rot ci-strcpy drop 1 |
| else |
| ( buf ) |
| 0 swap c! |
| 0 |
| then |
| ; |
| |
| : setprop ( len buf name phandle -- size ) |
| 3 pick >r |
| >r >r swap encode-bytes \ ( prop-addr prop-len R: phandle name ) |
| r> dup cstrlen r> |
| (property) |
| r> |
| ; |
| |
| : finddevice ( dev_spec -- phandle|-1 ) |
| dup cstrlen |
| \ ." FIND-DEVICE " 2dup type |
| find-dev 0= if -1 then |
| \ ." -- " dup . cr |
| ; |
| |
| : instance-to-package ( ihandle -- phandle ) |
| ?ihandle instance-to-package |
| ; |
| |
| : package-to-path ( buflen buf phandle -- length ) |
| \ XXX improve error checking |
| dup 0= if 3drop -1 exit then |
| >r swap r> |
| get-package-path |
| ( buf buflen str len ) |
| ci-strcpy |
| ; |
| |
| : canon ( buflen buf dev_specifier -- len ) |
| dup cstrlen find-dev if |
| ( buflen buf phandle ) |
| package-to-path |
| else |
| 2drop -1 |
| then |
| ; |
| |
| : instance-to-path ( buflen buf ihandle -- length ) |
| \ XXX improve error checking |
| dup 0= if 3drop -1 exit then |
| >r swap r> |
| get-instance-path |
| \ ." INSTANCE: " 2dup type cr dup . |
| ( buf buflen str len ) |
| ci-strcpy |
| ; |
| |
| : instance-to-interposed-path ( buflen buf ihandle -- length ) |
| \ XXX improve error checking |
| dup 0= if 3drop -1 exit then |
| >r swap r> |
| get-instance-interposed-path |
| ( buf buflen str len ) |
| ci-strcpy |
| ; |
| |
| : call-method ( ihandle method -- xxxx catch-result ) |
| dup 0= if ." call of null method" -1 exit then |
| dup >r |
| dup cstrlen |
| \ ." call-method " 2dup type cr |
| rot ?ihandle ['] $call-method catch dup if |
| \ not necessary an error but very useful for debugging... |
| ." call-method " r@ dup cstrlen type ." : exception " dup . cr |
| then |
| r> drop |
| ; |
| |
| |
| \ ------------------------------------------------------------- |
| \ 6.3.2.3 Device I/O |
| \ ------------------------------------------------------------- |
| |
| : open ( dev_spec -- ihandle|0 ) |
| dup cstrlen open-dev |
| ; |
| |
| : close ( ihandle -- ) |
| close-dev |
| ; |
| |
| : read ( len addr ihandle -- actual ) |
| >r swap r> |
| dup ihandle>phandle " read" rot find-method |
| if swap call-package else 3drop -1 then |
| ; |
| |
| : write ( len addr ihandle -- actual ) |
| >r swap r> |
| dup ihandle>phandle " write" rot find-method |
| if swap call-package else 3drop -1 then |
| ; |
| |
| : seek ( pos_lo pos_hi ihandle -- status ) |
| dup ihandle>phandle " seek" rot find-method |
| if swap call-package else 3drop -1 then |
| ; |
| |
| |
| \ ------------------------------------------------------------- |
| \ 6.3.2.4 Memory |
| \ ------------------------------------------------------------- |
| |
| : claim ( align size virt -- baseaddr|-1 ) |
| -rot swap |
| ciface-ph " cif-claim" rot find-method |
| if execute else 3drop -1 then |
| ; |
| |
| : release ( size virt -- ) |
| swap |
| ciface-ph " cif-release" rot find-method |
| if execute else 2drop -1 then |
| ; |
| |
| \ ------------------------------------------------------------- |
| \ 6.3.2.5 Control transfer |
| \ ------------------------------------------------------------- |
| |
| : boot ( bootspec -- ) |
| ." BOOT" |
| ; |
| |
| : enter ( -- ) |
| ." ENTER" |
| ; |
| |
| \ exit ( -- ) is defined later (clashes with builtin exit) |
| |
| : chain ( virt size entry args len -- ) |
| ." CHAIN" |
| ; |
| |
| \ ------------------------------------------------------------- |
| \ 6.3.2.6 User interface |
| \ ------------------------------------------------------------- |
| |
| : interpret ( xxx cmdstring -- ??? catch-reult ) |
| dup cstrlen |
| \ ." INTERPRETE: --- " 2dup type |
| ['] evaluate catch dup if |
| \ this is not necessary an error... |
| ." interpret: exception " dup . ." caught" cr |
| |
| \ Force back to interpret state on error, otherwise the next call to |
| \ interpret gets confused if the error occurred in compile mode |
| 0 state ! |
| then |
| \ ." --- " cr |
| ; |
| |
| : set-callback ( newfunc -- oldfunc ) |
| callback-function @ |
| swap |
| callback-function ! |
| ; |
| |
| \ : set-symbol-lookup ( sym-to-value -- value-to-sym ) ; |
| |
| |
| \ ------------------------------------------------------------- |
| \ 6.3.2.7 Time |
| \ ------------------------------------------------------------- |
| |
| : milliseconds ( -- ms ) |
| get-msecs |
| ; |
| |
| \ ------------------------------------------------------------- |
| \ arch? |
| \ ------------------------------------------------------------- |
| |
| : start-cpu ( xxx xxx xxx --- ) |
| ." Start CPU unimplemented" cr |
| 3drop |
| ; |
| |
| \ ------------------------------------------------------------- |
| \ special |
| \ ------------------------------------------------------------- |
| |
| : exit ( -- ) |
| ." EXIT" |
| |
| \ Execute (exit) hook if one exists |
| s" (exit)" $find if |
| execute |
| else |
| 2drop |
| then |
| |
| outer-interpreter |
| ; |
| |
| : test-method ( cstring-method phandle -- missing? ) |
| swap dup cstrlen rot |
| |
| \ Check for incorrect phandle |
| dup phandle-exists? false = if |
| -1 throw |
| then |
| |
| find-method 0= if -1 else drop 0 then |
| ; |
| |
| [IFDEF] CONFIG_SPARC64 |
| |
| : SUNW,power-off ( -- ) |
| power-off |
| ; |
| |
| [THEN] |
| |
| finish-device |
| device-end |
| |
| |
| \ ------------------------------------------------------------- |
| \ entry point |
| \ ------------------------------------------------------------- |
| |
| : client-iface ( [args] name len -- [args] -1 | [rets] 0 ) |
| ciface-ph find-method 0= if -1 exit then |
| catch ?dup if |
| cr ." Unexpected client interface exception: " . -2 cr exit |
| then |
| 0 |
| ; |
| |
| : client-call-iface ( [args] name len -- [args] -1 | [rets] 0 ) |
| ciface-ph find-method 0= if -1 exit then |
| execute |
| 0 |
| ; |