[openfirmware] r1331 - ofw/core
svn at openfirmware.info
svn at openfirmware.info
Thu Aug 27 20:53:12 CEST 2009
Author: wmb
Date: 2009-08-27 20:53:11 +0200 (Thu, 27 Aug 2009)
New Revision: 1331
Modified:
ofw/core/muxdev.fth
Log:
Muxdev - propagate the ring-bell method.
Modified: ofw/core/muxdev.fth
===================================================================
--- ofw/core/muxdev.fth 2009-08-26 23:54:20 UTC (rev 1330)
+++ ofw/core/muxdev.fth 2009-08-27 18:53:11 UTC (rev 1331)
@@ -12,6 +12,7 @@
/n field >ihandle
/n field >read
/n field >write
+ /n field >bell
constant /list-node
: read ( adr len -- actual )
@@ -40,6 +41,17 @@
repeat ( adr len listnode )
drop nip
;
+: ring-bell ( -- )
+ first-device @
+ begin dup while ( listnode )
+ >r ( )
+ r@ >bell @ ?dup if ( xt )
+ r@ >ihandle @ call-package ( )
+ then ( )
+ r> >link @ ( listnode' )
+ repeat ( listnode )
+ drop
+;
: show-devices ( -- )
first-device @
@@ -61,13 +73,16 @@
ihandle>phandle ( phandle r: listnode )
- " read" 2 pick find-method 0= if 0 then ( phandle xt r: listnode )
+ " read" third find-method 0= if 0 then ( phandle xt r: listnode )
r@ >read !
- " write" 2 pick find-method 0= if 0 then ( phandle xt r: listnode )
+ " write" third find-method 0= if 0 then ( phandle xt r: listnode )
r@ >write ! ( phandle r: listnode )
- " install-abort" 2 pick find-method if ( phandle xt r: listnode )
+ " ring-bell" third find-method 0= if 0 then ( phandle xt r: listnode )
+ r@ >bell ! ( phandle r: listnode )
+
+ " install-abort" third find-method if ( phandle xt r: listnode )
r@ >ihandle @ call-package ( phandle r: listnode )
then ( phandle r: listnode )
More information about the openfirmware
mailing list