diff options
Diffstat (limited to 'qemu/roms/openbios/forth/system/ciface.fs')
| -rw-r--r-- | qemu/roms/openbios/forth/system/ciface.fs | 363 |
1 files changed, 363 insertions, 0 deletions
diff --git a/qemu/roms/openbios/forth/system/ciface.fs b/qemu/roms/openbios/forth/system/ciface.fs new file mode 100644 index 000000000..fd6c54efd --- /dev/null +++ b/qemu/roms/openbios/forth/system/ciface.fs @@ -0,0 +1,363 @@ + +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 ihandle>phandle +; + +: 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" + 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 +; + +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 +; |