summaryrefslogtreecommitdiffstats
path: root/qemu/roms/openbios/forth/system
diff options
context:
space:
mode:
authorYang Zhang <yang.z.zhang@intel.com>2015-08-28 09:58:54 +0800
committerYang Zhang <yang.z.zhang@intel.com>2015-09-01 12:44:00 +0800
commite44e3482bdb4d0ebde2d8b41830ac2cdb07948fb (patch)
tree66b09f592c55df2878107a468a91d21506104d3f /qemu/roms/openbios/forth/system
parent9ca8dbcc65cfc63d6f5ef3312a33184e1d726e00 (diff)
Add qemu 2.4.0
Change-Id: Ic99cbad4b61f8b127b7dc74d04576c0bcbaaf4f5 Signed-off-by: Yang Zhang <yang.z.zhang@intel.com>
Diffstat (limited to 'qemu/roms/openbios/forth/system')
-rw-r--r--qemu/roms/openbios/forth/system/build.xml16
-rw-r--r--qemu/roms/openbios/forth/system/ciface.fs363
-rw-r--r--qemu/roms/openbios/forth/system/main.fs60
3 files changed, 439 insertions, 0 deletions
diff --git a/qemu/roms/openbios/forth/system/build.xml b/qemu/roms/openbios/forth/system/build.xml
new file mode 100644
index 000000000..f15440a07
--- /dev/null
+++ b/qemu/roms/openbios/forth/system/build.xml
@@ -0,0 +1,16 @@
+<build>
+
+ <!--
+ build description for openbios system bindings
+
+ Copyright (C) 2004-2005 by Stefan Reinauer
+ See the file "COPYING" for further information about
+ the copyright and warranty status of this work.
+ -->
+
+ <dictionary name="openbios" target="forth">
+ <object source="main.fs"/>
+ <object source="ciface.fs"/>
+ </dictionary>
+
+</build>
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
+;
diff --git a/qemu/roms/openbios/forth/system/main.fs b/qemu/roms/openbios/forth/system/main.fs
new file mode 100644
index 000000000..122ab1fa3
--- /dev/null
+++ b/qemu/roms/openbios/forth/system/main.fs
@@ -0,0 +1,60 @@
+\ tag: misc useful functions
+\
+\ Open Firmware Startup
+\
+\ Copyright (C) 2003 Samuel Rydh
+\
+\ See the file "COPYING" for further information about
+\ the copyright and warranty status of this work.
+\
+
+variable PREPOST-list
+variable POST-list
+variable SYSTEM-list
+variable DIAG-list
+
+: PREPOST-initializer ( xt -- )
+ PREPOST-list list-add ,
+;
+
+: POST-initializer ( xt -- )
+ POST-list list-add ,
+;
+
+: SYSTEM-initializer ( xt -- )
+ SYSTEM-list list-add ,
+;
+
+: DIAG-initializer ( xt -- )
+ DIAG-list list-add ,
+;
+
+
+\ OpenFirmware entrypoint
+: initialize-of ( startmem endmem -- )
+ initialize-forth
+
+ PREPOST-list begin list-get while @ execute repeat
+ POST-list begin list-get while @ execute repeat
+ SYSTEM-list begin list-get while @ execute repeat
+
+ \ evaluate nvramrc script
+ use-nvramrc? if
+ nvramrc evaluate
+ then
+
+ \ probe-all etc.
+ suppress-banner? 0= if
+ probe-all
+ install-console
+ banner
+ then
+
+ DIAG-list begin list-get while @ execute repeat
+
+ auto-boot? if
+ boot-command evaluate
+ then
+
+ outer-interpreter
+;