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