[openfirmware] r1266 - dev/ide

[svn at openfirmware.info]

Author: wmb
Date: 2009-08-01 00:52:11 +0200 (Sat, 01 Aug 2009)
New Revision: 1266

Modified:
   dev/ide/dmaide.fth
   dev/ide/generic.fth
Log:
IDE driver - added DMA write support.



Modified: dev/ide/dmaide.fth
===================================================================
--- dev/ide/dmaide.fth	2009-07-31 20:05:33 UTC (rev 1265)
+++ dev/ide/dmaide.fth	2009-07-31 22:52:11 UTC (rev 1266)
@@ -38,7 +38,7 @@
 ;
 
 : dma-wait  ( -- )
-   begin  dma-stat@  dup 1 and 0=  swap 2 and  or  until
+   begin  1 ms  dma-stat@  dup 1 and 0=  swap 2 and  or  until
 ;
 
 \ Sense and clear errors.  The bit masked by 04 is read-clear and means
@@ -49,30 +49,36 @@
 
 : dma-interrupt?  ( -- flag )  dma-stat@ 4 and ;
 
-: dma-rblock  ( dma-adr #blks -- error? )
-   /block@ *
-   set-dma		( )
-   dma-cmd@ 1 or dma-cmd!   dma-wait  dma-cmd@ 1 invert and dma-cmd!
-   dma-interrupt?  if
+: dma-begin  ( dma-adr #blks direction -- dma-adr phys #blks )
+   dma-cmd!                             ( dma-adr #blks )
+   2dup /block@ * true " dma-map-in" $call-parent swap  ( adr phys #blks )
+   2dup /block@ *  set-dma		( adr phys #blks )
+   dma-cmd@ 1 or dma-cmd!               ( adr phys #blks )
+;
+: dma-end  ( adr phys #blks -- actual# )
+   dma-wait  0 dma-cmd!                        ( adr phys #blks )
+   dma-interrupt?  if                          ( adr phys #blks )
       r-csr@ drop			\ Clear interrupt in drive
-      dma-stat@ h# f0 and 4 or dma-stat!
-   then
-   dma-error?
-;
+      dma-stat@ h# f0 and 4 or dma-stat!       ( adr phys #blks )
+   then                                        ( adr phys #blks )
 
-: (drblocks)  ( adr #blks -- actual# )
-   tuck dma-rblock  if  drop  0  then
+   dma-error?  if  0  else  dup  then  >r      ( adr phys #blks r: actual )
+
+   /block@ * " dma-map-out" $call-parent       ( r: actual )
+
+   r>                                          ( actual# )
 ;
 
 : dma-rblocks  ( adr #blks -- actual#blks )
-   2dup /block@ * true " dma-map-in" $call-parent swap  ( adr phys #blks )
+   8 dma-begin             ( adr phys #blks )
+   dma-read-cmd r-csr!     ( adr phys #blks )
+   dma-end                 ( actual#blks )
+;
 
-   dma-read-cmd r-csr!
-   8 dma-cmd!  \ DMA direction for disk read (0 is write)
-   ['] rblock behavior >r  ['] dma-rblock to rblock
-   2dup (drblocks)                           ( adr phys #blks actual#blks )
-   r> to rblock
-   >r  /block@ * " dma-map-out" $call-parent  r>   ( actual#blks )
+: dma-wblocks  ( adr #blks -- actual#blks )
+   0 dma-begin             ( adr phys #blks )
+   dma-write-cmd r-csr!    ( adr phys #blks )
+   dma-end                 ( actual#blks )
 ;
 
 : vendor-id  ( -- w )  my-space " config-w@" $call-parent  ;
@@ -172,11 +178,13 @@
    4 my-w@  4 or  4 my-w!
 
    ['] dma-rblocks to rblocks
+   ['] dma-wblocks to wblocks
 ;
 ' (open-dma) to open-dma
 
 : (close-dma) ( -- )
    ['] pio-rblocks to rblocks
+   ['] pio-wblocks to wblocks
 
    \ Disable bus mastering
    4 my-w@  4 invert and  4 my-w!

Modified: dev/ide/generic.fth
===================================================================
--- dev/ide/generic.fth	2009-07-31 20:05:33 UTC (rev 1265)
+++ dev/ide/generic.fth	2009-07-31 22:52:11 UTC (rev 1266)
@@ -177,7 +177,8 @@
    chip-base io-blk-w!  false
    pio-end-hack
 ;
-: wblocks  ( addr #blks -- actual# | error )
+
+: pio-wblocks  ( addr #blks -- actual# | error )
    over >r                                      ( addr #blks ) ( R: addr )
    h# 30 r-csr!
 
@@ -194,6 +195,8 @@
    until
    r> - /block@ /
 ;
+defer wblocks
+' pio-wblocks to wblocks
 
 \ Read or write "#blks" blocks starting at "block#" into memory at "addr"
 \ Input? is true for reading or false for writing.