r1331 - ofw/core

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 )