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