openfirmware November 2009

openfirmware@openfirmware.info

4 participants
78 discussions

r1527 - cpu/x86/pc/olpc
by svn＠openfirmware.info 29 Nov '09

29 Nov '09

Author: wmb Date: 2009-11-29 21:30:35 +0100 (Sun, 29 Nov 2009) New Revision: 1527 Modified: cpu/x86/pc/olpc/xmodem-reflash.fth Log: Tweaked progress report messages in xmodem-reflash Modified: cpu/x86/pc/olpc/xmodem-reflash.fth =================================================================== --- cpu/x86/pc/olpc/xmodem-reflash.fth 2009-11-29 20:11:05 UTC (rev 1526) +++ cpu/x86/pc/olpc/xmodem-reflash.fth 2009-11-29 20:30:35 UTC (rev 1527) @@ -53,9 +53,9 @@ " "rR " panel-msg: r1-msg \ … [View More]

1 0

r1526 - cpu/x86/pc/olpc
by svn＠openfirmware.info 29 Nov '09

29 Nov '09

Author: wmb Date: 2009-11-29 21:11:05 +0100 (Sun, 29 Nov 2009) New Revision: 1526 Modified: cpu/x86/pc/olpc/xmodem-reflash.fth Log: Minor tweaks in xmodem-reflash.fth source. Modified: cpu/x86/pc/olpc/xmodem-reflash.fth =================================================================== --- cpu/x86/pc/olpc/xmodem-reflash.fth 2009-11-29 19:58:20 UTC (rev 1525) +++ cpu/x86/pc/olpc/xmodem-reflash.fth 2009-11-29 20:11:05 UTC (rev 1526) @@ -3,6 +3,7 @@ \ Interface definitions to splice … [View More]

1 0

r1525 - cpu/x86/pc/olpc
by svn＠openfirmware.info 29 Nov '09

29 Nov '09

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) @@… [View More] -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 [View Less]

1 0

r1524 - dev/mmc/sdhci
by svn＠openfirmware.info 29 Nov '09

29 Nov '09

Author: wmb Date: 2009-11-29 19:40:34 +0100 (Sun, 29 Nov 2009) New Revision: 1524 Modified: dev/mmc/sdhci/selftest.fth Log: OLPC trac 9766 - test-all failed after testing SD with no card in slot. Modified: dev/mmc/sdhci/selftest.fth =================================================================== --- dev/mmc/sdhci/selftest.fth 2009-11-29 07:56:08 UTC (rev 1523) +++ dev/mmc/sdhci/selftest.fth 2009-11-29 18:40:34 UTC (rev 1524) @@ -40,7 +40,7 @@ " card-inserted?" $call-parent 0= if … [View More]

1 0

r1523 - cpu/x86/pc/olpc/via
by svn＠openfirmware.info 29 Nov '09

29 Nov '09

Author: wmb Date: 2009-11-29 08:56:08 +0100 (Sun, 29 Nov 2009) New Revision: 1523 Modified: cpu/x86/pc/olpc/via/versions.fth Log: q3a16f Modified: cpu/x86/pc/olpc/via/versions.fth =================================================================== --- cpu/x86/pc/olpc/via/versions.fth 2009-11-29 07:51:53 UTC (rev 1522) +++ cpu/x86/pc/olpc/via/versions.fth 2009-11-29 07:56:08 UTC (rev 1523) @@ -2,7 +2,7 @@ \ The overall firmware revision macro: FW_MAJOR A -macro: FW_MINOR 16e +macro: … [View More]

1 0

r1522 - in dev: olpc/viacamera via/unichrome
by svn＠openfirmware.info 29 Nov '09

29 Nov '09

Author: wmb Date: 2009-11-29 08:51:53 +0100 (Sun, 29 Nov 2009) New Revision: 1522 Modified: dev/olpc/viacamera/camera.fth dev/via/unichrome/accel2d.fth Log: OLPC trac 9763 - Fixed camera test to work with 32bpp display mode. Modified: dev/olpc/viacamera/camera.fth =================================================================== --- dev/olpc/viacamera/camera.fth 2009-11-29 00:10:18 UTC (rev 1521) +++ dev/olpc/viacamera/camera.fth 2009-11-29 07:51:53 UTC (rev 1522) @@ -345,7 +345,6 @@ … [View More] i 'dma-buf-phys 340 i 4 * + cl! \ Capture frame buffers loop ; - [then] @@ -378,7 +377,7 @@ 0 300 cl! \ Mask all interrupts 8850.2114 310 cl! \ Enable CLK, FIFO threshold, UYVY, 8-bit CCIR656, \ Capture odd/even in interlace, triple buffers - 500 350 cl! \ Disable coring and 640*2 stride + VGA_WIDTH 2* 350 cl! \ Disable coring and 640*2 stride ; : power-up ( -- ) @@ -422,6 +421,18 @@ then ; +: snap ( timeout -- true | adr false ) + 0 do + buf-done? if + next-buf 'dma-buf false + 300 cl@ 83 or 300 cl! \ Clear interrupts + unloop exit + then + 1 ms + loop + true +; + : (read) ( adr len -- actual ) next-buf 'dma-buf -rot /dma-buf min dup >r move r> ( actual ) 300 cl@ 83 or 300 cl! \ Clear interrupts @@ -429,11 +440,11 @@ external -: camera-read ( adr len -- actual ) +: read ( adr len -- actual ) buf-done? if (read) else 2drop 0 then ; -: camera-open ( -- flag ) +: open ( -- flag ) init ov7670-detected? 0= if false exit then alloc-dma-bufs @@ -441,7 +452,7 @@ true ; -: camera-close ( -- ) +: close ( -- ) ctlr-stop power-off free-dma-bufs @@ -463,42 +474,31 @@ : full-brightness ( -- ) h# f " bright!" $call-parent ; : display-frame ( adr -- ) -\ test-x test-y VGA_WIDTH VGA_HEIGHT draw-rectangle - " expand-to-screen" $call-parent + VGA_WIDTH 2* ( src-adr src-pitch ) + 0 0 d# 280 d# 210 VGA_WIDTH VGA_HEIGHT " copy16>32" $call-parent autobright ; : timeout-read ( adr len timeout -- actual ) >r 0 -rot r> 0 ?do ( actual adr len ) - 2dup camera-read ?dup if 3 roll drop -rot leave then + 2dup read ?dup if 3 roll drop -rot leave then 1 ms - loop 2drop ; -: shoot-movie ( -- error? ) - /dma-buf #dma-bufs * dup dma-alloc swap ( adr len ) - get-msecs movie-time + -rot ( timeout adr len ) - begin - 2dup camera-read ?dup 0> if ( timeout adr len actual ) - VGA_WIDTH VGA_HEIGHT * 2* / 0 ?do over display-frame loop - else - 1 ms - then ( timeout adr len ) - get-msecs 3 pick u> - until ( timeout adr len ) - dma-free drop false ( error? ) +: shoot-still ( -- error? ) + d# 1000 snap if true exit then ( adr ) + display-frame + false ; -: shoot-still ( -- error? ) - /dma-buf dup dma-alloc tuck ( adr len adr ) - /dma-buf d# 1,000 timeout-read 0> if ( adr len ) - over display-frame - false - else - true - then ( adr len error? ) - -rot dma-free ( error? ) +: shoot-movie ( -- error? ) + get-msecs movie-time + ( timeout ) + begin ( timeout ) + shoot-still if drop true exit then ( timeout ) + dup get-msecs - 0<= ( timeout reached ) + until ( timeout ) + false ; : mirrored ( -- ) h# 1e ov@ h# 20 or h# 1e ov! ; @@ -509,12 +509,12 @@ ." The serial port is in use so the camera cannot be used" cr true exit then - camera-open 0= if true exit then + open 0= if true exit then d# 300 ms - unmirrored shoot-still ?dup if camera-close exit then ( error? ) + unmirrored shoot-still ?dup if close exit then ( error? ) d# 1,000 ms mirrored shoot-movie full-brightness ( error? ) - camera-close ( error? ) + close ( error? ) ?dup 0= if confirm-selftest? then ( error? ) ; @@ -535,12 +535,12 @@ ; : xselftest ( -- error? ) - camera-open 0= if true exit then + open 0= if true exit then h# 10 0 do shoot-still drop d# 500 ms camera-config config-check i dump-regs loop - 0 camera-close ( error? ) + 0 close ( error? ) ; Modified: dev/via/unichrome/accel2d.fth =================================================================== --- dev/via/unichrome/accel2d.fth 2009-11-29 00:10:18 UTC (rev 1521) +++ dev/via/unichrome/accel2d.fth 2009-11-29 07:51:53 UTC (rev 1522) @@ -43,6 +43,17 @@ wait-done ; +: copy16>32 ( src-base src-pitch src-x,y dst-x,y w,h -- ) + wh! dst! src! ( src-base src-pitch ) + h# 30 mmio@ >r 8 mmio@ >r h# 1c mmio@ >r ( src-base src-pitch ) + 3 rshift bytes/line 3 rshift wljoin 8 mmio! ( src-base ) + fb-va - 3 rshift h# 1c mmio! ( ) + h# 8000.0041 h# 30 mmio! ( ) \ Expand RGB565 to ARGB8888 + h# cc.00.00.01 0 mmio! ( ) \ Perform BLT Output = source + wait-done + r> h# 1c mmio! r> 8 mmio! r> h# 30 mmio! +; + \ some tests 1 [if] : gp-fill-screen ( color -- ) [View Less]

1 0

r1521 - ofw/fs
by svn＠openfirmware.info 28 Nov '09

28 Nov '09

Author: wmb Date: 2009-11-29 01:10:18 +0100 (Sun, 29 Nov 2009) New Revision: 1521 Modified: ofw/fs/zipfs.fth Log: Minor cleanup of zipfs.fth, removing unused words and adding a few comments. Modified: ofw/fs/zipfs.fth =================================================================== --- ofw/fs/zipfs.fth 2009-11-29 00:00:54 UTC (rev 1520) +++ ofw/fs/zipfs.fth 2009-11-29 00:10:18 UTC (rev 1521) @@ -103,12 +103,14 @@ \ ID of the header that's currently in the buffer -1 instance value … [View More]header-id +external : load ( adr -- len ) 0. seek drop dup image-size read ( adr len ) tuck ?crc ( len ) ; +headers : read-magic ( id -- adr ) -1 to header-id ( id ) u>d seek drop ( id ) @@ -177,14 +179,6 @@ 4 + /end-header + ( id' ) eh-comlen le-w@ + ( id' ) \ Skip comment ; -: dirent? ( id -- id flag ) - dup header-id = if false exit then ( id ) - dup read-magic ( id ) - zip-buffer " PK"(01 02)" comp if ( id ) - false exit - then - zip-buffer /central read drop ( id ) -; : first-dir-header ( -- false | id true ) first-file-header 0= if false exit then @@ -232,12 +226,6 @@ h# fe00 and 9 >> d# 1980 + ( day month year ) ; -: next-header-ok? ( id -- flag ) - +file u>d seek drop zip-magic 2 read ( len ) - zip-magic swap " PK" $= -; - - : set-prefix ( adr len -- ) to prefix-len path-prefix prefix-len move @@ -312,6 +300,9 @@ find-file 0= if true exit then link-target ; + +\ Find the link target for the current directory entry and +\ if it is relative, prefix it with the current entry's path : chase-link ( -- true | name$ false ) zip-name$ [char] / right-split-string set-prefix link-target if true exit then ( link$ ) @@ -336,8 +327,6 @@ repeat ( ) false ( false ) ; - - : final-component ( -- flag ) dir? if ( ) zip-name$ set-prefix true ( true ) @@ -352,6 +341,17 @@ false ( false ) then ( flag ) ; +\ Determine if the current path name matches the path prefix +: in-directory? ( -- flag ) + prefix-len 0= if true exit then \ No prefix - return true + + \ If the path name is shorter than the prefix, it doesn't match + \ The = in <= filters out the name of the directory itself + name-len prefix-len <= if false exit then + + zip-name prefix$ comp 0= +; + external : open ( -- flag ) -1 to image-size 0 to offset @@ -367,17 +367,6 @@ ; : close ( -- ) ; -\ Determine if the current path name matches the path prefix -: in-directory? ( -- flag ) - prefix-len 0= if true exit then \ No prefix - return true - - \ If the path name is shorter than the prefix, it doesn't match - \ The = in <= filters out the name of the directory itself - name-len prefix-len <= if false exit then - - zip-name prefix$ comp 0= -; - : next-file-info ( id -- false | id' s m h d m y len attributes name$ true ) begin another-file? while ( id' ) in-directory? if ( id ) [View Less]

1 0

r1520 - ofw/fs
by svn＠openfirmware.info 28 Nov '09

28 Nov '09

Author: wmb Date: 2009-11-29 01:00:54 +0100 (Sun, 29 Nov 2009) New Revision: 1520 Modified: ofw/fs/zipfs.fth Log: Improvements in zip-file-system package to handle symlinks, subdirectories, and Unix attributes. Modified: ofw/fs/zipfs.fth =================================================================== --- ofw/fs/zipfs.fth 2009-11-27 19:44:37 UTC (rev 1519) +++ ofw/fs/zipfs.fth 2009-11-29 00:00:54 UTC (rev 1520) @@ -23,7 +23,6 @@ loop ; -headers external : seek ( d.offset -- … [View More]status ) 0<> over image-size u> or if drop true exit then \ Seek offset too big @@ -37,104 +36,186 @@ update-ptr ( len' ) ; +headers +4 buffer: zip-magic -d# 42 constant /central \ Size of central header +d# 64 instance buffer: zip-buffer \ the largest zip header is 52 bytes -4 buffer: zip-magic - -/central instance buffer: zip-buffer d# 512 instance buffer: zip-name +0 instance value name-len +: zip-name$ ( -- adr len ) zip-name name-len ; -0 value name-len +d# 512 instance buffer: path-prefix +0 instance value prefix-len +: prefix$ ( -- adr len ) path-prefix prefix-len ; : zfield \ name ( offset -- offset' ) create over , + does> @ zip-buffer + ; struct - /w zfield zip-version - /w zfield zip-flag - /w zfield zip-how - /w zfield zip-time - /w zfield zip-date - /l zfield zip-crc - /l zfield zip-size \ Compressed size - /l zfield zip-len \ Uncompressed size - /w zfield zip-namelen - /w zfield zip-extlen + /w zfield ch-madeby \ Creator ID (UNIX, DOS, etc) + /w zfield ch-extract \ Version needed for extraction + /w zfield ch-bits \ General purpose flags + /w zfield ch-compr \ Compression type + /w zfield ch-time \ Modification time + /w zfield ch-date \ Modification date + /l zfield ch-crc \ CRC-32 + /l zfield ch-size \ Compressed size + /l zfield ch-len \ Uncompressed size + /w zfield ch-namelen \ Name length + /w zfield ch-extlen \ Extra length + /w zfield ch-comlen \ Comment length + /w zfield ch-diskno \ Disk number + /w zfield ch-iattrs \ Internal attributes (e.g. text vs. binary) + /l zfield ch-eattrs \ External attributes (OS-specific permissions) + /l zfield ch-hdroff \ Offset to corresponding header in files section +constant /central \ Size of central header + +struct + /w zfield eh-diskno \ This disk number + /w zfield eh-chdisk \ Disk number of central header + /w zfield eh-cdnum \ Number of central directory entries on this disk + /w zfield eh-cdtot \ Total number of central directory entries + /l zfield eh-cdsize \ Central directory size + /l zfield eh-cdoff \ Offset to central directory + /w zfield eh-comlen \ Comment length +constant /end-header \ Size of central header + +struct + /w zfield fh-version + /w zfield fh-flag + /w zfield fh-how + /w zfield fh-time + /w zfield fh-date + /l zfield fh-crc + /l zfield fh-size \ Compressed size + /l zfield fh-len \ Uncompressed size + /w zfield fh-namelen + /w zfield fh-extlen constant /local-header : ?crc ( adr len -- ) $crc ( crc ) - zip-crc le-l@ <> if ." Zip file CRC mismatch" cr abort then + fh-crc le-l@ <> if ." Zip file CRC mismatch" cr abort then ; \ ID of the header that's currently in the buffer -1 instance value header-id : load ( adr -- len ) - 0 0 seek drop + 0. seek drop dup image-size read ( adr len ) tuck ?crc ( len ) ; : read-magic ( id -- adr ) -1 to header-id ( id ) - 4 - 0 seek drop ( id ) + u>d seek drop ( id ) zip-magic 4 read drop ( ) zip-magic ( adr ) ; -: get-header? ( id -- false | id true ) - dup header-id = if false exit then ( id ) - dup read-magic " PK"(0304)" comp if ( id ) - drop false exit ( false ) +: file-header? ( id -- id flag ) dup read-magic " PK"(0304)" comp 0= ; +: read-file-header ( -- ) + zip-buffer /local-header read drop ( id ) + fh-namelen le-w@ to name-len ( id ) + zip-name$ read drop ( id ) +; +: get-file-header? ( id -- id flag ) + dup header-id = if true exit then ( id ) + file-header? if ( id ) + dup to header-id ( id ) + read-file-header ( id ) + true ( id true ) + else ( id ) + false ( false ) then ( id ) - zip-buffer /local-header read drop ( id ) - dup to header-id ( id ) - zip-namelen le-w@ to name-len ( id ) - zip-name name-len read drop ( id ) - true ( id true ) ; -: first-header ( -- false | id true ) +: dir-header? ( id -- id flag ) dup read-magic " PK"(0102)" comp 0= ; +: read-dir-header ( -- ) + zip-buffer /central read drop ( id ) + ch-namelen le-w@ to name-len ( id ) + zip-name$ read drop ( id ) +; + +: get-dir-header? ( id -- false | id true ) + dup header-id = if true exit then ( id ) + dir-header? if ( id ) + dup to header-id ( id ) + read-dir-header ( id ) + true ( id true ) + else ( id ) + drop false ( false ) + then ( false | id true ) +; +: end-header? ( id -- flag ) read-magic " PK"(0506)" comp 0= ; +: read-end-header ( -- ) zip-buffer /end-header read drop ; + +: first-file-header ( -- false | id true ) d# 2000 4 do - i get-header? if true unloop exit then ( ) + i get-file-header? if true unloop exit else drop then ( ) loop 0 ; -: +extras ( id -- id' ) - zip-namelen le-w@ + ( id+ ) \ Skip the old name - zip-extlen le-w@ + ( id' ) \ Skip the old extra field +: +local ( id -- id' ) + 4 + /local-header + ( id+ ) \ Skip fixed length stuff + fh-namelen le-w@ + ( id+ ) \ Skip the old name + fh-extlen le-w@ + ( id' ) \ Skip the old extra field ; -: +local ( id -- id' ) /local-header + +extras ; -: +file ( id -- id' ) +local zip-size le-l@ + 4 + ; -: +central+end ( id -- id' ) - dup read-magic - zip-buffer " PK"(01 02)" comp if exit then ( id ) - begin ( id ) - zip-buffer /central read drop ( id ) - zip-buffer " PK"(0506)" comp ( id flag ) - while ( id ) - /central + ( id' ) \ Skip fixed-length stuff - zip-buffer d# 24 + le-w@ + ( id' ) \ Skip file name - zip-buffer d# 26 + le-w@ + ( id' ) \ Skip extras - repeat ( id ) +: +file ( id -- id' ) +local fh-size le-l@ + ; + +: +dirent ( id -- id' ) + 4 + /central + ( id' ) \ Skip fixed-length stuff + ch-namelen le-w@ + ( id' ) \ Skip file name + ch-extlen le-w@ + ( id' ) \ Skip extras +; +: +end-header \ Now ID is the offset of the END header signature, which is in the \ buffer along with that header - 4 + d# 18 + ( id' ) \ Skip signature and end hdr - zip-buffer d# 18 + le-w@ + ( id' ) \ Skip comment + 4 + /end-header + ( id' ) + eh-comlen le-w@ + ( id' ) \ Skip comment ; - +: dirent? ( id -- id flag ) + dup header-id = if false exit then ( id ) + dup read-magic ( id ) + zip-buffer " PK"(01 02)" comp if ( id ) + false exit + then + zip-buffer /central read drop ( id ) +; +: first-dir-header ( -- false | id true ) + first-file-header 0= if false exit then + + begin file-header? while ( id ) + read-file-header +file ( id' ) + repeat ( id ) + + get-dir-header? ( false | id true ) +; + +: +central+end ( id -- id' ) + begin dir-header? while ( id ) + read-dir-header +dirent ( id' ) + repeat ( id ) + + end-header? if ( id ) + read-end-header +end-header ( id' ) + then +; + : another-file? ( id -- false | id' true ) - ?dup if ( id ) \ Not the first call - get-header? drop ( id ) \ Get the old header into the buffer - +file ( id ) \ Skip the old header - get-header? ( false | id' true ) \ Get the new header - else ( ) - first-header ( false | id' true ) - then ( false | id' true ) + ?dup if ( id ) \ Not the first call + get-dir-header? 0= if ( ) + false exit + then ( id ) \ Get the old header into the buffer + +dirent ( id' ) \ Skip the old header + get-dir-header? ( false | id true ) \ Get the new header + else ( ) + first-dir-header ( false | id' true ) + then ( false | id' true ) ; headerless @@ -152,28 +233,126 @@ ; : next-header-ok? ( id -- flag ) - +file 4 - 0 seek drop zip-magic 2 read ( len ) + +file u>d seek drop zip-magic 2 read ( len ) zip-magic swap " PK" $= ; -: find-file ( name$ -- false | file-id file-len true ) + + +: set-prefix ( adr len -- ) + to prefix-len + path-prefix prefix-len move +; + +\ When found, zip-buffer contains the central directory header +: find-file ( name$ -- found? ) 0 ( name$ id ) begin another-file? while ( name$ id ) 2 pick 2 pick ( name$ id name$ ) - zip-name name-len $= if ( name$ id ) - nip nip ( id ) - dup next-header-ok? if ( id ) - zip-size le-l@ true ( id len true ) - else ( id ) - ." Missing signature in Zip archive" cr ( id ) - drop false ( false ) - then ( false | file-id file-len true ) + zip-name$ $= if ( name$ id ) + 3drop true ( true ) exit then ( name$ id ) repeat ( name$ ) - 2drop false + 2drop false ( false ) ; -headers +\ Called after find-file has located the directory information for a file. +\ Adjusts offset and image-size so subsequent seeks and reads +\ apply only to that file's data. +: select-file-data ( -- okay? ) + ch-hdroff le-l@ get-file-header? if ( file-header-id ) + +local to offset ( ) + fh-size le-l@ to image-size ( ) + 0. seek drop ( ) + true ( true ) + else ( ) + false ( false ) + then ( flag ) +; + +\ Convert DOS file attributes to the firmware encoding +\ see showdir.fth for a description of the firmware encoding +: >canonical-attrs ( dos-attrs -- canon-attrs ) + >r + \ Access permissions + r@ 1 and if o# 666 else o# 777 then \ rwxrwxrwx + + \ Bits that are independent of one another + r@ 2 and if h# 10000 or then \ hidden + r@ 4 and if h# 20000 or then \ system + r@ h# 20 and if h# 40000 or then \ archive + + \ Mutually-exclusive file types + r@ 8 and if h# 3000 or then \ Volume label + r> h# 10 and if h# 4000 or then \ Subdirectory + dup h# f000 and 0= if h# 8000 or then \ Ordinary file +; + +: zip-attrs ( -- attributes ) + ch-madeby le-w@ h# ff00 and case ( ) + h# 0300 of ch-eattrs le-l@ d# 16 rshift endof ( attributes ) \ Unix permissions + h# 0000 of ch-eattrs le-w@ >canonical-attrs endof ( attributes' ) \ DOS + ( default ) o# 100444 swap ( attributes' selector ) + endcase +; +: dir? ( -- flag ) zip-attrs h# f000 and h# 4000 = ; +: symlink? ( -- flag ) zip-attrs h# f000 and h# a000 = ; + +: link-target ( -- true | link$ false ) + ch-hdroff le-l@ get-file-header? if ( file-header-id ) + +local u>d seek drop ( ) + fh-size le-l@ to name-len ( ) + zip-name$ read ( actual-len ) + zip-name swap false ( link$ false) + else ( ) + true ( true ) + then ( true | link$ false ) +; +: $readlink ( name$ -- true | link$ false ) + find-file 0= if true exit then + link-target +; +: chase-link ( -- true | name$ false ) + zip-name$ [char] / right-split-string set-prefix + link-target if true exit then ( link$ ) + dup if ( link$ ) + over c@ [char] / <> if ( link$ ) + \ If the path is relative, append it to the prefix + \ XXX should handle .. + tuck prefix$ + swap move ( link-len ) + prefix-len + to prefix-len ( ) + prefix$ ( link$ ) + then + false + else + true + then +; + +: find-file-follow-links ( name$ -- found? ) + begin find-file while ( ) + symlink? 0= if true exit then ( ) + chase-link if false exit then ( name$ ) + repeat ( ) + false ( false ) +; + + +: final-component ( -- flag ) + dir? if ( ) + zip-name$ set-prefix true ( true ) + else ( ) + select-file-data ( flag ) + then ( flag ) +; +: resolve-path + find-file-follow-links if ( ) + final-component ( flag ) + else ( ) + false ( false ) + then ( flag ) +; +external : open ( -- flag ) -1 to image-size 0 to offset my-args fix-delims 2dup " /" $= if ( adr len ) @@ -181,40 +360,48 @@ true exit ( true ) else ( adr len ) over c@ [char] / = if 1 /string then ( adr' len' ) - find-file dup if ( file-id file-len true ) - -rot to image-size +local to offset ( true ) - 0. seek drop ( true ) - then ( flag ) + resolve-path ( flag ) exit ( flag ) then ( adr len ) 2drop false ( false ) ; : close ( -- ) ; +\ Determine if the current path name matches the path prefix +: in-directory? ( -- flag ) + prefix-len 0= if true exit then \ No prefix - return true + + \ If the path name is shorter than the prefix, it doesn't match + \ The = in <= filters out the name of the directory itself + name-len prefix-len <= if false exit then + + zip-name prefix$ comp 0= +; + : next-file-info ( id -- false | id' s m h d m y len attributes name$ true ) - another-file? if ( id ) - zip-time le-w@ >hms ( id s m h ) - zip-date le-w@ >dmy ( id s m h d m y ) - zip-len le-l@ ( id s m h d m y size ) -\ di-expansion be-l@ ( id s m h d m y size ) -\ ?dup 0= if di-size be-l@ then ( id s m h d m y size ) - o# 100444 ( id s m h d m y size attributes ) - zip-name name-len ( id s m h d m y size attr name$ ) - true ( id s m h d m y size attr name$ true ) - else ( ) - false ( false ) - then + begin another-file? while ( id' ) + in-directory? if ( id ) + ch-time le-w@ >hms ( id s m h ) + ch-date le-w@ >dmy ( id s m h d m y ) + ch-len le-l@ ( id s m h d m y size ) + \ di-expansion be-l@ ( id s m h d m y size ) + \ ?dup 0= if di-size be-l@ then ( id s m h d m y size ) + zip-attrs ( id s m h d m y size attributes ) + zip-name$ ( id s m h d m y size attr name$ ) + prefix-len /string ( id s m h d m y size attr name$' ) + true ( id s m h d m y size attr name$ true ) + exit + then ( id ) + repeat ( ) + false ( false ) ; : free-bytes ( -- d.#bytes ) - 0 ( "first"-id ) - begin dup another-file? while ( prev-id new-id ) - nip ( id ) - repeat ( prev-id ) - +file ( central-id ) + first-dir-header 0= if 0. exit then ( id ) +central+end ( end-offset ) - " size" $call-parent rot 0 d- ( d.#bytes ) + " size" $call-parent rot u>d d- ( d.#bytes ) ; + \ LICENSE_BEGIN \ Copyright (c) 2006 FirmWorks \ [View Less]

1 0

r1519 - cpu/x86/pc/olpc/via
by svn＠openfirmware.info 27 Nov '09

27 Nov '09

Author: wmb Date: 2009-11-27 20:44:37 +0100 (Fri, 27 Nov 2009) New Revision: 1519 Modified: cpu/x86/pc/olpc/via/dsdt.dsl Log: OLPC trac 9423 - improve support for EC and LID in dsdt.dsl . Modified: cpu/x86/pc/olpc/via/dsdt.dsl =================================================================== --- cpu/x86/pc/olpc/via/dsdt.dsl 2009-11-26 01:20:04 UTC (rev 1518) +++ cpu/x86/pc/olpc/via/dsdt.dsl 2009-11-27 19:44:37 UTC (rev 1519) @@ -35,9 +35,6 @@ // set to 1 to enable debug output Name (… [View More]

1 0

r1518 - dev/usb2/hcd/ehci
by svn＠openfirmware.info 25 Nov '09

25 Nov '09

Author: wmb Date: 2009-11-26 02:20:04 +0100 (Thu, 26 Nov 2009) New Revision: 1518 Modified: dev/usb2/hcd/ehci/qhtd.fth Log: OLPC trac 9423 - EHCI transfer completion - instead of checking the active bit in the transfer overlay, check it in the qtd, after verifying that the queue head has updated the current qtd pointer. This eliminates a race condition with the CPU looking at the transfer overlay before the EHCI host controller has performed the overlay. Modified: dev/usb2/hcd/ehci/qhtd.… [View More]

1 0

2025

2024

2023

2022

2021

2020

2019

2018

2017

2016

2015

2014

2013

2012

2011

2010

2009

2008

openfirmware November 2009