blob: 3a6fbbe3d3f6f7804c9d7c888232e735f6d6ad70 [file] [log] [blame]
\ USB Diagnostic Firmware Update (DFU)
$80 constant USB_ENDPOINT_IN
$00 constant USB_ENDPOINT_OUT
1 5 << constant USB_REQUEST_TYPE_CLASS
1 constant USB_RECIPIENT_INTERFACE
#100 value dfu-timeout
0 value dfu-handle
0 value dfu-dev
6 buffer: dfu-status
0 constant DFU_DETACH
1 constant DFU_DNLOAD
2 constant DFU_UPLOAD
3 constant DFU_GETSTATUS
4 constant DFU_CLRSTATUS
5 constant DFU_GETSTATE
6 constant DFU_ABORT
: dfu-control ( len data index value req in/out -- res )
2>r 2>r 2>r dfu-timeout 2r> 2r> 2r>
USB_REQUEST_TYPE_CLASS or USB_RECIPIENT_INTERFACE or
dfu-handle libusb_control_transfer
l->n
;
: dfu-in ( len data index value req -- res ) USB_ENDPOINT_IN dfu-control ;
: dfu-out ( len data index value req -- res ) USB_ENDPOINT_OUT dfu-control ;
: dfu-clear-status ( -- )
0 0 0 0 DFU_CLRSTATUS dfu-out 0< abort" Clear status failed"
;
false value verbose-status?
: (dfu-get-status) ( -- state )
begin
6 dfu-status 0 0 DFU_GETSTATUS dfu-in ( #bytes )
dup 6 = if ( #bytes )
verbose-status? if dfu-status 6 cdump cr then
drop dfu-status 4 + c@ exit ( -- state )
then ( #bytes )
dup 0<> if ( #bytes )
." dfu-get-status failed - #bytes = " .x cr
abort
then ( #bytes )
drop ( )
\ Retry 0-byte returns
again
;
: 3b@ ( adr -- n ) >r r@ c@ r@ 1+ c@ r> 2+ c@ 0 bljoin ;
0 value next-status-ms
: wait-status ( -- )
next-status-ms if
next-status-ms get-msecs - ( wait )
0 max ?dup if ." wait" cr ms then
then
;
: set-next-status-time ( -- )
dfu-status 1+ 3b@ dup if
verbose-status? if ." Time " dup .d cr then
get-msecs +
then
to next-status-ms
;
2 constant DFU_IDLE_STATE
4 constant DOWNLOAD_BUSY_STATE
5 constant DOWNLOAD_IDLE_STATE
7 constant DFU_MANIFEST_STATE
#10 constant DFU_ERROR_STATE
: dfu-get-status ( -- state )
(dfu-get-status) ( state )
dup DFU_ERROR_STATE = if ( state )
drop ( )
\ dfu-status c@ #10 <> if ( )
\ \ #10 means that the main (non-DFU) firmware is corrupt -
\ \ which is a common situation when initially programming it
\ ." DFU get status error - status " dfu-status c@ .x cr
\ then ( )
#100 ms dfu-clear-status #100 ms
(dfu-get-status) ( state )
then ( state )
set-next-status-time ( state )
;
: .status ( -- ) dfu-get-status dfu-status drop 6 cdump cr ;
\ This gets back to idle from states like upload and download
: dfu-abort-to-idle ( -- )
0 0 0 0 DFU_ABORT dfu-out 0< abort" Abort command error"
dfu-get-status DFU_IDLE_STATE <> abort" Did not enter IDLE state"
;
: claim+alt+status ( -- state )
0 dfu-handle libusb_claim_interface abort" Error claiming interface"
0 0 dfu-handle libusb_set_interface_alt abort" Error setting alt"
dfu-get-status
;
: release ( -- )
0 dfu-handle libusb_release_interface abort" Error releasing interface"
;
: /ep0 ( -- n ) dev-desc >dev-/ep0 c@ ;
: #configurations ( -- n ) dev-desc >#configurations c@ ;
0 value cfg-desc
0 value ifce-desc
$40 buffer: ifce-string
0 value /ifce-string
0 value dfu-flash-base
0 value regions
0 value #regions
: dec# ( adr len -- ) push-decimal $number pop-base abort" NumberR" ;
: region-type&size ( adr len -- type size ) \ e.g. 064Kg
" KM" lex 0= abort" LexS" ( rem$ head$ char )
>r dec# #1024 * r> ( rem$ n char )
'M' = if #1024 * then ( rem$ size )
>r drop c@ r> ( type size )
;
: set-regions ( adr len -- )
" *" lex 0= abort" LexR" drop ( rem$ head$ )
dec# dup #regions + to #regions ( rem$ nregions )
-rot region-type&size ( nregions type size )
rot 0 ?do dup l, over l, loop ( type size )
2drop
;
: parse-mem-layout ( adr len -- )
regions if 2drop exit then ( adr len )
" /" lex 0= abort" Lex1" drop 2drop ( rem$ )
" /" lex 0= abort" Lex2" drop ( rem$ head$ )
2 /string ( rem$' ) \ Drop 0x
push-hex $number pop-base abort" Number" to dfu-flash-base ( rem$ )
here to regions 0 to #regions ( rem$ )
begin " ," lex while ( rem$ head$ char )
drop set-regions ( rem$ )
repeat ( rem$ )
set-regions ( )
;
0 value dfu-desc
: dfu-version ( -- n )
dfu-desc if
dfu-desc c@ 7 = if
$0100
else
dfu-desc 7 + w@
then
else
0
then
;
: transfer-size ( -- n )
dfu-desc if
dfu-desc 5 + w@
else
0
then
;
$21 constant DT_DFU
: search-dfu-descriptor ( extra$ -- )
begin dup 2 >= while ( extra$ )
over c@ >r ( extra$ r: thislen )
r@ 0= if ( extra$ r: thislen )
r> 3drop false exit ( -- false )
then ( extra$ r: thislen )
over 1+ c@ DT_DFU = if ( extra$ r: thislen )
r> 2drop to dfu-desc ( )
exit ( )
then ( extra$ r: thislen )
r> /string ( extra$' )
repeat ( extra$ )
2drop ( )
;
0 value alt-array
0 value #alts
: set-alts ( index -- )
cfg-desc >'interfaces swap na+ @ dup if ( adr )
dup >'alt-interfaces @ to alt-array ( adr )
>#alt-interfaces @ to #alts ( )
else ( adr )
drop 0 to #alts exit ( -- )
then ( )
;
: set-ifce ( index -- )
alt-array swap /interface-descriptor * + to ifce-desc
;
: check-dfu-in-cfg ( -- )
cfg-desc >config-'extra @ ?dup if
cfg-desc >config-#extra int@ search-dfu-descriptor
then
;
: check-dfu-in-alt ( -- )
dfu-desc if exit then
ifce-desc >class c@ $fe = ifce-desc >subclass c@ $01 = and if
ifce-desc >interface-'extra @ ?dup if
ifce-desc >interface-#extra int@ search-dfu-descriptor
then
then
;
$40 buffer: desc-str-buf
: get-string ( index -- $ )
?dup if
$40 desc-str-buf rot dfu-handle libusb_get_string_descr_ascii ( len )
dup 0< if
." get-string failed" cr
drop 0
then
desc-str-buf swap
else
" "
then
;
false value verbose-scan?
: scan-interfaces ( -- )
\ Loop over interfaces
cfg-desc >#interfaces c@ 0 ?do
i set-alts
verbose-scan? if ." Interface " i . cr then
\ Loop over alternate settings
#alts 0 ?do
i set-ifce
\ Get the string for this alternate setting
ifce-desc >interface-sindex c@ dup if ( sindex )
$40 ifce-string rot dfu-handle ( len adr sindex handle )
libusb_get_string_descr_ascii ( strlen )
then ( strlen )
to /ifce-string ( )
\ If this is a DFU device (protocol 2), check the extra field
\ for a DFU tag containing the transfer size, and also parse
\ the memory layout from the string. Once those items have been
\ found, subsequent calls to the parsers will exit immediately.
ifce-desc >protocol c@ 2 = if
check-dfu-in-alt
ifce-string /ifce-string parse-mem-layout
then
verbose-scan? if
." protocol " ifce-desc >protocol c@ .d
ifce-string /ifce-string type cr
then
loop
verbose-scan? if cr then
loop
;
: dfu-setup ( vid pid -- )
init-libusb
\ Open the device (currently hardwired to the STM DFU ID)
swap 0 libusb_open_device_with_vid_pid to dfu-handle
dfu-handle 0= abort" Cannot open device in DFU mode. Hold the Y key while plugging it in."
\ Get the device descriptor
dfu-handle libusb_get_device to dfu-dev
dev-desc dfu-dev libusb_get_device_descriptor abort" Can't get dev descriptor"
\ Display the device name and serial number
dev-desc >manufacturer-sindex c@ get-string type ." "
dev-desc >product-sindex c@ get-string type ." "
dev-desc >sn-sindex c@ get-string type cr
0 sp@ 0 dfu-dev libusb_get_config_descriptor abort" Can't get config descriptor"
( cfg-descr ) to cfg-desc
\ Get the configuration descriptor and grovel through its interfaces
\ and alternate settings looking for information that we need, including
\ the transfer size and the region map
cfg-desc >'interfaces @ ( adr )
dup >'alt-interfaces @ to alt-array ( adr )
>#alt-interfaces int@ to #alts ( )
scan-interfaces
transfer-size 0= abort" Did not find transfer size"
regions 0= abort" Did not find the FLASH region map"
\ Put the device into IDLE state in readiness for further operations
claim+alt+status 2 <> if
dfu-clear-status
release
claim+alt+status 2 <> abort" Can't put DFU into idle state"
then
;
: dfu-up ( len adr transaction -- #bytes )
0 swap ( len adr interface transaction )
DFU_UPLOAD dfu-in
;
: (dfu-down) ( len adr transaction -- status )
0 swap ( len adr interface transaction )
DFU_DNLOAD dfu-out
;
\ DfuSe devices use transaction numbers 0 and 1 for special commands
\ like set-address and erase
2 value transaction0
5 buffer: cmd-buf
: dfu-command ( len cmd -- )
cmd-buf c! ( len )
cmd-buf 0 (dfu-down) 0< if ( res )
." Command " cmd-buf c@ .x ." failed" cr
abort
then
dfu-get-status DOWNLOAD_BUSY_STATE <>
abort" Expecting DOWNLOAD_BUSY after special command"
dfu-get-status drop
;
\needs le-l! : le-l! ( l adr -- ) >r lbsplit r@ 3 + c! r@ 2+ c! r@ 1+ c! r> c! ;
0 value base-adr
\ Set the base address for the next download or upload sequence.
\ The next state is DOWNLOAD_IDLE
: dfu-set-address ( address -- )
cmd-buf 1+ le-l! 5 $21 dfu-command
dup to base-adr
;
: dfu-erase-region ( adr -- ) cmd-buf 1+ le-l! 5 $41 dfu-command ;
: dfu-mass-erase ( -- ) 1 $41 dfu-command ;
: dfu-read-unprotect ( -- ) 1 $92 dfu-command ;
: dfu-chunk ( len adr transaction -- #bytes )
(dfu-down) dup 0< if ( error )
." Download failed, libusb error " .d cr
abort
then ( #bytes )
0 begin ( #bytes state )
drop ( #bytes )
dfu-get-status ( #bytes state )
dup DOWNLOAD_IDLE_STATE = ( #bytes state flag )
over DFU_ERROR_STATE = or ( #bytes state flag )
over DFU_MANIFEST_STATE = or ( #bytes state flag )
until ( #bytes state )
DFU_MANIFEST_STATE = if ( #bytes )
." Running new code" cr ( #bytes )
\ The "manifest state" comment is more accurate, but not user-friendly
\ ." Transition to manifest state" cr ( #bytes )
then ( #bytes )
dfu-status c@ ?dup if ( #bytes )
." Download failed with status " . cr ( #bytes )
abort
then ( #bytes )
;
\ FLASH regions, possibly with different erasure sizes
: region-size ( i -- ) regions swap 2* la+ l@ ;
\ Find the region containing adr
: >region#- ( adr -- n )
dfu-flash-base ( adr fadr )
#regions 0 ?do ( adr fadr )
i region-size + ( adr fadr' )
2dup u< if ( adr fadr' )
2drop i unloop exit ( adr fadr' )
then ( adr fadr' )
loop ( adr fadr' )
2drop #regions
;
\ Find the first region whose start address is >= adr
: >region#+ ( adr -- n )
dfu-flash-base ( adr fadr )
#regions 0 ?do ( adr fadr )
\ If adr falls right at the beginning of a region
\ it is the right one
2dup = if ( adr fadr' )
2drop i unloop exit ( adr fadr' )
then ( adr fadr' )
i region-size + ( adr fadr' )
\ If adr is less than the end of a region, the
\ next one is the right one.
2dup u< if ( adr fadr' )
2drop i 1+ unloop exit ( adr fadr' )
then ( adr fadr' )
loop ( adr fadr' )
2drop #regions
;
: >region-base ( region# -- )
dfu-flash-base swap 0 ?do ( end# start# adr )
i region-size + ( end# start# adr' )
loop ( end# start# adr )
;
: dfu-read-chunk ( adr len offset -- actual )
swap transfer-size min -rot ( thislen adr offset )
base-adr - transfer-size / ( thislen adr index )
transaction0 + dfu-up ( actual )
;
: dfu-write-chunk ( adr len offset -- actual )
swap transfer-size min -rot ( thislen adr offset )
base-adr - transfer-size / ( thislen adr index )
transaction0 + dfu-chunk ( actual )
;
\needs 3dup : 3dup 2 pick 2 pick 2 pick ;
\ Read len bytes into memory at adr from device address offset
: dfu-read ( adr len offset -- )
dup dfu-set-address ( adr len offset )
dfu-abort-to-idle \ dfu-set-address sets state to DOWNLOAD_IDLE
begin over 0> while ( adr len offset )
3dup dfu-read-chunk ( adr len offset actual-len )
dup 0< abort" Error"
tuck + >r /string r> ( adr' len' offset' )
repeat ( adr len offset )
3drop ( )
dfu-abort-to-idle ( )
;
\ Write len bytes from memory at adr to device address offset
\ The device area must have already been erased.
: dfu-write ( adr len offset -- )
dup dfu-set-address ( adr len offset )
begin over 0> while ( adr len offset )
dup show-progress ( adr len offset )
3dup dfu-write-chunk ( adr len offset actual-len )
dup 0< if ." Error " dup .d ." " .status cr abort then
tuck + >r /string r> ( adr' len' offset' )
repeat ( adr len offset )
3drop ( )
dfu-abort-to-idle ( )
;
: dfu-erase-regions ( start# end# -- )
swap dup >region-base ( end# start# adr )
-rot ?do ( adr )
dup show-progress ( adr )
dup dfu-erase-region ( adr )
i region-size + ( adr' )
loop ( adr )
drop
;
\ Erase FLASH erasure regions to include the range flash-adr,len
: dfu-erase ( flash-adr len -- )
over dfu-flash-base u< abort" Start address less than FLASH base" ( adr len )
over >region#- -rot ( start-region# adr len )
+ >region#+ ( start-region# end-region# )
dfu-erase-regions ( )
;
: dfu-program ( adr len flash-adr -- )
" Erasing ... " show-phase ( adr len flash-adr )
2dup swap dfu-erase ( adr len flash-adr )
progress-done
" Programming ... " show-phase ( adr len flash-adr )
2dup swap bounds set-progress-range ( adr len flash-adr )
dfu-write ( adr len flash-adr )
progress-done
" Complete" show-phase ( )
;
: dfu-leave ( -- )
dfu-flash-base dfu-set-address
0 0 2 dfu-chunk
;