[openfirmware] r1014 - in dev/usb2: device/wlan hcd hcd/ehci hcd/ohci

svn at openfirmware.info svn at openfirmware.info
Thu Dec 4 10:17:50 CET 2008


Author: wmb
Date: 2008-12-04 10:17:50 +0100 (Thu, 04 Dec 2008)
New Revision: 1014

Modified:
   dev/usb2/device/wlan/common.fth
   dev/usb2/device/wlan/fw8388.fth
   dev/usb2/device/wlan/usb8388.fth
   dev/usb2/device/wlan/wlan.fth
   dev/usb2/hcd/ehci/bulk.fth
   dev/usb2/hcd/ehci/control.fth
   dev/usb2/hcd/ehci/ehci.fth
   dev/usb2/hcd/ehci/qhtd.fth
   dev/usb2/hcd/hcd-call.fth
   dev/usb2/hcd/ohci/bulk.fth
Log:
USB speedups by using ring buffers for bulk in and out.

Modified: dev/usb2/device/wlan/common.fth
===================================================================
--- dev/usb2/device/wlan/common.fth	2008-12-04 09:17:43 UTC (rev 1013)
+++ dev/usb2/device/wlan/common.fth	2008-12-04 09:17:50 UTC (rev 1014)
@@ -72,17 +72,14 @@
 d# 2048 value /outbuf   \ Power of 2 larger than max-frame-size
                         \ Override as necessary
 
-0 value inbuf
 d# 2048 value /inbuf    \ Power of 2 larger than max-frame-size
                         \ Override as necessary
 
 : init-buf  ( -- )
    outbuf 0=  if  /outbuf dma-alloc to outbuf  then
-   inbuf  0=  if  /inbuf  dma-alloc to inbuf   then
 ;
 : free-buf  ( -- )
    outbuf  if  outbuf /outbuf dma-free  0 to outbuf  then
-   inbuf   if  inbuf  /inbuf  dma-free  0 to inbuf   then
 ;
 
 : property-or-abort  ( name$ -- n )
@@ -98,6 +95,12 @@
    " device-id"  property-or-abort  to pid
 ;
 
+: bulk-out  ( adr len pipe -- error? )
+   drop
+   " send-out" $call-parent  ( qtd )
+   " wait-out" $call-parent  ( error? )
+;
+
 headers
 
 \ LICENSE_BEGIN

Modified: dev/usb2/device/wlan/fw8388.fth
===================================================================
--- dev/usb2/device/wlan/fw8388.fth	2008-12-04 09:17:43 UTC (rev 1013)
+++ dev/usb2/device/wlan/fw8388.fth	2008-12-04 09:17:50 UTC (rev 1014)
@@ -67,26 +67,35 @@
 
 : dl-seq++  ( -- )  dl-seq 1+ to dl-seq  ;
 
-: cmd-fw-dl-ok?  ( len -- flag )
-   inbuf over vldump
-   /boot-ack <>  if  " Bad command status length" vtype false exit  then
-   inbuf >boot-magic le-l@ boot-magic <>  if  " Bad signature" vtype false exit  then
-   inbuf >cmd-status c@ boot-ack-ok =
+: cmd-fw-dl-ok?  ( adr len -- flag )
+   2dup vldump                              ( adr len )
+   /boot-ack <>  if                         ( adr )
+      drop                                  ( )
+      " Bad command status length" vtype
+      false exit
+   then                                     ( adr )
+   dup >boot-magic le-l@ boot-magic <>  if  ( adr )
+      drop                                  ( )
+      " Bad signature" vtype                ( )
+      false exit
+   then                                     ( adr )
+   >cmd-status c@ boot-ack-ok =             ( ok? )
 ;
 
 : wait-cmd-fw-dl-ack  ( -- acked? )
-   false d# 100 0  do
-      bulk-in?  if
-         restart-bulk-in drop leave	\ USB error
-      else
-         ?dup  if
-            cmd-fw-dl-ok? nip
-            restart-bulk-in
-            leave
-         then
-      then
-      1 ms
-   loop
+   d# 100 0  do			( )
+      bulk-in-ready?  if	( error | buf len 0 )
+         if			( )
+            false		( acked? )
+         else			( buf len )
+            cmd-fw-dl-ok?	( acked? )
+         then			( acked? )
+         restart-bulk-in	( acked? )
+         unloop exit
+      then			( )
+      1 ms			( )
+   loop				( )
+   false			( acked? )
 ;
 
 : download-fw-init  ( -- )
@@ -94,34 +103,28 @@
    boot-magic outbuf >boot-magic le-l!
    cmd-fw-dl  outbuf >boot-cmd   c!
 
-   inbuf /inbuf bulk-in-pipe begin-bulk-in
    5 0  do
       outbuf /boot-cmd bulk-out-pipe bulk-out drop
       wait-cmd-fw-dl-ack  if  leave  then
    loop
 ;
 
-: process-dl-resp  ( len -- )
-   inbuf over vldump
+: process-dl-resp  ( adr len -- )
+   2dup vldump
    h# 8 <  if  ." Response too short" abort  then
-   inbuf >dl-sync-seq le-l@ dl-seq <>  if  ." Bad sequence" abort  then
-   inbuf >dl-sync-ack le-l@ if  ." Image download failed" abort  then
+   dup >dl-sync-seq le-l@ dl-seq <>  if  drop  ." Bad sequence" abort  then
+   >dl-sync-ack le-l@  if  ." Image download failed" abort  then
 ;
 
 : wait-fw-dl-ack  ( -- )
-   d# 500 0  do
-      bulk-in?  if
-         drop restart-bulk-in  leave
-      else
-         ?dup if
-            process-dl-resp
-            restart-bulk-in
-            leave
-         else
-            1 ms
-         then
-      then
-   loop
+   d# 500 0  do				( )
+      bulk-in-ready?  if		( error | buf len 0 )
+         0= if  process-dl-resp  then	( )
+         restart-bulk-in		( )
+         leave
+      then				( )
+      1 ms				( )
+   loop					( )
 ;
 
 : (download-fw)  ( adr len -- )
@@ -149,14 +152,33 @@
    until  2drop
 ;
 
+: wait-fw  ( -- )
+   \ We first get a response packet saying that the download completed
+   wait-cmd-resp  if
+      ." No firmware download response; continuing anyway"  cr
+      d# 200 ms   \ Backwards compatibility with old firmware
+      exit
+   then
+
+   \ Wait for the "started" indicator
+   wait-event  if
+      ." Timeout waiting for firmware-started event" cr
+      exit
+   then    ( event )
+
+   h# 30 <>  if
+      ." Unexpected event while waiting for firmware-started" cr
+   then
+;
 : download-fw  ( adr len -- )
    driver-state ds-not-ready <>  if  " Firmware downloaded" vtype 2drop exit  then
-   2dup fw-image-ok? 0=  if  ." Bad WLAN firmware image" abort  then
+   2dup fw-image-ok? 0=  if  ." Bad WLAN firmware image" cr  exit  then
    download-fw-init
    (download-fw)
-   wait-cmd-resp drop			\ A packet is sent after download completes
+
+   wait-fw
+
    ds-ready to driver-state
-   d# 200 ms
    marvel-get-mac-address
 ;
 

Modified: dev/usb2/device/wlan/usb8388.fth
===================================================================
--- dev/usb2/device/wlan/usb8388.fth	2008-12-04 09:17:43 UTC (rev 1013)
+++ dev/usb2/device/wlan/usb8388.fth	2008-12-04 09:17:50 UTC (rev 1014)
@@ -112,7 +112,7 @@
 0 value preamble		\ 0=long, 2=short, 4=auto
 0 value auth-mode		\ 0: open; 1: shared key; 2: EAP
 h# 401 value cap		\ Capabilities
-3 value mac-ctrl		\ MAC control
+3 instance value mac-ctrl	\ MAC control
 
 external
 : set-preamble  ( preamble -- )  to preamble  ;
@@ -155,12 +155,13 @@
 
 : fw-seq++  ( -- )  fw-seq 1+ to fw-seq  ;
 
+d#     30 constant resp-wait-tiny
 d#  1,000 constant resp-wait-short
 d# 10,000 constant resp-wait-long
-resp-wait-short value resp-wait
+resp-wait-short instance value resp-wait
 
-/inbuf buffer: respbuf
-0 value /respbuf
+/inbuf instance buffer: respbuf
+0 instance value /respbuf
 
 \ =========================================================================
 \ Transmit Packet Descriptor
@@ -177,22 +178,34 @@
    1 field >tx-pwr
    1 field >tx-delay		\ in 2ms
    1+
+   1+  \ tx-mesh must be 0
+   1+  \ tx-mesh must be 0
+   1 field >tx-mesh-ttl
+   1+                    \ Just for alignment
    0 field >tx-pkt
-dup constant /tx-hdr
-4 - constant /tx-desc
+constant /tx-hdr
 
 0 constant tx-ctrl		\ Tx rates, etc
 
+\ The Libertas FW is currently abusing the WDS flag to mean "send on the mesh".
+\ At some point a separate mesh flag might be defined ...
+h# 20000 constant TX_WDS
+
+: mesh-on?  ( -- flag )  tx-ctrl TX_WDS and 0<>  ;
+
 : wrap-pkt  ( adr len -- adr' len' )
-   dup /tx-hdr + -rot			( len' adr len )
-   outbuf /tx-hdr erase			( len' adr len )
-   2dup outbuf >tx-pkt swap move	( len' adr len )
-   CMD_TYPE_DATA outbuf >fw-req le-l!	( len' adr len )
-   ( len )  outbuf >tx-len le-w!	( len' adr )
-   /tx-desc outbuf >tx-offset le-l!	( len' adr )
-   tx-ctrl  outbuf >tx-ctrl le-l!	( len' adr )
-   ( adr )  outbuf >tx-mac /mac-adr move	( len' )
-   outbuf swap				( adr' len' )
+   outbuf  /tx-hdr  erase			( adr len )
+   over  outbuf >tx-mac  /mac-adr  move		( adr len )
+   dup   outbuf >tx-len  le-w!			( adr len )
+   tuck  outbuf >tx-pkt  swap  move		( len )
+
+   CMD_TYPE_DATA  outbuf >fw-req    le-l!	( len )
+   /tx-hdr 4 -    outbuf >tx-offset le-l!	( len )  \ Offset from >tx-ctrl field
+   tx-ctrl        outbuf >tx-ctrl   le-l!	( len )
+
+   mesh-on?  if  1 outbuf >tx-mesh-ttl c!  then	( len )
+
+   outbuf  swap /tx-hdr +			( adr' len' )
 ;
 ' wrap-pkt to wrap-msg
 
@@ -200,10 +213,11 @@
 \ Receive Packet Descriptor
 \ =========================================================================
 
-true value got-data?
-0 value /data
-0 value data
+true instance value got-data?
+0 instance value /data
+0 instance value data
 
+\ Receive packet descriptor
 struct
    4 +				\ >fw-req
    2 field >rx-stat
@@ -216,14 +230,15 @@
    4 +
    1 field >rx-priority
    3 +
-dup constant /rx-desc
-   6 field >rx-dst-mac
-   6 field >rx-src-mac
-   0 field >rx-data-no-snap
-   2 field >rx-pkt-len		\ pkt len from >rx-snap-hdr
-   6 field >rx-snap-hdr
-   0 field >rx-data
-constant /rx-min
+\ dup constant /rx-desc
+\   6 field >rx-dst-mac
+\   6 field >rx-src-mac
+\   0 field >rx-data-no-snap
+\   2 field >rx-pkt-len		\ pkt len from >rx-snap-hdr
+\   6 field >rx-snap-hdr
+\   0 field >rx-data
+d# 22 +  \ Size of an Ethernet header with SNAP
+constant /rx-min  
 
 \ >rx-stat constants
 1 constant rx-stat-ok
@@ -247,24 +262,32 @@
    drop
 ;
 
-: unwrap-pkt  ( adr len -- adr' len' )
+: unwrap-pkt  ( adr len -- data-adr data-len )
    /rx-min <  if  drop 0 0  then	\ Invalid packet: too small
-   dup >rx-snap-hdr snap-header comp 0=  if	\ Remove snap header
-      dup >rx-data over >rx-data-no-snap 2 pick >rx-pkt-len be-w@ move
-      dup >rx-len le-w@ 8 -		\ Less snap-header and len field
-   else
-      dup >rx-len le-w@ 		( adr len' )
+
+   \ Go to the payload, skipping the descriptor header
+   dup  dup >rx-offset le-l@ + la1+	( adr data-adr )
+   swap >rx-len le-w@			( data-adr data-len )
+
+   \ Remove snap header by moving the MAC addresses up
+   \ That's faster than moving the contents down
+   over d# 14 + snap-header comp 0=  if	( data-adr data-len )
+      over  dup 8 +  d# 12  move	( data-adr data-len )
+      8 /string				( adr' len' )
    then
-   swap dup >rx-offset le-l@ + 4 + swap	( adr' len' )
 ;
 
 : process-data  ( adr len -- )
-   2dup vdump
-   over .rx-desc
+   2dup vdump				( adr len )
+   over .rx-desc			( adr len )
+
    over >rx-stat le-w@ rx-stat-ok <>  if  2drop exit  then
-   true to got-data?
-   unwrap-pkt				( adr' len' )
-   to /data to data
+
+   unwrap-pkt  to /data  to data	( )
+
+   true to got-data?	\ do-process-eapol may unset this
+
+   \ Check the Ethernet type field for EAPOL messages
    data d# 12 + be-w@ h# 888e =  if	\ Pass EAPOL messages to supplicant
       data /data ?process-eapol
    then
@@ -289,7 +312,9 @@
 : +xbl ( n -- )  'x be-l!  /l +x  ;
 
 : outbuf-bulk-out  ( dlen -- error? )
-   /fw-cmd + outbuf swap 2dup vdump bulk-out-pipe bulk-out  
+   /fw-cmd + outbuf swap		( adr len )
+   2dup vdump bulk-out-pipe		( adr len )
+   bulk-out				( error? )
 ;
 
 : .cmd  ( cmd -- )
@@ -359,28 +384,18 @@
 : prepare-cmd  ( len cmd -- )
    dup .cmd
    resp-wait-short to resp-wait
-   outbuf 2 pick /fw-cmd + erase
-   bulk-in? ?dup  if
-      nip
-      USB_ERR_INV_OP =  if
-         inbuf /inbuf bulk-in-pipe begin-bulk-in
-      else
-         restart-bulk-in			\ USB error
-      then
-   else
-      if  restart-bulk-in  then
-   then
-   fw-seq++
-   CMD_TYPE_REQUEST      outbuf >fw-req    le-l!
-   ( cmd )               outbuf >fw-cmd    le-w!
-   ( len ) /fw-cmd-hdr + outbuf >fw-len    le-w!
-   fw-seq                outbuf >fw-seq    le-w!
-   0                     outbuf >fw-result le-w!
-   set-fw-data-x
+   outbuf 2 pick /fw-cmd + erase                  ( len cmd )
+   fw-seq++					  ( len cmd )
+   CMD_TYPE_REQUEST      outbuf >fw-req    le-l!  ( len cmd )
+   ( cmd )               outbuf >fw-cmd    le-w!  ( len )
+   ( len ) /fw-cmd-hdr + outbuf >fw-len    le-w!  ( )
+   fw-seq                outbuf >fw-seq    le-w!  ( )
+   0                     outbuf >fw-result le-w!  ( )
+   set-fw-data-x				  ( )
 ;
 
-true value cmd-resp-error?
 true value got-response?
+true value got-indicator?
 
 : process-disconnect  ( -- )  ds-disconnected set-driver-state  ;
 : process-wakeup  ( -- )  ;
@@ -389,9 +404,12 @@
 : process-gmic-failure  ( -- )  ;
 
 : .event  ?cr  ." Event: "  type  cr ;
+0 instance value last-event
 : process-ind  ( adr len -- )
    drop
-   4 + le-l@  case
+   true to got-indicator?
+   4 + le-l@  dup to last-event
+   case
       h# 00  of  " Tx PPA Free" .event  endof  \ n
       h# 01  of  " Tx DMA Done" .event  endof  \ n
       h# 02  of  " Link Loss with scan" .event  process-disconnect  endof
@@ -415,16 +433,17 @@
       h# 1d  of  " SNR high" .event  endof
       h# 23  of  endof  \ Suppress this; the user doesn't need to see it
       \ h# 23  of  ." Mesh auto-started"  endof
-      h# 30  of  " Firmware ready" .event  endof
+      h# 30  of   endof  \ Handle this silently
+\      h# 30  of  " Firmware ready" .event  endof
       ( default )  ." Unknown " dup u.
    endcase
 ;
 
 : process-request  ( adr len -- )
-   2dup vdump
-   drop
-   true to got-response?
-   >fw-result le-w@  to cmd-resp-error?
+   2dup vdump			( adr len )
+   to /respbuf			( adr )
+   respbuf  /respbuf  move	( ) 
+   true to got-response?	( )
 ;
 
 : process-rx  ( adr len -- )
@@ -437,36 +456,56 @@
 ;
 
 : check-for-rx  ( -- )
-   bulk-in?  if
-      restart-bulk-in exit		\ USB error
-   else
-      ?dup  if
-         inbuf respbuf rot dup to /respbuf move
-         restart-bulk-in
-         respbuf /respbuf process-rx
-      then
-   then
+   bulk-in-ready?  if		( error | buf len 0 )
+      0= if  process-rx	 then	( )
+      restart-bulk-in		( )
+   then				( )
 ;
+
+\ : xcheck-for-rx  ( -- )
+\    bulk-in?  if                    ( actual )
+\       drop restart-bulk-in exit		\ USB error
+\    else                            ( actual )
+\       ?dup  if                     ( actual )
+\          inbuf respbuf rot dup to /respbuf move
+\          restart-bulk-in
+\          respbuf /respbuf process-rx
+\       then
+\    then
+\ ;
+
 \ -1 error, 0 okay, 1 retry
 : wait-cmd-resp  ( -- -1|0|1 )
    false to got-response?
-   false to got-data?
    resp-wait 0  do
       check-for-rx
       got-response?  if  leave  then
       1 ms
    loop
    got-response?  if
-      cmd-resp-error?  case
+      respbuf >fw-result le-w@  case
          0 of  0  endof  \ No error
          4 of  1  endof  \ Busy, so retry
          ( default )  ." Result = " dup u. cr  dup
       endcase
    else
-      ." Timeout or USB error" cr
+\      ." Timeout or USB error" cr
       true
    then
 ;
+: wait-event  ( -- true | event false )
+   false to got-indicator?
+   d# 1000 0  do
+      check-for-rx
+      got-indicator?  if  last-event false unloop exit  then
+      1 ms
+   loop
+   true
+;
+: outbuf-wait  ( len -- error? )
+   outbuf-bulk-out  ?dup  if  exit  then
+   wait-cmd-resp
+;
 
 
 \ =========================================================================
@@ -493,17 +532,6 @@
                    endcase
 ;
 
-: .hw-spec  ( adr -- )
-   ." HW interface version: " dup >fw-data le-w@ u. cr
-   ." HW version: " dup >fw-data 2 + le-w@ u. cr
-   ." Max multicast addr: " dup >fw-data 6 + le-w@ .d cr
-   ." MAC address: " dup >fw-data 8 + .enaddr cr
-   ." Region code: " dup >fw-data d# 14 + le-w@ u. cr
-   ." # antenna: " dup >fw-data d# 16 + le-w@ .d cr
-   ." FW release: " dup >fw-data d# 18 + le-l@ u. cr
-   ." FW capability:" >fw-data d# 34 + le-l@ .fw-cap cr
-;
-
 : .log  ( adr -- )
    dup >fw-len le-w@ /fw-cmd-hdr =  if  drop exit  then
    ." Multicast txed:       " dup >fw-data le-l@ u. cr
@@ -529,6 +557,23 @@
 
 : reset-wlan  ( -- )  " wlan-reset" evaluate  ;
 
+: marvel-get-hw-spec  ( -- true | adr false )
+   d# 38 h# 03 ( CMD_GET_HW_SPEC ) prepare-cmd
+   d# 38 outbuf-bulk-out  ?dup  if  true exit  then
+   resp-wait-tiny to resp-wait
+   wait-cmd-resp  if  true exit  then
+
+   respbuf >fw-data  false
+;
+
+\ The purpose of this is to work around a problem that I don't fully understand.
+\ For some reason, when you reopen the device without re-downloading the
+\ firmware, the first command silently fails - you don't get a response.
+\ This is a "throwaway" command to handle that case without a long timeout
+\ or a warning message.
+
+: nonce-cmd  ( -- )  marvel-get-hw-spec  0=  if  drop  then  ;
+
 \ =========================================================================
 \ MAC address
 \ =========================================================================
@@ -536,9 +581,7 @@
 : marvel-get-mac-address  ( -- )
    8 h# 4d ( CMD_802_11_MAC_ADDRESS ) prepare-cmd
    ACTION_GET +xw
-   8 outbuf-bulk-out
-   ?dup if  ." Failed to send get mac address command: " u. cr exit  then
-   wait-cmd-resp  if  exit  then
+   8 outbuf-wait  if  ." marvel-get-mac-address failed" cr exit  then
    respbuf >fw-data 2 + mac-adr$ move
 ;
 
@@ -546,15 +589,13 @@
    8 h# 4d ( CMD_802_11_MAC_ADDRESS ) prepare-cmd
    ACTION_SET +xw
    mac-adr$ +x$
-   8 outbuf-bulk-out  if  exit  then
-   wait-cmd-resp  if  exit  then
+   8 outbuf-wait  if  exit  then
 ;
 
 : marvel-get-mc-address  ( -- )
    4 /mc-adrs + h# 10 ( CMD_MAC_MULTICAST_ADR ) prepare-cmd
    ACTION_GET +xw
-   4 /mc-adrs + outbuf-bulk-out  if  exit  then
-   wait-cmd-resp  if  exit  then
+   4 /mc-adrs + outbuf-wait  if  exit  then
    respbuf >fw-data 2 + le-w@ to #mc-adr
    respbuf >fw-data 4 + mc-adrs #mc-adr /mac-adr * move
 ;
@@ -566,8 +607,7 @@
    to #mc-adr
    ( adr len ) 2dup +x$				\ Multicast addresses
    mc-adrs swap move
-   4 /mc-adrs + outbuf-bulk-out  if  exit  then
-   wait-cmd-resp  if  exit  then
+   4 /mc-adrs + outbuf-wait  if  exit  then
 ;
 
 \ =========================================================================
@@ -578,8 +618,7 @@
    8 swap prepare-cmd
    ACTION_GET +xw
    ( reg ) +xw
-   8 outbuf-bulk-out  if  0 exit  then
-   wait-cmd-resp  if  0 exit  then
+   8 outbuf-wait  if  0 exit  then
    respbuf >fw-data 4 + le-l@
 ;
 
@@ -597,8 +636,7 @@
    ACTION_GET +xw
    ( idx ) +xw
    4 +xw
-   a outbuf-bulk-out  if  0 exit  then
-   wait-cmd-resp  if  0 exit  then
+   a outbuf-wait  if  0 exit  then
    respbuf >fw-data 6 + le-l@
 ;
 
@@ -610,8 +648,7 @@
    4 h# 1c ( CMD_802_11_RADIO_CONTROL ) prepare-cmd
    ACTION_SET +xw
    preamble 1 or +xw	\ Preamble, RF on
-   4 outbuf-bulk-out  if  exit  then
-   wait-cmd-resp  if  exit  then
+   4 outbuf-wait  if  exit  then
 ;
 
 : (set-bss-type)  ( bsstype -- ok? )
@@ -620,29 +657,32 @@
    0 +xw		\ Object = desiredBSSType
    1 +xw		\ Size of object
    ( bssType ) +xb	
-   6 d# 128 + outbuf-bulk-out  if  false exit  then
-   wait-cmd-resp 0=
+   6 d# 128 + outbuf-wait 0=
 ;
 
 external
 : set-bss-type  ( bssType -- ok? )  dup to bss-type (set-bss-type)  ;
 headers
 
-: set-mac-control  ( -- )
+: (set-mac-control)  ( -- error? )
    4 h# 28 ( CMD_MAC_CONTROL ) prepare-cmd
    mac-ctrl +xw		\ WEP type, WMM, protection, multicast, promiscous, WEP, tx, rx
-   4 outbuf-bulk-out  if  exit  then
-   wait-cmd-resp  if  exit  then
+   4 outbuf-wait
 ;
 
+: set-mac-control  ( -- error? )
+   (set-mac-control)  if
+     (set-mac-control) drop
+   then
+;
+
 : set-domain-info  ( adr len -- )
    dup 6 + h# 5b ( CMD_802_11D_DOMAIN_INFO ) prepare-cmd
    ACTION_SET +xw
    7 +xw				\ Type = MrvlIETypes_DomainParam_t
    ( len ) dup +xw			\ Length of payload
    ( adr len ) tuck +x$			\ Country IE
-   ( len ) 6 + outbuf-bulk-out  if  exit  then
-   wait-cmd-resp  if  exit  then
+   ( len ) 6 + outbuf-wait  if  exit  then
 ;
 
 : enable-11d  ( -- )
@@ -651,8 +691,7 @@
    9 +xw		\ Object = enable 11D
    2 +xw		\ Size of object
    1 +xw		\ Enable 11D
-   6 d# 128 + outbuf-bulk-out  if  exit  then
-   wait-cmd-resp  if  exit  then
+   6 d# 128 + outbuf-wait  if  exit  then
 ;
 
 external
@@ -691,6 +730,10 @@
    set-mac-control
 ;
 : set-multicast  ( adr len -- )   marvel-set-mc-address  enable-multicast  ;
+
+: mac-off  ( -- )
+   0 to mac-ctrl  set-mac-control  3 to mac-ctrl
+;
 headers
 
 \ =========================================================================
@@ -749,18 +792,22 @@
 
 d# 34 instance buffer: ssid
 
+0 value scan-type
+: active-scan  ( -- )  0 to scan-type  ;
+: passive-scan  ( -- )  1 to scan-type  ;
+
 : make-chan-list-param  ( adr -- )
    #channels 0  do
       dup i /chan-list * +
       0 over >radio-type c!
       i 1+ over >channel# c!
-      0 over >scan-type c!
+      scan-type over >scan-type c!
       d# 100 over >min-scan-time le-w!
       d# 100 swap >max-scan-time le-w!
    loop  drop
 ;
 
-: (scan)  ( -- error? )
+: (scan)  ( -- error? | adr len 0 )
    /cmd_802_11_scan  ssid c@  if
       /marvel-IE-hdr +  ssid c@ +
    then
@@ -790,19 +837,29 @@
       /cmd_802_11_scan                            ( cmdlen )
    then                                           ( cmdlen )
 
-   outbuf-bulk-out  if  true exit  then
-   wait-cmd-resp
+   outbuf-wait					  ( error? )
+   dup  0=  if 				          ( error? )
+      respbuf /respbuf /fw-cmd /string  rot       ( adr len 0 )
+   then
 ;
 
 external
 \ Ask the device to look for the indicated SSID.
-: set-ssid  ( adr len -- )  h# 32 min  ssid pack drop  ;
+: set-ssid  ( adr len -- )
+   \ This is an optimization for NAND update over the mesh.
+   \ It prevents listening stations, of which there can be many,
+   \ from transmitting when they come on-line.
+   2dup  " olpc-mesh"  $=  if  passive-scan  then
 
+   h# 32 min  ssid pack drop
+;
+
 : scan  ( adr len -- actual )
    begin  (scan)  dup 1 =  while  drop d# 1000 ms  repeat  \ Retry while busy
-   if  2drop 0 exit  then
-   respbuf /respbuf /fw-cmd /string	( adr len radr rlen )
-   rot min -rot swap 2 pick move	( actual )
+   if  2drop 0 exit  then               ( adr len scan-adr scan-len )
+   rot min >r                           ( adr scan-adr r: len )
+   swap r@ move			        ( r: len )
+   r>
 ;
 headers
 
@@ -833,8 +890,7 @@
       ?dup  if  x /x + swap move  else  drop  then
       d# 16 /x + to /x
    loop
-   d# 72 outbuf-bulk-out  if  false exit  then
-   wait-cmd-resp 0=
+   d# 72 outbuf-wait 0=
 ;
 : set-wep  ( wep4$ wep3$ wep2$ wep1$ idx -- ok? )
    to wep-idx
@@ -855,8 +911,7 @@
    d# 72 h# 13 ( CMD_802_11_SET_WEP ) prepare-cmd
    ACTION_REMOVE +xw
    0 +xw				\ TxKeyIndex
-   d# 72 outbuf-bulk-out  if  false exit  then
-   wait-cmd-resp 0=
+   d# 72 outbuf-wait 0=
 ;
 headers
 
@@ -868,8 +923,7 @@
    4 h# 2f ( CMD_802_11_ENABLE_RSN ) prepare-cmd
    ACTION_SET +xw
    ( enable? ) +xw		\ 1: enable; 0: disable
-   4 outbuf-bulk-out  if  false exit  then
-   wait-cmd-resp 0=
+   4 outbuf-wait 0=
 ;
 
 external
@@ -887,8 +941,7 @@
    dup        +xw			\ Key length
    ( key$ )   +x$			\ key$
    /x dup /fw-cmd-hdr + outbuf >fw-len le-w!	\ Finally set the length
-   outbuf-bulk-out  if  exit  then
-   wait-cmd-resp  if  exit  then
+   outbuf-wait  if  exit  then
 ;
 
 external
@@ -944,8 +997,7 @@
    0      +xw				\ Probe delay time
 
    /x dup /fw-cmd-hdr + outbuf >fw-len le-w!	\ Finally set the length
-   outbuf-bulk-out  if  false exit  then
-   wait-cmd-resp  if  ." Failed to join adhoc network" cr false exit  then
+   outbuf-wait  if  ." Failed to join adhoc network" cr false exit  then
    true
 ;
 
@@ -961,19 +1013,104 @@
    7 h# 11 ( CMD_802_11_AUTHENTICATE ) prepare-cmd
    ( target-mac$ ) +x$		\ Peer MAC address
    auth-mode +xb		\ Authentication mode
-   7 outbuf-bulk-out  if  exit  then
-   wait-cmd-resp  if  exit  then
+   7 outbuf-wait  if  exit  then
 ;
 
 : deauthenticate  ( mac$ -- )
    8 h# 24 ( CMD_802_11_DEAUTHENTICATE ) prepare-cmd
    ( mac$ ) +x$			\ AP MAC address
    3 +xw			\ Reason code: station is leaving
-   8 outbuf-bulk-out  if  exit  then
-   wait-cmd-resp  if  exit  then
+   8 outbuf-wait  if  exit  then
    ds-disconnected set-driver-state
 ;
 
+\ Mesh
+
+: mesh-access!  ( value cmd -- )
+   h# 82 h# 9b ( CMD_MESH_ACCESS ) prepare-cmd  ( value cmd )
+   +xw  +xl                                     ( )
+
+   h# 82 outbuf-wait  if  exit  then
+;
+: mesh-access@  ( cmd -- value )
+   h# 82 h# 9b ( CMD_MESH_ACCESS ) prepare-cmd  ( value cmd )
+   +xw                                          ( )
+
+   h# 82 outbuf-wait  if  -1 exit  then
+   respbuf >fw-data wa1+ le-l@
+;
+
+: mesh-config-set  ( adr len type channel action -- error? )
+   h# 88 h# a3 ( CMD_MESH_CONFIG ) prepare-cmd  ( adr len type channel action )
+   +xw +xw +xw                                  ( adr len )
+   dup +xw +x$                                  ( )
+
+   h# 88 outbuf-wait
+;
+: mesh-config-get  ( -- true | buf false )
+   h# 88 h# a3 ( CMD_MESH_CONFIG ) prepare-cmd  ( )
+   3 +xw 0 +xw 5 +xw                            ( )
+
+   h# 88 outbuf-wait  if  true exit  then
+   respbuf >fw-data   false
+;
+: (mesh-start)  ( channel tlv -- error? )
+   " "(dd 0e 00 50 43 04 00 00 00 00 00 04)mesh"  ( channel tlv adr len )
+   2swap swap  1  ( adr len tlv channel action )  \ 1 is CMD_ACT_MESH_CONFIG_START
+   mesh-config-set   
+;
+
+: mesh-stop  ( -- error? )
+   mesh-on?  if
+      " "  0 0 0 mesh-config-set                ( error? )
+      tx-ctrl  TX_WDS invert and  to tx-ctrl    ( error? )
+      ds-associated reset-driver-state          ( error? )
+   else
+      false                                     ( error? )
+   then
+;
+
+: mesh-start  ( channel -- error? )
+   \ h# 223 (0x100 + 291) is an old value
+   \ h# 125 (0x100 + 37) is an "official" value that doesn't work
+   h# 223 (mesh-start)  dup  0=  if   ( error? )
+      tx-ctrl  TX_WDS or to tx-ctrl   ( error? )
+      ds-associated set-driver-state  ( error? )
+   then                               ( error? )
+;
+
+instance variable mesh-param
+: mesh-set-bootflag  ( bootflag -- error? )
+   mesh-param le-l!  mesh-param 4  1 0 3 mesh-config-set
+;
+: mesh-set-boottime  ( boottime -- error? )
+   mesh-param le-w!  mesh-param 2  2 0 3 mesh-config-set
+;
+: mesh-set-def-channel  ( boottime -- error? )
+   mesh-param le-w!  mesh-param 2  3 0 3 mesh-config-set
+;
+: mesh-set-ie  ( adr len -- error? )  4 0 3 mesh-config-set  ;
+: mesh-set-ttl  ( ttl -- )  2 mesh-access!  ;
+: mesh-get-ttl  ( -- ttl )  1 mesh-access@  ;
+: mesh-set-bcast  ( index -- )  8 mesh-access!  ;
+: mesh-get-bcast  ( -- index )  9 mesh-access@  ;
+
+[ifdef] notdef
+: mesh-set-anycast  ( mask -- )  5 mesh-access!  ;
+: mesh-get-anycast  ( -- mask )  4 mesh-access@  ;
+
+: mesh-set-rreq-delay  ( n -- )  d# 10 mesh-access!  ;
+: mesh-get-rreq-delay  ( -- n )  d# 11 mesh-access@  ;
+
+: mesh-set-route-exp  ( n -- )  d# 12 mesh-access!  ;
+: mesh-get-route-exp  ( -- n )  d# 13 mesh-access@  ;
+
+: mesh-set-autostart  ( n -- )  d# 14 mesh-access!  ;
+: mesh-get-autostart  ( -- n )  d# 15 mesh-access@  ;
+
+: mesh-set-prb-rsp-retry-limit  ( n -- )  d# 17 mesh-access!  ;
+[then]
+
 \ =========================================================================
 \ Associate/disassociate
 \ =========================================================================
@@ -1060,8 +1197,7 @@
    \ XXX pass thru IEs (optional)
 
    /x dup /fw-cmd-hdr + outbuf >fw-len le-w!	\ Finally set the length
-   outbuf-bulk-out  if  false exit  then
-   wait-cmd-resp  if  false exit  then
+   outbuf-wait  if  false exit  then
 
    respbuf >fw-data 2 + le-w@ ?dup  if \ This is the IEEE Status Code
       ." Failed to associate: " u. cr
@@ -1074,7 +1210,20 @@
 ;
 
 external
+instance defer mesh-default-modes
+' noop to mesh-default-modes
+: nandcast-mesh-modes  ( -- )
+   1 mesh-set-ttl
+   d# 12 mesh-set-bcast
+;
+' nandcast-mesh-modes to mesh-default-modes
+
 : associate  ( ch ssid$ target-mac$ -- ok? )
+   2over  " olpc-mesh" $=  if       ( ch ssid$ target-mac$ )
+      2drop 2drop mesh-start 0=     ( ok? )
+      dup  if  mesh-default-modes  then
+      exit
+   then
    ?set-wep				\ Set WEP keys again, if ktype is WEP
    set-mac-control
    2dup authenticate
@@ -1090,15 +1239,15 @@
 ;
 
 : ?reassociate  ( -- )
-   driver-state ds-disconnected and  if  do-associate drop  then  ;
+   driver-state ds-disconnected and  if  do-associate drop  then
+;
 ' ?reassociate to start-nic
 
 : disassociate  ( mac$ -- )
    8 h# 26 ( CMD_802_11_DISASSOCIATE ) prepare-cmd
    ( mac$ ) +x$			\ AP MAC address
    3 +xw			\ Reason code: station is leaving
-   8 outbuf-bulk-out  if  exit  then
-   wait-cmd-resp  if  exit  then
+   8 outbuf-wait  if  exit  then
    ds-disconnected set-driver-state
 ;
 
@@ -1110,39 +1259,76 @@
 : get-rf-channel  ( -- )
    d# 40 h# 1d ( CMD_802_11_RF_CHANNEL ) prepare-cmd
    ACTION_GET +xw
-   d# 40 outbuf-bulk-out  if  exit  then
-   wait-cmd-resp  if  exit  then
+   d# 40 outbuf-wait  if  exit  then
    ." Current channel = " respbuf >fw-data 2 + le-w@ .d cr
 ;
 
+: get-beacon  ( -- interval enabled? )
+   6 h# b0 ( CMD_802_11_BEACON_CTRL ) prepare-cmd
+   ACTION_GET +xw
+   6 outbuf-wait  if  exit  then
+   respbuf >fw-data  dup 2 wa+ le-w@  swap wa1+ le-w@
+;
+
+: set-beacon  ( interval enabled? -- )
+   6 h# b0 ( CMD_802_11_BEACON_CTRL ) prepare-cmd
+   ACTION_SET +xw   ( interval enabled? )
+   +xw +xw
+   6 outbuf-wait drop
+;
+
+
 : get-log  ( -- )
    0 h# b ( CMD_802_11_GET_LOG ) prepare-cmd
-   0 outbuf-bulk-out  if  exit  then
-   wait-cmd-resp  if  exit  then
+   0 outbuf-wait  if  exit  then
    respbuf .log
 ;
 
 : get-rssi  ( -- )
    2 h# 1f ( CMD_802_11_RSSI ) prepare-cmd
    8 +xw			\ Value used for exp averaging
-   2 outbuf-bulk-out  if  exit  then
-   wait-cmd-resp  if  exit  then
+   2 outbuf-wait  drop
    \ XXX What to do with the result?
 ;
 
-: get-hw-spec  ( -- )
-   d# 38 3 ( CMD_802_11_GET_HW_SPEC ) prepare-cmd
-   ACTION_GET +xw
-   d# 38 outbuf-bulk-out  if  exit  then
-   wait-cmd-resp  if  exit  then
-   respbuf .hw-spec
+: .hw-spec  ( -- )
+   marvel-get-hw-spec  if
+      ." marvel-get-hw-spec command failed" cr
+   else
+      ." HW interface version: " dup le-w@ u. cr
+      ." HW version: " dup 2 + le-w@ u. cr
+      ." Max multicast addr: " dup 6 + le-w@ .d cr
+      ." MAC address: " dup 8 + .enaddr cr
+      ." Region code: " dup d# 14 + le-w@ u. cr
+      ." # antenna: " dup d# 16 + le-w@ .d cr
+      ." FW release: " dup d# 18 + le-l@ u. cr
+      ." FW capability:" d# 34 + le-l@ .fw-cap cr
+   then
 ;
 
+: set-data-rate  ( rate-code -- )
+   #rates 4 +  h# 22 ( CMD_802_11_DATA_RATE ) prepare-cmd
+
+   1 ( CMD_ACT_SET_TX_FIX_RATE ) +xw
+   0 +xw  \ reserved field
+   ( rate-code ) +xb
+
+   #rates 4 +  outbuf-wait  drop
+;
+: auto-data-rate  ( -- )
+   #rates 4 +  h# 22 ( CMD_802_11_DATA_RATE ) prepare-cmd
+
+   0 ( CMD_ACT_SET_TX_FIX_RATE ) +xw
+   0 +xw  \ reserved field
+
+   #rates 4 +  outbuf-wait  drop
+;
+
+
 : get-data-rates  ( -- )
    #rates 4 + h# 22 ( CMD_802_11_DATA_RATE ) prepare-cmd
    2 ( HostCmd_ACT_GET_TX_RATE ) +xw
-   #rates 4 + outbuf-bulk-out  if  exit  then
-   wait-cmd-resp  if  exit  then
+   #rates 4 + outbuf-wait  drop
 ;
 
 2 constant gpio-pin 
@@ -1156,8 +1342,7 @@
 
 : host-sleep-activate  ( -- )
    0 h# 45 ( CMD_802_11_HOST_SLEEP_ACTIVATE ) prepare-cmd
-   0 outbuf-bulk-out  if  exit  then
-   wait-cmd-resp  if  exit  then
+   0 outbuf-wait  drop
 ;
 
 : host-sleep-config  ( conditions -- )
@@ -1169,22 +1354,91 @@
    gpio-pin +xb
    wake-gap +xb
 
-   6 outbuf-bulk-out  if  exit  then
-   wait-cmd-resp  if  exit  then
+   6 outbuf-wait  drop
 ;
 
 : unicast-wakeup  ( -- )  wake-on-unicast host-sleep-config  ;
 : broadcast-wakeup  ( -- )  wake-on-unicast wake-on-broadcast or  host-sleep-config  ;
 : sleep ( -- ) host-sleep-activate  ;
 
+[ifdef] notdef
+  CMD_ACT_MESH_...
+ 1 GET_TTL   2 SET_TTL   3 GET_STATS   4 GET_ANYCAST   5 SET_ANYCAST
+ 6 SET_LINK_COSTS  7 GET_LINK_COSTS   8 SET_BCAST_RATE   9 GET_BCAST_RATE
+10 SET_RREQ_DELAY  11 GET_RREQ_DELAY  12 SET_ROUTE_EXP  13 GET_ROUTE_EXP
+14 SET_AUTOSTART_ENABLED  15 GET_AUTOSTART_ENABLED  16 not used
+17 SET_PRB_RSP_RETRY_LIMIT
+
+CMD_TYPE_MESH_
+1 SET_BOOTFLAG  2 SET_BOOTTIME  3 SET_DEF_CHANNEL  4 SET_MESH_IE
+5 GET_DEFAULTS  6 GET_MESH_IE /* GET_DEFAULTS is superset of GET_MESHIE */
+
+CMD_ACT_MESH_CONFIG_..  0 STOP  1 START  2 SET  3 GET
+
+struct cmd_ds_mesh_config {
+        struct cmd_header hdr;
+        __le16 action; __le16 channel; __le16 type; __le16 length;
+        u8 data[128];   /* last position reserved */
+}
+struct mrvl_meshie_val {
+        uint8_t oui[P80211_OUI_LEN];
+        uint8_t type;
+        uint8_t subtype;
+        uint8_t version;
+        uint8_t active_protocol_id;
+        uint8_t active_metric_id;
+        uint8_t mesh_capability;
+        uint8_t mesh_id_len;
+        uint8_t mesh_id[IW_ESSID_MAX_SIZE];  32
+}
+struct ieee80211_info_element {
+        u8 id;  u8 len;  u8 data[0];
+}
+struct mrvl_meshie {
+        struct ieee80211_info_element hdr;
+        struct mrvl_meshie_val val;
+}
+        memset(&cmd, 0, sizeof(cmd));
+        cmd.channel = cpu_to_le16(chan);
+        ie = (struct mrvl_meshie *)cmd.data;
+
+        switch (action) {
+        case CMD_ACT_MESH_CONFIG_START:
+0.b      221    ie->hdr.id = MFIE_TYPE_GENERIC;
+2.b      h# 00  ie->val.oui[0] = 0x00;
+3.b      h# 50  ie->val.oui[1] = 0x50;
+4.b      h# 43  ie->val.oui[2] = 0x43;
+5.b      4      ie->val.type = MARVELL_MESH_IE_TYPE;
+6.b      0      ie->val.subtype = MARVELL_MESH_IE_SUBTYPE;
+7.b      0      ie->val.version = MARVELL_MESH_IE_VERSION;
+8.b      0      ie->val.active_protocol_id = MARVELL_MESH_PROTO_ID_HWMP;
+9.b      0      ie->val.active_metric_id = MARVELL_MESH_METRIC_ID;
+10.b     0      ie->val.mesh_capability = MARVELL_MESH_CAPABILITY;
+11.b  ssid_len  ie->val.mesh_id_len = priv->mesh_ssid_len;
+12              memcpy(ie->val.mesh_id, priv->mesh_ssid, priv->mesh_ssid_len);
+1  10+ssid_len  ie->hdr.len = sizeof(struct mrvl_meshie_val) - IW_ESSID_MAX_SIZE + priv->mesh_ssid_len;
+
+    42 (32+10)  cmd.length = cpu_to_le16(sizeof(struct mrvl_meshie_val));
+
+config_start:  action is 1 (...CONFIG_START), type = mesh_tlv which is either h# 100 d# 291 +  or h# 100 d# 37 +
+[then]
+
+[ifdef] notdef
+create mesh_start_cmd
+   \ MFIE_TYPE_GENERIC  ielen (10 + sizeof("mesh"))
+   d# 221 c,            d# 14 c,
+
+   \  OUI....................  type  subtyp vers  proto metric cap
+   h# 00 c, h# 50 c, h# 43 c,  4 c,  0 c,   0 c,  0 c,  0 c,   0 c, 
+
+   \ ssidlen   ssid (set at 12)
+   d# 04 c,   here 4 allot  " mesh" rot swap move
+here mesh_start_cmd - constant /mesh_start_cmd
+[then]
+
 [ifdef] wlan-wackup  \ This is test code that only works with a special debug version of the Libertas firmware
 : autostart  ( -- )
-   h# 82 h# 9b ( CMD_MESH_ACCESS ) prepare-cmd
-   5 +xw  \ CMD_ACT_SET_ANYCAST
-   h# 700000 +xl
-
-   h# 82 outbuf-bulk-out  if  exit  then
-   wait-cmd-resp  if  exit  then
+   h# 700000 h# 5 mesh-access!
 ;
 [then]
 

Modified: dev/usb2/device/wlan/wlan.fth
===================================================================
--- dev/usb2/device/wlan/wlan.fth	2008-12-04 09:17:43 UTC (rev 1013)
+++ dev/usb2/device/wlan/wlan.fth	2008-12-04 09:17:50 UTC (rev 1014)
@@ -54,6 +54,8 @@
 
 false instance value use-promiscuous?
 
+: end-out-ring  ( -- )  " end-out-ring" $call-parent  ;
+
 external
 
 \ Set to true to force open the driver without association.
@@ -76,9 +78,12 @@
    device set-target
    opencount @ 0=  if
       init-buf
-      ?load-fw 0=  if  free-buf false exit  then
+      /outbuf     4 bulk-out-pipe " begin-out-ring" $call-parent
+      /inbuf  h# 40 bulk-in-pipe  " begin-in-ring"  $call-parent
+      ?load-fw 0=  if  end-bulk-in end-out-ring free-buf false exit  then
       my-args " supplicant" $open-package to supplicant-ih
-      supplicant-ih 0=  if  free-buf false exit  then
+      supplicant-ih 0=  if  end-bulk-in end-out-ring free-buf false exit  then
+      nonce-cmd
       force-open?  if  true exit  then
       link-up? 0=  if
          ['] 2drop to ?process-eapol
@@ -86,8 +91,6 @@
          ds-disconnected reset-driver-state
          ds-associated set-driver-state
          ['] do-process-eapol to ?process-eapol
-      else
-         inbuf /inbuf bulk-in-pipe begin-bulk-in
       then
       start-nic
    then
@@ -100,10 +103,13 @@
    opencount @ 1-  0 max  opencount !
    opencount @ 0=  if
       disable-multicast
+      mesh-stop drop
       link-up?  if  target-mac$ deauthenticate  then
       ['] 2drop to ?process-eapol
+      stop-nic
+      mac-off
       end-bulk-in
-      stop-nic
+      end-out-ring
       free-buf
       supplicant-ih ?dup  if  close-package 0 to supplicant-ih  then
    then
@@ -113,26 +119,28 @@
 \ Used by the /supplicant support package to perform key handshaking.
 : write-force  ( adr len -- actual )
    tuck wrap-msg			( actual adr' len' )
-   bulk-out-pipe bulk-out		( actual usberr )
-   if  drop -1  then			( actual )
+   " send-out" $call-parent drop 	( actual )
 ;
 : read-force  ( adr len -- actual )
-   false to got-data?
-   bulk-in?  if
-      restart-bulk-in -1 exit		\ USB error
-   else
-      ?dup  if
-         inbuf respbuf rot dup to /respbuf move
-         restart-bulk-in
-         respbuf /respbuf process-rx
-      then
-   then
+   bulk-in-ready?  0=  if  		( adr len )
+      2drop  -2  exit
+   then                                 ( adr len [ error | buf actual 0 ] )
 
-   got-data?  if
+   if					( adr len )
+      restart-bulk-in			( adr len )
+      2drop  -1  exit
+   then					( adr len buf actual )
+
+   false to got-data?			( adr len buf actual )
+   process-rx				( adr len )
+
+   got-data?  if			( adr len )
       /data min tuck data -rot move	( actual )
-   else
+   else					( adr len )
       2drop -2				\ No data
-   then
+   then					( actual )
+
+   restart-bulk-in
 ;
 
 \ Normal read and write methods.
@@ -178,8 +186,8 @@
 
    (scan)  if
       ." Failed to scan" true cr
-   else
-      respbuf /fw-cmd + .scan false
+   else    ( adr len )
+      drop .scan false
    then
 
    close

Modified: dev/usb2/hcd/ehci/bulk.fth
===================================================================
--- dev/usb2/hcd/ehci/bulk.fth	2008-12-04 09:17:43 UTC (rev 1013)
+++ dev/usb2/hcd/ehci/bulk.fth	2008-12-04 09:17:50 UTC (rev 1014)
@@ -17,21 +17,27 @@
 0 instance value bulk-in-qh		\ For begin-bulk-in, bulk-in?,...
 0 instance value bulk-in-qtd		\ For begin-bulk-in, bulk-in?,...
 
+0 instance value bulk-out-qh		\ For begin-bulk-out-ring ...
+0 instance value bulk-out-qtd		\ For begin-bulk-out-ring ...
+
 : bulk-in-data@         ( -- n )  bulk-in-pipe  target di-in-data@   di-data>td-data  ;
 : bulk-out-data@        ( -- n )  bulk-out-pipe target di-out-data@  di-data>td-data  ;
 : bulk-in-data!         ( n -- )  td-data>di-data bulk-in-pipe  target di-in-data!   ;
 : bulk-out-data!        ( n -- )  td-data>di-data bulk-out-pipe target di-out-data!  ;
 : toggle-bulk-in-data   ( -- )    bulk-in-pipe  target di-in-data-toggle   ;
 : toggle-bulk-out-data  ( -- )    bulk-out-pipe target di-out-data-toggle  ;
-: fixup-bulk-in-data    ( qh -- data )
+
+: qtd-fixup-bulk-in-data  ( qtd -- data )
    usb-error USB_ERR_STALL and  if
       drop bulk-in-pipe h# 80 or unstall-pipe 
       TD_TOGGLE_DATA0
    else
-      >hcqh-overlay >hcqtd-token le-l@
+      >hcqtd-token le-l@
    then
    bulk-in-data!
 ;
+: fixup-bulk-in-data    ( qh -- data )  >hcqh-overlay qtd-fixup-bulk-in-data  ;
+
 : fixup-bulk-out-data   ( qh -- data )
    usb-error USB_ERR_STALL and  if
       drop bulk-out-pipe unstall-pipe
@@ -42,34 +48,34 @@
    bulk-out-data!
 ;
 
-: process-bulk-args  ( buf len pipe timeout -- )
-   to timeout
-   clear-usb-error
-   set-my-dev
-   set-my-char
+: set-bulk-vars  ( pipe -- )
+   clear-usb-error      ( pipe )
+   set-my-dev           ( pipe )
+   set-my-char          ( )
+;
+
+: process-bulk-args  ( buf len pipe -- )
+   set-bulk-vars	( buf len )
    2dup hcd-map-in  to my-buf-phys to /my-buf to my-buf
 ;
 
 : alloc-bulk-qhqtds  ( -- qh qtd )
-   my-buf-phys /my-buf cal-#qtd dup to my-#qtds
-   alloc-qhqtds
+   my-buf-phys /my-buf cal-#qtd dup to my-#qtds   ( #qtds )
+   alloc-qhqtds      ( qh qtd )
 ;
 
 : ?alloc-bulk-qhqtds  ( -- qh qtd )
-   my-buf-phys /my-buf cal-#qtd dup to my-#qtds
-   dup #bulk-qtd-max >  if  ." Requested bulk transfer is too big." cr abort  then
+   my-buf-phys /my-buf cal-#qtd dup to my-#qtds   ( #qtds )
+   dup #bulk-qtd-max >  if  ." Requested bulk transfer is too big." cr abort  then  ( #qtds )
 
-   bulk-qh 0=  if
-      #bulk-qtd-max alloc-qhqtds drop to bulk-qh
-   then
-   ( #qtd ) bulk-qh reuse-qhqtds
+   bulk-qh 0=  if                                 ( #qtds )
+      #bulk-qtd-max alloc-qhqtds drop to bulk-qh  ( )
+   then                                           ( #qtds )
+   bulk-qh reuse-qhqtds
 ;
 : free-bulk-qhqtds  ( -- )
-   bulk-qh ?dup  if
-      dup >qh-unaligned l@ swap		( qh.u,v )
-      dup >qh-phys l@			( qh.u,v,p )
-      #bulk-qtd-max /qtd * /qh +	( qh.u,v,p size )
-      aligned32-free-map-out		( )
+   bulk-qh ?dup  if                     ( qh )
+      free-qhqtds			( )
       0 to bulk-qh
    then
 ;
@@ -94,92 +100,351 @@
    loop  2drop					( )
 ;
 
-external
+: more-qtds?  ( qtd -- qtd flag )
+   dup >hcqtd-next le-l@		( qtd next )
+   over >hcqtd-next-alt le-l@  <>	( qtd more? )
+;
 
-: set-bulk-in-timeout  ( t -- )  ?dup  if  to bulk-in-timeout  then  ;
+: activate-in-ring  ( qtd -- )
+   \ Start with the second entry in the ring so the first entry
+   \ is the last to be activated, thus deferring host controller
+   \ activity until all qtds are active.
+   >qtd-next l@  dup				( qtd0 qtd )
+   begin					( qtd0 qtd )
+      TD_C_ERR3 TD_PID_IN or TD_STAT_ACTIVE or	( qtd0 qtd token )
+      over >hcqtd-token le-w!			( qtd0 qtd )
+      >qtd-next l@				( qtd0 qtd' )
+   2dup = until					( qtd0 qtd' )
+   2drop
+;
 
-: begin-bulk-in  ( buf len pipe -- )
-   debug?  if  ." begin-bulk-in" cr  then
-   bulk-in-qh  if  3drop exit  then		\ Already started
+: new-fill-bulk-io-qtds  ( /buf qtd -- )
+   swap to /my-buf					( qtd )
+   my-buf-phys /my-buf cal-#qtd to my-#qtds		( /buf qtd )
+   my-#qtds 0  do					( qtd )
+      >r						( r: qtd )
+      my-buf my-buf-phys /my-buf r@ fill-qtd-bptrs	( /bptr r: qtd )
+      dup r@ >hcqtd-token 2+ le-w!			( /bptr r: qtd )
+      my-buf++						( r: qtd )
+      r> >qtd-next l@					( qtd' )
+   loop  drop						( )
+;
 
-   dup to bulk-in-pipe                                ( buf len pipe )
-   bulk-in-timeout process-bulk-args                  ( )
-   alloc-bulk-qhqtds  to bulk-in-qtd  to bulk-in-qh
+\ Attach the qtd transaction chain beginning at "qtd" to "successor-qtd".
+: attach-qtds  ( successor-qtd qtd -- )
+   begin				( succ qtd )
+      \ Test before setting "next-alt"
+      more-qtds? >r			( succ qtd r: flag )
 
-   \ IN qTDs
-   TD_PID_IN bulk-in-qtd fill-bulk-io-qtds
+      \ Point each next-alt field to the successor
+      over >qtd-phys l@			( succ qtd succ-phys )
+      over >hcqtd-next-alt le-l!	( succ qtd r: flag )
+   r>  while  				( succ qtd )
+      >qtd-next l@			( succ qtd' )
+   repeat				( succ last-qtd )
 
+   \ Only the final qtd's next field points to the successor
+   over >qtd-phys l@  over  >hcqtd-next le-l!	( succ last-qtd )
+   >qtd-next l!				( )
+;
+
+: alloc-ring-qhqtds  ( buf-pa /buf #bufs -- qh qtd )
+   0 swap  0 ?do		( pa /buf #qtds )
+      >r 2dup cal-#qtd >r 	( pa /buf r: #qtds this-#qtds )
+      tuck + swap		( pa' /buf r: #qtds this-#qtds ) 
+      r> r> +			( pa' /buf #qtds' )
+   loop				( pa' /buf #qtds' )
+   nip nip  alloc-qhqtds	( qh qtd0 )
+;
+
+: unmap&free  ( va pa len -- )
+   >r			( va pa r: len )
+   over swap		( va va pa r: len )
+   r@ hcd-map-out	( va r: len )
+   r> dma-free		( )
+;
+: alloc&map  ( len -- va pa )
+   dup dma-alloc	( totlen va )
+   dup rot hcd-map-in  	( va pa )
+;
+
+\ It would be better to put these fields in the qh extension
+\ so we don't need separate ones for in and out.
+
+: free-ring  ( qh -- )
+   >r  r@ >qh-buf l@  r@ >qh-buf-pa l@
+   r@ >qh-#bufs l@  r> >qh-/buf l@ *
+   unmap&free
+;
+
+: set-bulk-in-timeout  ( ms -- )  ?dup  if  bulk-in-qh >qh-timeout l!  then  ;
+
+: alloc-ring-bufs  ( /buf #bufs qh -- )
+   >r
+   2dup  r@ >qh-#bufs l!  r@ >qh-/buf l!	( /buf #bufs )
+   * alloc&map  r@ >qh-buf-pa l!  r> >qh-buf l!	( )
+;
+: link-ring  ( qh qtd -- )
+   swap >r				( qtd r: qh )
+   r@ >qh-buf-pa l@ to my-buf-phys      ( qtd r: qh )
+   r@ >qh-buf    l@ to my-buf		( qtd r: qh )
+   r@ >qh-/buf   l@ swap		( /buf qtd r: qh )
+   r> >qh-#bufs  l@			( /buf qtd #bufs )
+
+   over >r				( /buf qtd #bufs r: qtd0 )
+
+   1-  0  ?do				( /buf qtd )
+      2dup new-fill-bulk-io-qtds	( /buf qtd )
+
+      dup  my-#qtds /qtd * +		( /buf qtd next-qtd )
+      dup rot attach-qtds		( /buf next-qtd )
+   loop					( /buf qtd r: qtd0 )
+
+   tuck new-fill-bulk-io-qtds		( qtd  r: qtd0 )
+   r> swap attach-qtds			( )
+;
+
+: make-ring  ( /buf #bufs -- qh qtd )
+   2dup * alloc&map				( /buf #bufs va pa )
+   dup  4 pick 4 pick  alloc-ring-qhqtds	( /buf #bufs va pa qh qtd )
+   >r >r					( /buf #bufs va pa r: qtd qh )
+   r@ >qh-buf-pa l!  r@ >qh-buf  l!		( /buf #bufs )
+   r@ >qh-#bufs  l!  r@ >qh-/buf l!		( r: qtd qh )
+
    \ Start bulk in transaction
-   bulk-in-qh pt-bulk fill-qh
-   bulk-in-qh insert-qh
+   r@ pt-bulk fill-qh				( r: qtd qh )
+
+   \ Let the QH keep track of the data toggle
+   r@ >hcqh-endp-char dup le-l@ QH_TD_TOGGLE invert and swap le-l!
+
+   r> r>					( qh qtd )
+   2dup link-ring				( qh qtd )
+   over insert-qh				( qh qtd )
 ;
 
-: bulk-in?  ( -- actual usberr )
-   bulk-in-qh 0=  if  0 USB_ERR_INV_OP exit  then
+\ Find the last qtd in a chain of qtds for the same transaction.
+: transaction-last-qtd  ( qtd -- qtd' )
+   begin  more-qtds?  while  >qtd-next l@  repeat	( qtd' )
+;
+
+: qtd-successor  ( qtd -- qtd' )  transaction-last-qtd >qtd-next l@  ;
+
+\ Insert the qtd transaction chain "new-qtd" in the circular list
+\ after "qtd".  This is safe only if qtd is inactive.
+: qtd-insert-after  ( new-qtd qtd -- )
+   \ First make qtd's successor new-qtd's successor
+   2dup qtd-successor swap attach-qtds	( new-qtd qtd )
+
+   \ Then make new-qtd qtd's successor
+   attach-qtds				( )
+;
+
+external
+
+0 value bulk-out-pending
+: activate-out  ( qtd len -- )
+   over to bulk-out-pending	( qtd len )
+   over >hcqtd-token		( qtd len token-adr )
+   tuck 2+ le-w!		( qtd token-adr )
+   TD_C_ERR3  TD_PID_OUT or  TD_STAT_PING or  TD_STAT_ACTIVE or   swap le-w!  ( qtd )
+   sync-qtd
+;
+
+: wait-out  ( qtd -- error? )
+   begin  dup qtd-done?  until	( qtd )
+   >hcqtd-token c@ h# fc and
+;
+
+\ Possible enhancement: pass in a size argument so that a chain of qtds can be
+\ allocated, with more total buffer space than can be represented by one qtd.
+\ That can get complicated though - if the chain wraps around the ring, the
+\ buffer space would be discontiguous.
+
+: get-out-buffer  ( -- qtd buf )
+   bulk-out-qtd begin  dup qtd-done?  until	( qtd )
+   dup >qtd-next l@ to bulk-out-qtd		( qtd )
+   dup >qtd-buf	l@				( qtd buf )
+;
+
+: send-out  ( adr len -- qtd )
+   >r  get-out-buffer				( adr qtd buf r: len )
+   rot swap r@ move				( qtd r: len )
+   dup r> activate-out
+;
+
+: begin-out-ring  ( /buf #bufs pipe -- )
+   debug?  if  ." begin-out-ring" cr  then
+   bulk-out-qh  if  3drop exit  then		\ Already started
+
+   dup to bulk-out-pipe				( /buf #bufs pipe )
+   set-bulk-vars				( /buf #bufs )
+
+   make-ring					( qh qtd )
+   to bulk-out-qtd  to bulk-out-qh		( )
+   bulk-out-timeout bulk-out-qh >qh-timeout l!	( )
+;
+
+: begin-in-ring  ( /buf #bufs pipe -- )
+   debug?  if  ." begin-bulk-in-ring" cr  then
+   bulk-in-qh  if  3drop exit  then		\ Already started
+
+   dup to bulk-in-pipe				( /buf #bufs pipe )
+   set-bulk-vars				( /buf #bufs )
+
+   make-ring					( qh qtd )
+   dup activate-in-ring				( qh qtd )
+   to bulk-in-qtd  to bulk-in-qh		( )
+   bulk-in-timeout bulk-in-qh >qh-timeout l!	( )
+;
+
+: bulk-in-ready?  ( -- false | error true |  buf actual 0 true )
    clear-usb-error
-   bulk-in-qh dup sync-qhqtds
-   qh-done?  if
-      bulk-in-qh error?  if
-         0
-      else
-         bulk-in-qtd dup bulk-in-qh >qh-#qtds l@ get-actual
-         over >qtd-buf rot >qtd-pbuf l@ 2 pick dma-sync
-      then
-      usb-error
-      bulk-in-qh fixup-bulk-in-data
+   bulk-in-qtd >r
+   r@ sync-qtd
+   r@ qtd-done?  if				( )
+      r@  bulk-in-qh qtd-error? ?dup  0=  if	( )
+         r@ >qtd-buf l@				( buf actual )
+         r@ qtd-get-actual			( buf actual )
+         2dup  r@ >qtd-pbuf l@  swap  dma-sync	( buf actual )
+         0					( buf actual 0 )
+      then					( error | buf actual 0 )
+      true					( ... )
+      \ Possibly unnecessary 
+      r@ qtd-fixup-bulk-in-data			( ... )
+
 \ XXX Ethernet does not like process-hc-status!
 \      process-hc-status
-   else
-      0 usb-error
-   then
+   else						( )
+      false				        ( false )
+   then						( ... )
+   r> drop
 ;
 
 headers
+: recycle-one-qtd  ( qtd -- )
+   \ Clear "Current Offset" field in first buffer pointer
+   dup >qtd-pbuf l@  over >hcqtd-bptr0 le-l!  ( qtd )
+
+   \ Reset the "token" word which contains various transfer control bits
+   dup >qtd-/buf l@ d# 16 <<                       ( qtd token_word )
+   TD_STAT_ACTIVE or TD_C_ERR3 or TD_PID_IN or     ( qtd token_word' )
+
+   \ Not doing data toggles here!
+
+   swap >hcqtd-token le-l!
+;
+: recycle-bulk-in-qtd  ( qtd -- )
+   dup
+   begin  more-qtds?  while	( qtd0 qtd )
+      >qtd-next l@		( qtd0 qtd' )
+      dup recycle-one-qtd	( qtd0 qtd )
+   repeat			( qtd0 qtd )
+
+   \ Recycle the first qtd last so the transaction is atomic WRT the HC
+   drop dup recycle-one-qtd	( qtd0 )
+   sync-qtds
+;
+
 \ Fixup the host-controller-writable fields in the chain of qTDs -
 \ current offset, bytes_to_transfer, and status
 : restart-bulk-in-qtd  ( qtd -- )
-   begin  ?dup  while        ( qtd )
+   begin					   ( qtd )
       \ Clear "Current Offset" field in first buffer pointer
       dup >hcqtd-bptr0 dup le-l@ h# ffff.f000 and swap le-l!  ( qtd )
 
       \ Reset the "token" word which contains various transfer control bits
       dup >qtd-/buf l@ d# 16 <<                    ( qtd token_word )
       TD_STAT_ACTIVE or TD_C_ERR3 or TD_PID_IN or  ( qtd token_word' )
+
+      \ Maybe unnecessary based on using dt in QH
       bulk-in-data@ or  toggle-bulk-in-data        ( qtd token_word' )
+
       over >hcqtd-token le-l!                      ( qtd )
-
+   more-qtds?   while				   ( qtd )
       >qtd-next l@                                 ( qtd' )
-   repeat
+   repeat					   ( qtd )
+   drop
 ;
 
 external
-: restart-bulk-in  ( -- )
-   debug?  if  ." restart-bulk-in" cr  then
-   bulk-in-qh 0=  if  exit  then
+\ Wait for the hardware next pointer to catch up with the software pointer.
+: drain-bulk-out  ( -- )
+   debug?  if  ." drain-bulk-out" cr  then
+   bulk-out-qtd >qtd-phys l@	( qtd-pa )
+   bulk-out-qh >hcqh-overlay >hcqtd-next	( qtd-pa 'qh-next )
+   begin  2dup le-l@ =  until   ( qtd-pa 'qh-next )
+   2drop
+;
 
-   \ Setup qTD again
-   bulk-in-qtd restart-bulk-in-qtd
+: end-out-ring  ( -- )
+   debug?  if  ." end-out-ring" cr  then
+   bulk-out-qh 0=  if  exit  then
+   drain-bulk-out
 
-   \ Setup QH again
-   bulk-in-qh >hcqh-endp-char dup le-l@ QH_TD_TOGGLE invert and swap le-l!
-   bulk-in-qtd >qtd-phys l@ bulk-in-qh >hcqh-overlay >hcqtd-next le-l!
-   bulk-in-qh sync-qhqtds
+   bulk-out-qh remove-qh
+   bulk-out-qh free-ring
+   bulk-out-qh free-qh
+   
+   0 to bulk-out-qh  0 to bulk-out-qtd
 ;
 
 : end-bulk-in  ( -- )
    debug?  if  ." end-bulk-in" cr  then
    bulk-in-qh 0=  if  exit  then
-   bulk-in-qtd map-out-bptrs
-   bulk-in-qh dup fixup-bulk-in-data
-   dup remove-qh  free-qhqtds
+
+   bulk-in-qh remove-qh
+   bulk-in-qh fixup-bulk-in-data
+   bulk-in-qh free-ring
+   bulk-in-qh free-qh
+   
    0 to bulk-in-qh  0 to bulk-in-qtd
 ;
 
+0 instance value app-buf
+
+: begin-bulk-in  ( buf len pipe -- )
+   rot to app-buf
+   h# 20 swap begin-in-ring
+;
+
+: bulk-in?  ( -- actual usberr )
+   bulk-in-ready?  if		( usberr | buf actual 0 )
+      ?dup  if			( usberr )
+         0 swap			( actual usberr )
+      else			( buf actual )
+         tuck			( actual buf actual )
+         app-buf swap move	( actual )
+         0			( actual usberr )
+      then                      ( actual usberr )
+   else				( )
+      0 0			( actual usberr )
+   then
+;
+
+: restart-bulk-in  ( -- )
+   debug?  if  ." recycle buffer" cr  then
+   bulk-in-qh 0=  if  exit  then
+
+   \ Setup qTD again
+   bulk-in-qtd recycle-bulk-in-qtd
+
+   bulk-in-qtd qtd-successor to bulk-in-qtd
+;
+
+: bulk-read?  ( -- [ buf ] actual )
+   bulk-in?  if  restart-bulk-in  -1 exit  then    ( actual )
+   dup 0=  if  drop -2 exit  then                  ( actual )
+   bulk-in-qtd >qtd-buf l@ swap                    ( buf actual )
+;
+
+: recycle-buffer restart-bulk-in ;
+
 : bulk-in  ( buf len pipe -- actual usberr )
    debug?  if  ." bulk-in" cr  then
    dup to bulk-in-pipe
-   bulk-in-timeout process-bulk-args
+   process-bulk-args
    ?alloc-bulk-qhqtds  to my-qtd  to  my-qh
+   bulk-in-timeout my-qh >qh-timeout l!
 
    \ IN qTDs
    TD_PID_IN my-qtd fill-bulk-io-qtds
@@ -206,28 +471,41 @@
    remove-qh
 ;
 
-: bulk-out  ( buf len pipe  -- usberr )
+0 instance value bulk-out-busy?
+: done-bulk-out  ( -- error? )
+   \ Process results
+   my-qh done? 0=  if  my-qh error? drop  then
+
+   usb-error				( usberr )
+   my-qtd map-out-bptrs			( usberr )
+   my-qh fixup-bulk-out-data		( usberr )
+   my-qh remove-qh			( usberr )
+   false to bulk-out-busy?		( usberr )
+;
+: start-bulk-out  ( buf len pipe -- usberr )
+   bulk-out-busy?  if			( buf len pipe )
+      done-bulk-out  ?dup  if   nip nip nip exit  then
+   then					( buf len pipe )
+
    debug?  if  ." bulk-out" cr  then
-   dup to bulk-out-pipe
-   bulk-out-timeout process-bulk-args
-   ?alloc-bulk-qhqtds  to my-qtd  to my-qh
+   dup to bulk-out-pipe			( buf len pipe )
+   process-bulk-args			( )
+   ?alloc-bulk-qhqtds  to my-qtd  to my-qh	( )
+   bulk-out-timeout my-qh >qh-timeout l!	( )
    my-qh >hcqh-overlay >hcqtd-token dup le-l@ TD_STAT_PING or swap le-l!
 
    \ OUT qTDs
-   TD_PID_OUT my-qtd fill-bulk-io-qtds
+   TD_PID_OUT my-qtd fill-bulk-io-qtds	( )
 
    \ Start bulk out transaction
-   my-qh pt-bulk fill-qh
-   my-qh insert-qh
-
-   \ Process results
-   my-qh done? 0=  if  my-qh error? drop  then
-
-   usb-error					( actual usberr )
-   my-qtd map-out-bptrs
-   my-qh dup fixup-bulk-out-data
-   remove-qh
+   my-qh pt-bulk fill-qh		( )
+   my-qh insert-qh			( )
+   true to bulk-out-busy?		( )
+   0					( usberr )
 ;
+: bulk-out  ( buf len pipe -- usberr )
+   start-bulk-out drop done-bulk-out
+;
 
 headers
 

Modified: dev/usb2/hcd/ehci/control.fth
===================================================================
--- dev/usb2/hcd/ehci/control.fth	2008-12-04 09:17:43 UTC (rev 1013)
+++ dev/usb2/hcd/ehci/control.fth	2008-12-04 09:17:50 UTC (rev 1014)
@@ -24,6 +24,7 @@
 0 value my-buf					\ Virtual address of data buffer
 0 value my-buf-phys				\ Physical address of data buffer
 0 value /my-buf					\ Size of data buffer
+0 value my-dir					\ Direction (in or out)
 
 0 value my-qtd					\ Current TD head
 0 value my-qh					\ Current QH
@@ -49,10 +50,11 @@
 ;
 
 : alloc-control-qhqtds  ( extra-qtds -- )
-   >r
-   my-buf-phys /my-buf cal-#qtd dup to my-#qtds
-   dup  if  data-timeout  else  nodata-timeout  then  to timeout
-   r> + alloc-qhqtds  to my-qtd  to my-qh
+   >r						( r: extra-qtds )
+   my-buf-phys /my-buf cal-#qtd dup to my-#qtds	( #data-qtds r: extra-qtds )
+   dup r> + alloc-qhqtds  to my-qtd  to my-qh	( #data-qtds )
+   if  data-timeout  else  nodata-timeout  then	( timeout )
+   my-qh >qh-timeout l!				( )
 ;
 
 : fill-qh  ( qh pipetype -- )
@@ -85,10 +87,11 @@
    fill-qtd-bptrs  drop
 ;
 
-: my-buf++ ( len -- )
-   /my-buf     over - to /my-buf
-   my-buf-phys over + to my-buf-phys
-   my-buf      swap + to my-buf
+: my-buf++  ( len -- )
+   /my-buf min				( len' )
+   /my-buf     over - to /my-buf	( len )
+   my-buf-phys over + to my-buf-phys	( len )
+   my-buf      swap + to my-buf		( )
 ;
 : fixup-last-qtd  ( td -- )
    /my-buf  if  drop exit  then

Modified: dev/usb2/hcd/ehci/ehci.fth
===================================================================
--- dev/usb2/hcd/ehci/ehci.fth	2008-12-04 09:17:43 UTC (rev 1013)
+++ dev/usb2/hcd/ehci/ehci.fth	2008-12-04 09:17:50 UTC (rev 1014)
@@ -75,14 +75,18 @@
 : halted?    ( -- flag )  usbsts@ h# 1000 and  ;
 : halt-wait  ( -- )       begin  halted?  until  ;
 
-: process-hc-status  ( -- )  
+: process-hc-status  ( -- )
    usbsts@ dup usbsts!		\ Clear interrupts and errors
    h# 10  and  if  " Host system error" USB_ERR_HCHALTED set-usb-error  then
 ;
+: get-hc-status  ( -- status )
+   usbsts@ dup usbsts!		\ Clear interrupts and errors
+   dup h# 10  and  if  " Host system error" USB_ERR_HCHALTED set-usb-error  then
+;
 
 : doorbell-wait  ( -- )
-   \ Wait until interupt on async advance bit is set.
-   \ But, some HC fails to set the async advance bit sometimes.  Therefore,
+   \ Wait until interrupt on async advance bit is set.
+   \ But, some HCs fail to set the async advance bit sometimes.  Therefore,
    \ we add a timeout and clear the status all the same.
    h# 100 0  do  usbsts@ h# 20 and  if  leave  then  loop
    h# 20 usbsts!			\ Clear status

Modified: dev/usb2/hcd/ehci/qhtd.fth
===================================================================
--- dev/usb2/hcd/ehci/qhtd.fth	2008-12-04 09:17:43 UTC (rev 1013)
+++ dev/usb2/hcd/ehci/qhtd.fth	2008-12-04 09:17:50 UTC (rev 1014)
@@ -105,6 +105,8 @@
    4 field >qtd-/buf-all		\ Buffer length (size of the entire buffer)
 					\ Only the first qTD has the entire size of buffer
 					\ For bulk and intr qTDs
+   4 field >qtd-unaligned		\ Unaligned buffer address
+   4 field >qtd-size		        \ Unaligned buffer size
 d# 32 round-up
 constant /qtd
 
@@ -154,6 +156,11 @@
    4 field >qh-unaligned		\ QH's unaligned address
    4 field >qh-size			\ Size of QH+qTDs 
    4 field >qh-#qtds			\ # of qTDs in the list
+   4 field >qh-#bufs			\ # of bufs
+   4 field >qh-/buf			\ size of each buf
+   4 field >qh-buf			\ buf start va
+   4 field >qh-buf-pa			\ buf start pa
+   4 field >qh-timeout			\ Timeout
 d# 32 round-up
 constant /qh
 
@@ -180,34 +187,50 @@
 
 : sync-qh      ( qh  -- )  dup >qh-phys  l@ /hcqh  dma-sync  ;
 : sync-qtd     ( qtd -- )  dup >qtd-phys l@ /hcqtd dma-sync  ;
-: sync-qhqtds  ( qh  -- )  dup >qh-phys  l@ over >qh-size l@  dma-sync  ;
+: sync-qtds    ( qtd -- )  dup >qtd-phys l@ over >qtd-size l@  dma-sync  ;
+: sync-qhqtds  ( qh  -- )  dup >qh-phys  l@ over >qh-size  l@  dma-sync  ;
 
 : map-out-bptrs  ( qtd -- )
    dup >qtd-buf l@ over >qtd-pbuf l@ rot >qtd-/buf-all l@ hcd-map-out
 ;
 
-: init-qh  ( qh.u,v,p len #qtds -- )
-   3 pick >qh-#qtds l!			( qh.u,v,p len )
-   2 pick >qh-size l!			( qh.u,v,p )
-   over >qh-phys l!			( qh.u,v )
-   TERMINATE 2 pick >hcqh-next le-l!	( qh.u,v )
-   >qh-unaligned l!			( )
-;
 : link-qtds  ( qtd.v qtd.p #qtds -- )
-   1- 0  ?do				( qtd.v qtd.p )
-      TERMINATE 2 pick >hcqtd-next-alt le-l!	( qtd.v qtd.p )
-      2dup swap >qtd-phys l!		( qtd.v qtd.p )
-      /qtd +				( qtd.v qtd.p' )
-      2dup swap >hcqtd-next le-l!	( qtd.v qtd.p )
-      swap dup /qtd + tuck swap >qtd-next l!	( qtd.p qtd.v' )
-      swap				( qtd.v qtd.p )
+   1- 0  ?do					( v p )
+      TERMINATE 2 pick >hcqtd-next-alt le-l!	( v p )
+      2dup swap >qtd-phys l!			( v p )
+      /qtd +					( v p' )
+      2dup swap >hcqtd-next le-l!		( v p )
+      swap dup /qtd + tuck swap >qtd-next l!	( p v' )
+      swap					( v p )
    loop
 
    \ Fix up the last qTD
-   over >qtd-phys l!			( qtd.v )
-   TERMINATE over >hcqtd-next le-l!	( qtd.v )
-   TERMINATE swap >hcqtd-next-alt le-l!	( )
+   over >qtd-phys l!				( v )
+   TERMINATE over >hcqtd-next le-l!		( v )
+   TERMINATE swap >hcqtd-next-alt le-l!		( )
 ;
+
+: alloc-qtds  ( #qtds -- qtd )
+   dup >r  /qtd * dup >r		( len )  ( R: #qtds len )
+   aligned32-alloc-map-in		( u v p )  ( R: #qtds len )
+   swap					( u p v )  ( R: #qtds len )
+   dup r@ erase				( u p v )  ( R: #qtds len )
+
+   \ Record QTD size for later freeing
+   rot over >qtd-unaligned l!		( p v )  ( R: #qtds len )
+   r> over >qtd-size l!			( p v )  ( R: #qtds )
+
+   dup rot r> link-qtds			( qtd.v )
+;
+
+: free-qtds  ( qtd -- )
+   >r					( R: qtd )
+   r@ >qtd-unaligned l@			( u )  ( R: qtd )
+   r@ dup >qtd-phys l@			( u v p )  ( R: qtd )
+   r> >qtd-size l@			( u v p size )
+   aligned32-free-map-out		( )
+;
+
 : link-qhqtd  ( qtd.p qh -- )
    >hcqh-overlay tuck			( qh.overlay qtd.p qh.overlay )
    >hcqtd-next le-l!			( qh.overlay )
@@ -223,6 +246,30 @@
    link-qtds				( )			\ Link qTDs
 ;
 
+: init-qh  ( qh.u,v,p len #qtds -- )
+   3 pick >qh-#qtds l!			( qh.u,v,p len )
+   2 pick >qh-size l!			( qh.u,v,p )
+   over >qh-phys l!			( qh.u,v )
+   TERMINATE 2 pick >hcqh-next le-l!	( qh.u,v )
+   >qh-unaligned l!			( )
+;
+
+: alloc-qh  ( -- qh )
+   /qh aligned32-alloc-map-in		( u v p )
+   over /qh erase			( u v p )
+   over >r				( u v p r: v )
+   /qh 0 init-qh			( r: v )
+   TERMINATE r@ link-qhqtd		( r: v )
+   r>					( qh.v )
+;
+: free-qh  ( qh -- )
+   >r					( R: qh )
+   r@ >qh-unaligned l@			( qh.u )  ( R: qh )
+   r@ dup >qh-phys l@			( qh.u,v,p )  ( R: qh )
+   r> >qh-size l@			( qh.u,v,p size )
+   aligned32-free-map-out		( )
+;
+
 : alloc-qhqtds  ( #qtds -- qh qtd )
    dup >r  /qtd * /qh + dup >r		( len )  ( R: #qtds len )
    aligned32-alloc-map-in		( qh.u,v,p )  ( R: #qtds len )
@@ -234,13 +281,17 @@
    r> 4 pick link-qhqtds		( qh qtd )
 ;
 
-: free-qhqtds  ( qh -- )
+: free-qh  ( qh -- )
    >r					( R: qh )
    r@ >qh-unaligned l@			( qh.u )  ( R: qh )
    r@ dup >qh-phys l@			( qh.u,v,p )  ( R: qh )
    r> >qh-size l@			( qh.u,v,p size )
    aligned32-free-map-out		( )
 ;
+
+\ Same as free-qh because the size field tells all
+: free-qhqtds  ( qh -- )  free-qh  ;
+
 : reuse-qhqtds  ( #qtds qh -- qh qtd )
    swap dup >r  /qtd * /qh + >r		( qh )  ( R: #qtds len )
    dup >qh-unaligned l@ swap		( qh.u,v )  ( R: #qtds len )
@@ -332,6 +383,7 @@
       qh-ptr >hcqh-next le-l@ r@ >hcqh-next le-l!
       r@ qh-ptr >qh-next l!
       r@ >qh-phys l@ qh-ptr >hcqh-next le-l!
+
       r> sync-qhqtds
       qh-ptr sync-qh
    else
@@ -345,7 +397,26 @@
       enable-async
    then
 ;
+: fix-wraparound-qh  ( qh -- )
+   \ Find the end of the list, the node that points back to the beginning
+   dup >r                ( thisqh r: qh0 )
+   begin                 ( thisqh r: qh0 )
+      dup >qh-next l@    ( thisqh nextqh r: qh0 )
+   dup r@ <>  while      ( thisqh nextqh r: qh0 )
+      nip                ( thisqh' r: qh0 )
+   repeat                ( thisqh nextqh r: qh0 )
 
+   drop
+   \ Change that node's next pointers to skip the removed qh
+   r> >qh-next l@        ( lastqh nextqh )
+   swap                  ( nextqh lastqh )
+   over >qh-phys l@      ( nextqh lastqh next-phys )
+   over >hcqh-next le-l@ ( nextqh lastqh next-phys last-phys )
+   TYP_QH and or         ( nextqh lastqh next-phys' )
+   over >hcqh-next le-l! ( nextqh lastqh next-phys' )
+   >qh-next l!           ( )
+;
+
 : remove-qh  ( qh -- )
    dup >qh-next l@ over =  if
       \ If qh is the only qh in the system, disable-async and exit
@@ -364,10 +435,11 @@
          else
             drop
          then
-      else
-         >qh-next l@ to qh-ptr
-         qh-ptr >hcqh-endp-char dup le-l@ QH_HEAD or swap le-l!
-         0 qh-ptr >qh-prev l!
+      else                          ( qh )
+         dup >qh-next l@ to qh-ptr  ( qh )
+         qh-ptr >hcqh-endp-char dup le-l@ QH_HEAD or swap le-l!  ( qh )
+         fix-wraparound-qh          ( )
+         0 qh-ptr >qh-prev l!       ( )
 	 qh-ptr sync-qh
       then
       ring-doorbell
@@ -450,8 +522,6 @@
 \ were found in the TDs.
 \ ---------------------------------------------------------------------------
 
-0 value timeout
-
 : .qtd-error  ( cc -- )
    dup TD_STAT_HALTED  and  if  " Stalled; "                USB_ERR_STALL       set-usb-error  then
    dup TD_STAT_DBUFF   and  if  " Data Buffer Error; "      USB_ERR_DBUFERR     set-usb-error  then
@@ -461,22 +531,25 @@
    TD_STAT_SPLIT_ERR   and  if  " Periodic split-x error; " USB_ERR_SPLIT       set-usb-error  then
 ;
 
-: qh-done?  ( qh -- done? )
-   >hcqh-overlay			( olay )
-   dup >hcqtd-next le-l@ 		( olay pnext )
-   swap >hcqtd-token le-l@ 		( pnext token )
-   dup TD_STAT_HALTED and -rot		( halted? pnext token )
-   TD_STAT_ACTIVE and 0= swap		( halted? inactive? pnext )
-   TERMINATE = and			( halted? done? )
+: qtd-done?  ( qtd -- done? )
+   >hcqtd-token le-l@			( token )
+   dup TD_STAT_HALTED and		( token halted? )
+   swap TD_STAT_ACTIVE and 0=		( halted? inactive? )
    or					( done?' )
 ;
+
+: qh-done?  ( qh -- done? )  >hcqh-overlay qtd-done?  ;
+
 : done?  ( qh -- usberr )
    begin
-      process-hc-status
-      ( qh ) dup sync-qh
-      ( qh ) dup qh-done? ?dup 0=  if
+      process-hc-status		( qh )
+      dup sync-qh		( qh )
+      dup qh-done? ?dup 0=  if  ( qh )
          1 ms
-         timeout 1- dup to timeout 0=
+         dup >qh-timeout	( qh timeout-adr )
+         dup l@ 1-		( qh timeout-adr timeout' )
+         dup rot l!		( qh timeout' )
+         0=
       then
    until
 
@@ -484,13 +557,15 @@
    usb-error
 ;
 
-: error?  ( qh -- usberr )
-   dup >hcqh-endp-char le-l@ d# 12 >> 3 and
-   speed-high =  if  h# fc  else  h# fd  then
-   swap >hcqh-overlay >hcqtd-token le-l@  and ?dup  if  .qtd-error  then
+: qtd-error?  ( qtd qh -- usberr )
+   >hcqh-endp-char le-l@ d# 12 >> 3 and         ( qtd speed )
+   speed-high =  if  h# fc  else  h# fd  then   ( qtd error-mask )
+   swap >hcqtd-token le-l@  and ?dup  if  .qtd-error  then
    usb-error
 ;
 
+: error?  ( qh -- usberr )  dup >hcqh-overlay  swap  qtd-error?   ;
+
 : get-actual  ( qtd #qtd -- actual )
    0 -rot 0  ?do			( actual qtd )
       dup sync-qtd			( actual qtd )
@@ -505,6 +580,25 @@
    loop  drop				( qtd )
 ;
 
+: qtd-get-actual  ( qtd -- actual )
+   0 swap  begin			( actual qtd )
+      dup sync-qtd			( actual qtd )
+      dup >hcqtd-token le-l@ dup TD_STAT_ACTIVE and 0=  if
+         over >qtd-/buf l@		( actual qtd token len )
+         swap d# 16 >> h# 7fff and -	( actual qtd len' )
+         rot + swap			( actual' qtd )
+      else
+         drop				( actual qtd )
+      then
+      dup >hcqtd-next l@		( actual qtd next )
+      over >hcqtd-next-alt l@		( actual qtd next alt-next )
+   <> while
+      \ If next and alt differ, the next one is part of the same transaction.
+      \ If they are the same, it's a different transaction
+      >qtd-next l@			( actual qtd' )
+   repeat  drop				( actual )
+;
+
 \ ---------------------------------------------------------------------------
 \ Allocate a dummy qh to be head of the queue to get around the fact that
 \ the VIA 2.0 controller does not stop async when told to.

Modified: dev/usb2/hcd/hcd-call.fth
===================================================================
--- dev/usb2/hcd/hcd-call.fth	2008-12-04 09:17:43 UTC (rev 1013)
+++ dev/usb2/hcd/hcd-call.fth	2008-12-04 09:17:50 UTC (rev 1014)
@@ -66,7 +66,11 @@
 : set-bulk-in-timeout  ( t -- )
    " set-bulk-in-timeout" $call-parent
 ;
+: bulk-in-ready?  ( -- false | error true | buf len 0 true )
+   " bulk-in-ready?" $call-parent
+;
 
+
 \ Interrupt pipe operations
 : begin-intr-in  ( buf len pipe interval -- )
    " begin-intr-in" $call-parent

Modified: dev/usb2/hcd/ohci/bulk.fth
===================================================================
--- dev/usb2/hcd/ohci/bulk.fth	2008-12-04 09:17:43 UTC (rev 1013)
+++ dev/usb2/hcd/ohci/bulk.fth	2008-12-04 09:17:50 UTC (rev 1014)
@@ -105,6 +105,23 @@
    bulk-in-ed insert-my-bulk-in
 ;
 
+: bulk-in-ready?  ( -- false | error true |  buf actual 0 true )
+   clear-usb-error				( )
+   process-hc-status				( )
+   bulk-in-ed dup sync-edtds			( ed )
+   ed-done?  if					( )
+      bulk-in-td error? ?dup 0=  if		( )
+         bulk-in-td >td-cbp l@			( buf )
+         bulk-in-td get-actual			( buf actual )
+         2dup bulk-in-td >td-pcbp l@ swap dma-sync	( buf actual )
+         0					( buf actual 0 )
+      then					( error | buf actual 0 )
+      bulk-in-ed fixup-bulk-in-data		( error | buf actual 0 )
+   else
+      false                                     ( false )
+   then
+;
+
 : bulk-in?  ( -- actual usberr )
    bulk-in-ed 0=  if  0 USB_ERR_INV_OP exit  then
    clear-usb-error				( )




More information about the openfirmware mailing list