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@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 ( )
