blob: c57f6fc214dc4a2dd7f23221db2a05f830c148a5 [file] [log] [blame]
\ STMicro ROM bootloader FLASH programming code
: drain-rx ( -- )
begin serbuf 1 #10 timed-serial-read 1 <> until
;
#2000 value rx-timeout
alias tx serial-put
: rx ( -- b )
\ Erase all command can take upto 10s on STM32F4 to get ACK'ed
serbuf 1 rx-timeout timed-serial-read
1 <> abort" Serial timeout"
serbuf c@
;
: stm-wait-ack ( -- )
rx dup $79 = if drop exit then
dup $1f = abort" Got NACK from serial bootloader"
." Bad ACK: " .x cr abort
;
: reboot-stm ( run? -- ) \ Run if run? is true, else download
\ Run with no parity, but downloading requires even parity
dup if 'n' else 'e' then serial-ih set-parity ( run? )
dup 0 set-rts-dtr \ With NRST high (DTR=0), set BOOT0 according to run?
dup 1 set-rts-dtr \ Drive NRST low (DTR=1), with BOOT0 according to run?
0 tx \ While reset, send NUL to prime the transmitter
drain-rx \ While chip is in reset, clear old Rx bytes
#10 ms \ Probably unnecessary but harmless
( run? ) 0 set-rts-dtr \ Release NRST with BOOT0 according to run?
;
: stm-run-from-flash ( -- ) true reboot-stm ;
: strun ( -- ) stm-run-from-flash display ;
\ Put the chip in serial bootload mode
: stm-setup0 ( -- ) false reboot-stm ;
\ After stm-setup0, give STM32 time to get into bootloader and be ready to
\ accept commands. 10ms was enough for STM32L152, need atleast 100ms for
\ STM32F4
: stm-start-bootloader ( -- ) stm-setup0 #100 ms $7f tx stm-wait-ack ;
alias sb stm-start-bootloader
0 value cksum
: sum-tx ( n -- ) dup cksum xor to cksum tx ;
: init-cksum ( -- ) 0 to cksum ;
: send-cksum ( -- ) cksum tx ;
\ Tools for collecting data into a buffer and sending it later.
\ This improves performance when using FTDI libraries that send
\ immediately and thus incur USB frame synchronization delays for
\ every send.
$200 buffer: sum-buf
0 value sum-ptr
: buf{ ( -- ) sum-buf to sum-ptr ;
: }buf ( -- ) sum-buf sum-ptr over - serial-write stm-wait-ack ;
: +ptr ( n -- adr ) sum-ptr tuck + to sum-ptr ;
: +b ( b -- ) 1 +ptr c! ;
: +$ ( adr len -- ) dup +ptr swap move ;
: cksum{ ( -- ) buf{ init-cksum ;
: }cksum ( -- ) cksum +b }buf ;
: sum+b ( b -- ) dup cksum xor to cksum ( b ) +b ;
: (stm-send1) ( b -- ) dup +b $ff xor +b ;
: stm-send1 ( b -- ) buf{ (stm-send1) }buf ;
: (stm-send2) ( w -- ) wbsplit sum+b sum+b ;
: (stm-send4) ( n -- )
init-cksum lbsplit ( b.low b.2 b.3 b.high )
sum+b sum+b sum+b sum+b ( )
cksum +b ( )
;
: stm-send4 (stm-send4) stm-wait-ack ;
: stm-version ( -- version )
0 stm-send1 rx rx ( numbytes version )
swap 0 ?do rx drop loop ( version )
stm-wait-ack ( version )
;
: stm-read-protect-status ( -- version #disable #enables )
1 stm-send1 rx rx rx stm-wait-ack
;
: stm-get-id ( -- id )
2 stm-send1 rx rx ( n id )
swap 0 ?do 8 lshift rx or loop ( id' )
stm-wait-ack ( )
;
: stm-read-memory ( adr len offset -- )
$11 stm-send1 ( adr len offset )
stm-send4 dup 1- stm-send1 ( adr len )
serial-read-exact ( )
;
: stm-go ( offset -- ) $11 stm-send1 stm-send4 stm-wait-ack ;
: slow-send-summed ( adr len n -- )
init-cksum sum-tx ( )
bounds ?do i c@ sum-tx loop ( )
send-cksum stm-wait-ack ( )
;
: stm-slow-write-memory ( adr len offset -- )
$31 stm-send1 stm-send4 dup 1- slow-send-summed
;
\needs 3dup : 3dup 2 pick 2 pick 2 pick ;
: (send-summed) ( adr len n -- )
\ n is either len or len-1 depending on the command
init-cksum sum+b ( adr len ) \ Length code goes first
bounds ?do i c@ sum+b loop ( )
cksum +b ( )
;
: send-summed ( adr len n -- ) buf{ (send-summed) }buf ;
: stm-write-memory ( adr len offset -- )
\ We do a tricky thing here for performance sake. Instead of waiting for
\ each of the three ACKs individually (after send1, after send4, and after
\ the data), we group the three writes into one buffer, send it all, then
\ wait for the three ACKs. That works because the STM chip has enough buffering
\ to accept everything at full speed (the send1 and send4 are quite short),
\ and the three ACKs fit easily in the receive FIFO. It's a big performance
\ win because waiting for an individual ACK can take up to 6 ms because of
\ library, syscall, and USB overhead. Doing it this way collapses several
\ 3-to-6 ms delays into one delay, nearly doubling download speed in some cases.
buf{ $31 (stm-send1) (stm-send4) dup 1- (send-summed) }buf
stm-wait-ack stm-wait-ack
;
\ The commented-out ones are not supported on the part we use
\ : stm-erase-chip ( -- ) $43 stm-send1 $ff stm-send1 ;
\ : stm-erase-pages ( adr len -- ) $43 stm-send1 dup send-summed ;
\ : stm-erase-bank1 ( -- ) $fffe (stm-extended-erase) ;
\ : stm-erase-bank2 ( -- ) $fffd (stm-extended-erase) ;
: (stm-extended-erase) ( code -- ) $44 stm-send1 cksum{ (stm-send2) }cksum ;
: stm-erase-all ( -- ) $ffff (stm-extended-erase) ;
: stm-erase-page-list ( adr len -- )
$44 stm-send1 ( adr len )
cksum{ ( adr len )
dup 2/ 1- (stm-send2) ( adr len )
bounds ?do i w@ (stm-send2) /w +loop ( )
}cksum
;
: stm-erase-page ( page# -- )
$44 stm-send1 cksum{ 0 (stm-send2) ( page# ) (stm-send2) }cksum
;
: stm-erase-pages ( page# #pages -- )
$44 stm-send1
cksum{ ( page# #pages )
dup 1- (stm-send2) ( page# #pages )
bounds ?do i (stm-send2) loop ( )
}cksum
;
$40 constant /erase-chunk
: stm-erase-pages-chunked ( page# #pages -- )
dup 0 ?do ( page# #pages )
over .x (cr ( page# #pages )
2dup /erase-chunk min ( page# #pages page# this#pages )
stm-erase-pages ( page# #pages )
/erase-chunk /string ( page#' #pages' )
/erase-chunk +loop ( page#' #pages' )
2drop ( )
;
: stm-wp-pages ( adr len -- ) $63 stm-send1 dup send-summed ;
: stm-write-unprotect ( -- ) $73 stm-send1 stm-wait-ack ;
: stm-readout-protect ( -- ) $82 stm-send1 stm-wait-ack ;
\ This will clear the FLASH if it is current protected
: stm-readout-unprotect ( -- ) $92 stm-send1 stm-wait-ack ;
defer show-phase ( adr len -- )
: text-show-phase ( adr len -- ) type cr ;
' text-show-phase to show-phase
defer set-progress-range ( high low -- )
: text-set-range ( high low -- ) 2drop ;
' text-set-range to set-progress-range
defer show-progress
: text-show-progress ( n -- ) .x (cr ;
' text-show-progress to show-progress
: stm-write ( adr len offset -- )
begin over while ( adr len offset )
dup show-progress ( adr len offset )
3dup swap $100 min ( adr len offset adr offset this )
tuck >r ( adr len offset adr offset this r: this )
stm-write-memory ( adr len offset r: this )
r@ + -rot ( offset' adr len r: this )
r> /string rot ( adr' len' offset' )
repeat ( adr len offset )
3drop ( )
cr
;
: stm-read ( adr len offset -- )
begin over while ( adr len offset )
3dup dup .x (cr ( adr len offset adr len offset )
swap $100 min ( adr len offset adr offset this )
tuck >r ( adr len offset adr offset this r: this )
stm-read-memory ( adr len offset r: this )
r@ + -rot ( offset' adr len r: this )
r> /string rot ( adr' len' offset' )
repeat ( adr len offset )
3drop ( )
cr
;
\ offset is typically $08000000 for the start of FLASH
$100 constant /flash-page
$08000000 constant flash-base
$08080000 constant data-eeprom-base
$49534843 constant chooser-magic \ CHSI
data-eeprom-base $000 + constant chooser-spec
flash-base $00000 + constant chooser-base
$02000 constant /chooser
$4952444c constant loader-magic \ LDRI
data-eeprom-base $0c0 + constant loader-spec
flash-base $02000 + constant loader-base
$06000 constant /loader
$494d5453 constant stmapp-magic \ STMI
data-eeprom-base $180 + constant stmapp-spec
flash-base $08000 + constant stmapp-base
$30000 constant /stmapp
$494d4342 constant bcmapp-magic \ BCMI
data-eeprom-base $240 + constant bcmapp-spec
flash-base $38000 + constant bcmapp-base
$08000 constant /bcmapp
create one 1 ,
: flash-spec-file ( name$ spec-adr -- )
>r open-bin-file ( r: spec-adr )
bin-file-buf /bin-file r@ stm-write ( r: spec-adr )
one /l r> #24 + stm-write ( )
;
: (chooser-spec) ( -- ) " chooser.spec" chooser-spec flash-spec-file ;
: (loader-spec) ( -- ) " loader.spec" loader-spec flash-spec-file ;
: (stmapp-spec) ( -- ) " stmapp.spec" stmapp-spec flash-spec-file ;
: (bcmapp-spec) ( -- ) " bcmapp.spec" bcmapp-spec flash-spec-file ;
$c0 constant /spec
/spec buffer: spec
: +spec ( offset -- adr ) spec + ;
: spec-l! ( offset -- ) +spec le-l! ;
$40000 buffer: sha-buf
: make-spec ( version developer name$ magic baseaddr len -- )
>r ( version developer name$ magic baseaddr r: len )
spec /spec erase ( version developer name$ magic baseaddr )
4 spec-l! ( version developer name$ magic )
0 spec-l! ( version developer name$ )
2swap #14 +spec le-w! ( name$ version )
#12 +spec le-w! ( name$ )
2dup file-date #16 spec-l! ( name$ )
open-bin-file ( )
/bin-file 8 spec-l! ( ) \ size
1 #24 spec-l! ( ) \ state = IMAGE_DOWNLOADED
sha-buf r@ erase ( )
bin-file-buf sha-buf /bin-file move ( )
#32 +spec sha-buf r> sha256 ( )
;
: write-spec ( version developer name$ magic baseaddr len spec-adr -- )
>r make-spec ( r: spec-adr )
spec /spec r> stm-write
;
: flash-section ( flash-adr size name$ -- )
open-bin-file ( flash-adr size )
" Erasing ... " show-phase ( flash-adr size )
over /flash-page / ( flash-adr size page# )
swap /flash-page 1- + /flash-page / ( flash-adr page# #pages )
stm-erase-pages-chunked ( flash-adr )
bin-file-buf ( flash-adr adr )
/bin-file /flash-page round-up ( flash-adr adr len )
rot stm-write ( )
;
: spec-common ( -- version developer name$ -- )
\ XXX need some way to set the developer initials, preferably automatic
0 'mb' bin-filename$
;
: (chooser) ( -- )
chooser-base /chooser " chooser.bin" flash-section
\ spec-common chooser-magic chooser-base /chooser chooser-spec write-spec
;
: chooser ( -- ) stm-start-bootloader (chooser) (chooser-spec) ;
: (loader) ( -- )
loader-base /loader " loader.bin" flash-section
\ spec-common loader-magic loader-base /loader loader-spec write-spec
;
: loader ( -- ) stm-start-bootloader (loader) (loader-spec) ;
: (stmapp) ( -- )
stmapp-base /stmapp " stmapp.bin" flash-section
\ spec-common stmapp-magic stmapp-base /stmapp stmapp-spec write-spec
;
: stmapp ( -- ) stm-start-bootloader (stmapp) (stmapp-spec) ;
: (bcmapp) ( -- )
bcmapp-base /bcmapp " bcmapp.bin" flash-section
\ spec-common bcmapp-magic bcmapp-base /bcmapp bcmapp-spec write-spec
;
: bcmapp ( -- ) stm-start-bootloader (bcmapp) (bcmapp-spec) ;
alias (bcmfw) (bcmapp)
alias bcmfw bcmapp
create bspin-page-sizes
$4000 , $4000 , $4000 , $4000 , $10000 , $20000 , $20000 , $20000 ,
8 constant bspin-#pages
: bspin-erased ( i -- n )
0 swap 1+ 0 ?do bspin-page-sizes i na+ @ + loop
;
: bspin-erase ( size -- )
0 set-progress-range
bspin-#pages 0 do
i stm-erase-page
i bspin-erased show-progress
loop
;
: bspin-flash-section ( flash-adr size -- )
" Erasing ... " show-phase ( flash-adr )
bspin-erase ( flash-adr )
" Programming ... " show-phase ( flash-adr )
bin-file-buf ( flash-adr adr )
/bin-file /flash-page round-up ( flash-adr adr len )
2 pick over bounds set-progress-range ( flash-adr adr len )
rot stm-write ( )
" Complete" show-phase ( )
;
: connect-to-backspin ( -- )
#10000 to rx-timeout
" Connecting ... " show-phase
stm-start-bootloader
;
: flash-backspin ( -- )
connect-to-backspin
flash-base $80000 bspin-flash-section
;
: bspin ( -- )
" backspin.bin" open-bin-file
flash-backspin
stm-run-from-flash
display
;
: (allapps) ( -- )
stm-start-bootloader
(chooser) (loader) (stmapp) (bcmapp)
\ If we don't want to inject the specs from files comment this out and
\ and enable write-spec for each app
(chooser-spec) (loader-spec) (stmapp-spec) (bcmapp-spec)
;
: allapps ( -- )
(allapps)
stm-run-from-flash
display
;
: (stapp)
" stapp.bin" arg-or-default open-bin-file
/bin-file /flash-page 1- + /flash-page / ( #pages )
." Erasing ... " cr
0 swap stm-erase-pages-chunked ." done" cr ( )
bin-file-buf /bin-file /flash-page round-up flash-base stm-write
;
: stmapp-only ( -- )
stm-start-bootloader
(stmapp)
stm-run-from-flash
display
;
: bcmapp-only ( -- )
stm-start-bootloader
(bcmapp)
stm-run-from-flash
display
;
: old-stapp ( -- )
stm-start-bootloader
(stapp) (bcmfw)
stm-run-from-flash
display
;
: stapp ( -- )
." Running allapps instead; for old behavior use old-stapp" cr
allapps
;
$20000 constant /this-flash
: stread ( "filename" -- )
safe-parse-word w/o create-file abort" Can't create file" to bin-file
?alloc-flash-buf
stm-start-bootloader
bin-file-buf /this-flash flash-base stm-read
bin-file-buf /this-flash bin-file write-file ( ior )
bin-file close-file drop abort" Write failed"
;
0 value target-revision#
: ?get-hardware-version ( adr len -- )
-crlf ( adr len )
" Hardware version = " 2over initial-substring? if ( adr len )
#19 /string push-decimal $number? pop-base if ( d )
drop to target-revision# ( )
exit ( -- )
then ( adr len )
else ( adr len )
2drop ( )
then ( )
;