Author: wmb Date: 2009-11-29 20:58:20 +0100 (Sun, 29 Nov 2009) New Revision: 1525
Added: cpu/x86/pc/olpc/xmodem-reflash.fth Log: Checked in xmodem-reflash.fth . It can be downloaded serially to provide a reflash-over-serial capability.
Added: cpu/x86/pc/olpc/xmodem-reflash.fth =================================================================== --- cpu/x86/pc/olpc/xmodem-reflash.fth (rev 0) +++ cpu/x86/pc/olpc/xmodem-reflash.fth 2009-11-29 19:58:20 UTC (rev 1525) @@ -0,0 +1,470 @@ +\ See license at end of file +purpose: Reflash OLPC Open Firmware using XMODEM serial download for the image + +\ Interface definitions to splice xmodem into Open Firmware + +true value serial-on? +: serial-off ( -- ) + serial-on? if + fallback-in-ih remove-input + fallback-out-ih remove-output + false to serial-on? + then +; +: serial-on ( -- ) + serial-on? 0= if + fallback-in-ih add-input + fallback-out-ih add-output + true to serial-on? + then +; + +\ alias m-key? ukey? +alias m-key ukey +alias m-emit uemit + +: m-init ( -- ) + h# 07 h# 3fa pc! \ Clear and enable FIFOs + h# 80 h# 3fb pc! \ Select baud divisor port + h# 00 h# 3f9 pc! \ High divisor for 115200 baud + h# 01 h# 3f8 pc! \ Low divisor for 115200 baud + h# 3 h# 3fb pc! \ 8n1 +; + +\ : panel-button? ( -- flag ) key? ; +: panel-button? ( -- flag ) false ; \ We don't want to abort +: panel-d. ( n -- ) + #out @ >r + push-decimal + <# u# u# u# ( bs hold bs hold bs hold ) u#> type + pop-base + r> #out ! +; + +: panel-msg: create ", does> count type ; + +" Abort" panel-msg: abrt-msg \ Abrt +" Cancel" panel-msg: can-msg \ CAn +: crc-msg ; \ " Xmodem-CRC" panel-msg: crc-msg \ crc +: done-msg ; \ " Done" panel-msg: done-msg \ donE +" Timeout" panel-msg: timeout-msg \ tout +" "rr " panel-msg: r0-msg \ Start of packet +" "rR " panel-msg: r1-msg \ Start of packet big +" " panel-msg: r2-msg \ Inside try-receive + +" Error" panel-msg: giveup-msg \ Err +" Loading diags " panel-msg: upld-msg \ UPLd +" OF" panel-msg: of-msg \ OF + +: bogus-char ( c -- ) ." Bogus: " .x ; +: ignore-char ( c -- ) ." Ignoring: " .x ; + +: ms>ticks ( ms -- ticks ) ; + +variable timer-init + +: timed-in ( -- true | char false ) \ get a character unless timeout + get-msecs timer-init @ + ( time-limit ) + begin ( time-limit ) + ukey? if drop ukey false exit then ( time-limit ) + dup get-msecs - 0< until + drop true +; + + +\ --- + +\ CRC-16 table +base @ hex +create crc16tab + 0000 w, 1021 w, 2042 w, 3063 w, 4084 w, 50a5 w, 60c6 w, 70e7 w, + 8108 w, 9129 w, a14a w, b16b w, c18c w, d1ad w, e1ce w, f1ef w, + 1231 w, 0210 w, 3273 w, 2252 w, 52b5 w, 4294 w, 72f7 w, 62d6 w, + 9339 w, 8318 w, b37b w, a35a w, d3bd w, c39c w, f3ff w, e3de w, + 2462 w, 3443 w, 0420 w, 1401 w, 64e6 w, 74c7 w, 44a4 w, 5485 w, + a56a w, b54b w, 8528 w, 9509 w, e5ee w, f5cf w, c5ac w, d58d w, + 3653 w, 2672 w, 1611 w, 0630 w, 76d7 w, 66f6 w, 5695 w, 46b4 w, + b75b w, a77a w, 9719 w, 8738 w, f7df w, e7fe w, d79d w, c7bc w, + 48c4 w, 58e5 w, 6886 w, 78a7 w, 0840 w, 1861 w, 2802 w, 3823 w, + c9cc w, d9ed w, e98e w, f9af w, 8948 w, 9969 w, a90a w, b92b w, + 5af5 w, 4ad4 w, 7ab7 w, 6a96 w, 1a71 w, 0a50 w, 3a33 w, 2a12 w, + dbfd w, cbdc w, fbbf w, eb9e w, 9b79 w, 8b58 w, bb3b w, ab1a w, + 6ca6 w, 7c87 w, 4ce4 w, 5cc5 w, 2c22 w, 3c03 w, 0c60 w, 1c41 w, + edae w, fd8f w, cdec w, ddcd w, ad2a w, bd0b w, 8d68 w, 9d49 w, + 7e97 w, 6eb6 w, 5ed5 w, 4ef4 w, 3e13 w, 2e32 w, 1e51 w, 0e70 w, + ff9f w, efbe w, dfdd w, cffc w, bf1b w, af3a w, 9f59 w, 8f78 w, + 9188 w, 81a9 w, b1ca w, a1eb w, d10c w, c12d w, f14e w, e16f w, + 1080 w, 00a1 w, 30c2 w, 20e3 w, 5004 w, 4025 w, 7046 w, 6067 w, + 83b9 w, 9398 w, a3fb w, b3da w, c33d w, d31c w, e37f w, f35e w, + 02b1 w, 1290 w, 22f3 w, 32d2 w, 4235 w, 5214 w, 6277 w, 7256 w, + b5ea w, a5cb w, 95a8 w, 8589 w, f56e w, e54f w, d52c w, c50d w, + 34e2 w, 24c3 w, 14a0 w, 0481 w, 7466 w, 6447 w, 5424 w, 4405 w, + a7db w, b7fa w, 8799 w, 97b8 w, e75f w, f77e w, c71d w, d73c w, + 26d3 w, 36f2 w, 0691 w, 16b0 w, 6657 w, 7676 w, 4615 w, 5634 w, + d94c w, c96d w, f90e w, e92f w, 99c8 w, 89e9 w, b98a w, a9ab w, + 5844 w, 4865 w, 7806 w, 6827 w, 18c0 w, 08e1 w, 3882 w, 28a3 w, + cb7d w, db5c w, eb3f w, fb1e w, 8bf9 w, 9bd8 w, abbb w, bb9a w, + 4a75 w, 5a54 w, 6a37 w, 7a16 w, 0af1 w, 1ad0 w, 2ab3 w, 3a92 w, + fd2e w, ed0f w, dd6c w, cd4d w, bdaa w, ad8b w, 9de8 w, 8dc9 w, + 7c26 w, 6c07 w, 5c64 w, 4c45 w, 3ca2 w, 2c83 w, 1ce0 w, 0cc1 w, + ef1f w, ff3e w, cf5d w, df7c w, af9b w, bfba w, 8fd9 w, 9ff8 w, + 6e17 w, 7e36 w, 4e55 w, 5e74 w, 2e93 w, 3eb2 w, 0ed1 w, 1ef0 w, +base ! + +: updcrc ( crc c -- crc' c ) + dup rot ( c c crc ) + wbsplit >r ( c c low r: high ) + bwjoin ( c low|c r: high ) + crc16tab r> wa+ w@ ( c low|c table-entry ) + xor swap ( crc' c ) +; + +: crc-send ( crc adr len -- crc' ) + bounds ?do i c@ updcrc m-emit loop +; + +\ Assumes 0<len<64K +: crc-receive ( crc adr len timeout -- true | crc' false ) + timer-init ! + bounds ?do timed-in if drop true unloop exit then i c! loop +; + +: checksum-send ( sum adr len -- sum' ) + bounds ?do i c@ dup m-emit + loop +; + + + +\ --- + +purpose: X/YMODEM protocol for serial uploads and downloads + +\ Xmodem protocol file transfer to and from memory +\ Commands: +\ send ( adr len -- ) +\ receive ( adr maxlen -- adr len ) + +\ Interface to the serial line: +\ +\ m-key? -- flag +\ Flag is true if a character is available on the serial line +\ m-key -- char +\ Gets a character from the serial line +\ m-emit char -- +\ Puts the character out on the serial line. + +variable buf-start +variable buf-end +variable mem-start +variable mem-end + +: putc ( char -- ) buf-start @ c! 1 buf-start +! ; + +: end-delay ( -- ) d# 200 ms ; + + +vocabulary modem +only forth also modem also modem definitions +base @ decimal + +\ Common to both sending and receiving +0 value crc? 0 value big? \ 0 value streaming? +variable #control-z's +d# 128 constant 128by +d# 1024 constant 1k +variable sector# +variable checksum +variable #errors 4 constant max#errors variable #naks +: /sector ( -- n ) big? if 1k else 128by then ; + +\ ASCII control characters + 0 constant nul + 1 constant soh \ Start of header; 128-byte packets + 2 constant stx \ Start of header; 1024-byte packets + 4 constant eot + 6 constant ack +d# 21 constant nak +d# 24 constant can + +: timeout! ( ms -- ) ms>ticks timer-init ! ; +: timeout: \ name ( milliseconds -- ) + create , + does> @ timeout! +; +d# 3000 timeout: short-timeout d# 6000 timeout: long-timeout +d# 60,000 timeout: initial-timeout +short-timeout + +: gobble ( -- ) \ eat characters until they stop coming + d# 100 timeout! begin timed-in 0= while drop repeat long-timeout +; + +variable done? +: rx-abort ( -- ) end-delay 2 done? ! ; +: tx-abort ( -- ) end-delay 2 done? ! true abort" aborted" ; + +\ It would be nice to use control C, but some operating systems don't pass it +: ?interrupt ( -- ) \ aborts if user types control Z + panel-button? if can m-emit abrt-msg tx-abort then +; + +\ Receiving + +: receive-setup ( adr maxlen -- ) + 1 sector# ! #naks off #control-z's off +; +: receive-error ( -- ) \ eat rest of packet and send a nak + gobble + 1 #naks +! #naks @ max#errors > if + can m-emit giveup-msg rx-abort + then + nak m-emit +; + +: receive-data ( adr len -- error? ) + 0 -rot bounds ( chk endadr startadr ) + crc? if ( crc endadr startadr ) + ?do timed-in throw updcrc i c! loop ( crc ) + timed-in throw timed-in throw ( crc high low ) + swap bwjoin <> ( error? ) + else ( sum endadr startadr ) + ?do timed-in throw dup i c! + loop ( sum ) + h# ff and timed-in throw <> ( error? ) + then ( error? ) +; +variable got-sector# +: try-receive ( adr maxlen -- adr maxlen actual-len ) + ( packet OK return: none ) + ( retry return: throws -1 ) + ( done return: throws 1 ) + ( abort return: throws 2 ) +\ begin + timed-in throw + case + soh of false to big? r0-msg endof \ expected... + stx of true to big? r1-msg endof \ expected... + -1 of timeout-msg -1 throw endof + nul of 1 throw endof \ XXX check this + can of can-msg 2 throw endof + eot of done-msg ack m-emit 1 throw endof + ( default) bogus-char -1 throw + endcase ( adr maxlen ) +\ again + + /sector < if 2 throw then ( adr ) + timed-in throw ( adr sec# ) + timed-in throw ( adr sec# ~sec# ) + h# ff xor over <> throw ( adr sec# ) + got-sector# ! ( adr ) + /sector receive-data throw ( ) + + ack m-emit + sector# @ panel-d. + 1 sector# +! \ Expected sector# + + #naks off + /sector ( actual ) +; +: !receive-packet ( adr maxlen -- adr maxlen actual-len ) + r2-msg + begin ( adr maxlen ) + 2dup ['] try-receive catch case ( adr maxlen [ actual 0 | x x n ] ) + \ The usual case: successful packet reception + 0 of ( adr maxlen actual-len ) exit endof + + ?interrupt + + \ Retryable error + -1 of ( adr maxlen x x ) 2drop receive-error endof + + \ Handle termination conditions at a higher level + ( default: adr maxlen x x n ) throw + endcase ( adr maxlen ) + again +; +: (receive) ( adr0 maxlen -- adr0 len ) + receive-setup ( adr0 maxlen ) + gobble nak m-emit ( adr0 maxlen ) + 2dup ( adr0 maxlen adr0 maxlen ) + begin dup 0> while ( adr0 maxlen adr remlen ) + ['] !receive-packet catch case + 0 of ( adr0 maxlen adr remlen actual-len ) \ Packet ok + /string ( adr0 maxlen adr' remlen' ) + endof + 1 of ( adr0 maxlen adr remlen ) \ Normal end of transmission + nip - exit ( adr0 len ) + endof + ( default ) can m-emit abrt-msg throw + endcase + repeat ( adr0 maxlen adr remlen ) + can m-emit of-msg end-delay ( adr0 maxlen adr remlen ) + nip - ( adr0 len ) +; + +\ Sending +modem definitions + +: bail-out ( -- ) can m-emit giveup-msg tx-abort ; +: wait-ack ( -- proceed? ) \ wait for ack or can +[ifdef] streaming? \ YMODEM-g + streaming? if + m-key? if m-key can = if bail-out then then + true exit + then +[then] + + #errors off + begin + ?interrupt + timed-in if + 1 #errors +! #errors @ max#errors > if bail-out then + timeout-msg false exit + then + case + ack of #naks off true exit endof + can of can-msg tx-abort endof + nak of + 1 #naks +! #naks @ max#errors > if bail-out then + false exit + endof + + \ If we get a C, restart + [char] C of sector# @ 1 <> if [char] C bogus-char then endof + + ( default) dup bogus-char + endcase + again +; +: start-receiver ( -- ) \ wait for nak + gobble + upld-msg + sector# off + #naks off false to crc? + initial-timeout + begin + timed-in if timeout-msg tx-abort exit then + case + can of can-msg tx-abort endof + nak of true endof + [char] C of true to crc? crc-msg true endof +[ifdef] streaming? + [char] G of true to streaming? true to crc? true endof +[then] + nul of false endof \ Startup transients generate nulls + ( default) dup ignore-char false swap + endcase + until + gobble long-timeout +; + +: pad ( -- b ) control Z sector# @ 0<> and ; +\ Send without confirmation +: send-packet ( adr len big? -- ) + if 1k stx else 128by soh then ( adr len /sec start ) + m-emit ( adr len /sec ) + + \ Sector number + sector# @ dup m-emit h# ff xor m-emit ( adr len /sec ) + + over - 0 2swap ( #pad 0 adr len ) + crc? if ( #pad 0 adr len ) + crc-send ( #pad crc ) + swap 0 ?do pad updcrc m-emit loop ( crc' ) + 0 updcrc updcrc drop ( crc' ) + wbsplit m-emit m-emit ( ) + else ( #pad 0 adr len ) + checksum-send ( #pad sum ) + swap 0 ?do pad dup m-emit + loop ( sum' ) + m-emit ( ) + then ( ) +; + +\ Send until delivery confirmed +: deliver-packet ( adr len big? -- ) + sector# @ panel-d. + begin 3dup send-packet wait-ack until + 3drop +; + +: end-data ( -- ) + begin eot m-emit wait-ack until \ End the protocol + done-msg end-delay +; + +: sx ( adr len -- ) + m-init + start-receiver ( adr len ) + begin dup 0> while ( adr len ) + 1 sector# +! ( adr len ) + 2dup /sector min ( adr len adr /this ) + tuck big? deliver-packet ( adr len /this ) + /string ( adr' len' ) + repeat ( adr len ) + 2drop ( ) + + end-data +; + +\ Info format: +\ <filename>NUL<decimal_size>[[ <decimal_modtime>] <octal_permsissions.]NUL... +: send-file ( adr len name$ -- ) + m-init + start-receiver + here place ( adr len ) + " "(00)" here $cat ( adr len ) + push-decimal dup (.) pop-base ( adr len len$ ) + here $cat here count ( adr len batch$ ) + false deliver-packet ( adr len ) + sx +; + +: sb-end ( -- ) start-receiver " "(00)" false deliver-packet end-delay ; + +: sb ( adr len name$ -- ) send-file sb-end ; + +forth definitions + +alias sx sx +: xmodem-receive ( adr maxlen -- adr len ) + serial-off cursor-off + ['] (receive) catch ( adr maxlen throw-code ) + serial-on cursor-on ( adr maxlen throw-code ) + abort" XMODEM reception aborted" +; + +: xmodem-reflash ( -- ) + ?enough-power + ." Send the firmware image using the XMODEM (Checksum) protocol" cr + flash-buf /flash xmodem-receive nip ( actual-len ) + ?image-valid true to file-loaded? + reflash +; +.( Type 'xmodem-reflash' to begin XMODEM reception) cr + +only forth also definitions + +base ! + +\ LICENSE_BEGIN +\ Copyright (c) 2009 FirmWorks +\ +\ Permission is hereby granted, free of charge, to any person obtaining +\ a copy of this software and associated documentation files (the +\ "Software"), to deal in the Software without restriction, including +\ without limitation the rights to use, copy, modify, merge, publish, +\ distribute, sublicense, and/or sell copies of the Software, and to +\ permit persons to whom the Software is furnished to do so, subject to +\ the following conditions: +\ +\ The above copyright notice and this permission notice shall be +\ included in all copies or substantial portions of the Software. +\ +\ THE SOFTWARE IS PROVIDED "AS IS", WITHOUT WARRANTY OF ANY KIND, +\ EXPRESS OR IMPLIED, INCLUDING BUT NOT LIMITED TO THE WARRANTIES OF +\ MERCHANTABILITY, FITNESS FOR A PARTICULAR PURPOSE AND +\ NONINFRINGEMENT. IN NO EVENT SHALL THE AUTHORS OR COPYRIGHT HOLDERS BE +\ LIABLE FOR ANY CLAIM, DAMAGES OR OTHER LIABILITY, WHETHER IN AN ACTION +\ OF CONTRACT, TORT OR OTHERWISE, ARISING FROM, OUT OF OR IN CONNECTION +\ WITH THE SOFTWARE OR THE USE OR OTHER DEALINGS IN THE SOFTWARE. +\ +\ LICENSE_END