[OpenBIOS] r608 - cpu/x86/pc/olpc

svn at openbios.org svn at openbios.org
Tue Sep 18 01:15:36 CEST 2007


Author: wmb
Date: 2007-09-18 01:15:36 +0200 (Tue, 18 Sep 2007)
New Revision: 608

Modified:
   cpu/x86/pc/olpc/copynand.fth
   cpu/x86/pc/olpc/nandstat.fth
Log:
save-nand now creates a .crc file .
New "scan-nand" command.




Modified: cpu/x86/pc/olpc/copynand.fth
===================================================================
--- cpu/x86/pc/olpc/copynand.fth	2007-09-17 23:09:19 UTC (rev 607)
+++ cpu/x86/pc/olpc/copynand.fth	2007-09-17 23:15:36 UTC (rev 608)
@@ -15,12 +15,16 @@
 
 0 value crc-buf
 
-: >crc  ( index -- crc )  crc-buf swap la+ l@  ;
 
+: >crc  ( index -- 'crc )  crc-buf swap la+  ;
+
 : $call-nand  ( ?? method$ -- ?? )  nandih $call-method  ;
 
+: close-image-file  ( -- )
+   fileih  ?dup  if  0 to fileih  close-dev  then
+;
 : close-nand-ihs  ( -- )
-   fileih  ?dup  if  0 to fileih  close-dev  0 to #image-eblocks  then
+   close-image-file
    nandih  ?dup  if  0 to nandih  close-dev  0 to #nand-pages     then
    crc-ih  ?dup  if  0 to crc-ih  close-dev  then
    #crc-records  if
@@ -118,7 +122,7 @@
 ;
 
 : check-mem-crc  ( record# -- )
-   >crc                                                 ( crc )
+   >crc l@                                              ( crc )
    load-base /nand-block  $crc                          ( crc actual-crc )
    2dup <>  if
       cr ." CRC miscompare - expected " swap . ." got " . cr
@@ -133,6 +137,9 @@
    #crc-records  if  check-mem-crc  else  drop  then
 ;
 
+defer show-init  ( #eblocks -- )
+' drop to show-init
+
 defer show-erasing  ( #blocks -- )
 : (show-erasing)  ( #blocks -- )  ." Erasing " . ." blocks" cr  ;
 ' (show-erasing) to show-erasing
@@ -151,17 +158,26 @@
 ' drop to show-clean
 
 defer show-cleaning  ( -- )
-: (show-cleaning)  ( -- )  cr ." Cleanmarkers" cr  ;
+: (show-cleaning)  ( -- )  cr ." Cleanmarkers"  ;
 ' (show-cleaning) to show-cleaning
 
 defer show-writing  ( #blocks -- )
 : (show-writing)  ." Writing " . ." blocks" cr  ;
 ' (show-writing) to show-writing
 
+defer show-pending  ( block# -- )
+' drop to show-pending
+
 defer show-written
 : (show-written)  ( block# -- )  (cr .  ;
 ' (show-written) to show-written
 
+defer show-strange
+' drop to show-strange
+
+defer show-done
+' cr to show-done
+
 : copy-nand  ( "devspec" -- )
    open-nand
    get-img-filename
@@ -170,7 +186,9 @@
 
    ['] noop to show-progress
 
-   #nand-pages nand-pages/block / show-erasing
+   #nand-pages nand-pages/block /  dup  show-init  ( #eblocks )
+
+   show-erasing                                    ( )
    ['] show-bad  ['] show-erased  ['] show-bbt-block " (wipe)" $call-nand
 
    #image-eblocks show-writing
@@ -185,6 +203,7 @@
 
    show-cleaning
    ['] show-clean " put-cleanmarkers" $call-nand
+   show-done
 
    close-nand-ihs
 ;
@@ -243,7 +262,7 @@
 
       load-base " read-next-block" $call-nand              ( )
 
-      load-base /nand-block  $crc  i >crc                  ( actual-crc expected-crc )
+      load-base /nand-block  $crc  i >crc l@               ( actual-crc expected-crc )
       2dup <>  if                                          ( actual-crc expected-crc )
          cr ." CRC miscompare - expected " . ." got " .    ( )
          ." in NAND block starting at page "
@@ -264,44 +283,101 @@
 ;
 
 true value dump-oob?
-: (dump-nand)  ( "devspec" -- )
-   open-nand
-   safe-parse-word   ( name$ )
+: make-new-file  ( devspec$ -- fileih )
+   2dup ['] $delete  catch  if  2drop  then  ( name$ )
+   2dup ['] $create-file  catch  if          ( name$ x x )
+      2drop                                  ( name$ )
+      " Can't open a file.  Try using the raw disk?" confirm  if  ( name$ )
+         open-dev                            ( ih )
+      else                                   ( name$ )
+         2drop 0                             ( ih=0 )
+      then                                   ( ih )
+   else                                      ( name$ ih )
+      nip nip                                ( ih )
+   then                                      ( ih )
+;
 
-   cr ." Dumping to " 2dup type  cr
+: alloc-crc-buf  ( -- )
+   #nand-pages nand-pages/block / to #crc-records
+   #crc-records /l* alloc-mem to crc-buf
+;
 
-   2dup ['] $delete  catch  if  2drop  then  ( name$ )
-   2dup ['] $create-file  catch  if
-      2drop
-      " Can't open a file.  Try using the raw disk?" confirm  if
-         open-file
-      else
-         2drop 0
+: save-crcs  ( -- )
+   image-name$ crc-name-buf place
+   true
+   crc-name$ nip 4 >=  if
+      crc-name$ + 4 - c@  [char] .  =  if
+         " crc"  crc-name$ + 3 -  swap move
+         drop false
       then
-   then
-   to fileih
+   then                ( error? )
+   " Filename needs a 3-character extension"  ?nand-abort
+   crc-name$           ( name$ )
 
+   ." CRC file is " 2dup type  ( name$ )
+
+   make-new-file to crc-ih
+
+   crc-ih 0=  " Can't open CRC output file"  ?nand-abort
+
+   #image-eblocks 0  ?do
+      i >crc l@
+      push-hex  
+      <# newline hold u# u# u# u# u# u# u# u# u#>    ( adr len )
+      pop-base
+      " write" crc-ih $call-method 9 <>  " CRC write failed" ?nand-abort
+   loop
+
+;
+: open-dump-file  ( devspec$ -- )
+   cr ." Dumping to " 2dup type  cr
+
+   make-new-file  to fileih
+
    fileih 0=  " Can't open output"  ?nand-abort
+;
 
+: (dump-nand)  ( "devspec" -- )
+   open-nand
+   get-img-filename
+
+   dump-oob?  0=  if  alloc-crc-buf  then
+   image-name$ open-dump-file
+
+   0 to #image-eblocks
+
    \ The stack is empty at the end of each line unless otherwise noted
-   #nand-pages  0  do
-      (cr i .
+   dump-oob?  if  #nand-pages  else  " usable-page-limit" $call-nand  then
+   0  do
+      (cr i nand-pages/block / .
       load-base  i  nand-pages/block  " read-blocks" $call-nand
       nand-pages/block =  if
          load-base /nand-block  written?  if
-            load-base /nand-block  " write" fileih $call-method drop
+            ." w"
+            load-base /nand-block  " write" fileih $call-method
+            /nand-block  <>  " Write to dump file failed" ?nand-abort
             dump-oob?  if
                i  nand-pages/block  bounds  ?do
                   i " read-oob" $call-nand  h# 40  ( adr len )
                   " write" fileih $call-method drop
-                  i pad !  pad 4 " write" fileih $call-method drop
+                  h# 40 <>  " Write of OOB data failed" ?nand-abort
+                  i pad !  pad 4 " write" fileih $call-method
+                  4 <>  " Write of eblock number failed" ?nand-abort
                loop
+            else
+               load-base /nand-block $crc #image-eblocks >crc l!
             then
+            #image-eblocks 1+ to #image-eblocks
+         else
+            ." s"
          then
       then
    nand-pages/block +loop
    cr  ." Done" cr
 
+   close-image-file
+   save-crcs
+
    close-nand-ihs
 ;
 : dump-nand  ( "devspec" -- )  true  to dump-oob?  (dump-nand)  ;

Modified: cpu/x86/pc/olpc/nandstat.fth
===================================================================
--- cpu/x86/pc/olpc/nandstat.fth	2007-09-17 23:09:19 UTC (rev 607)
+++ cpu/x86/pc/olpc/nandstat.fth	2007-09-17 23:15:36 UTC (rev 608)
@@ -12,71 +12,250 @@
 9 constant grid-h
 
 d# 128 value #cols
+: xy+  ( x1 y1 x2 y2 -- x3 y3 )  rot + -rot  + swap  ;
 : xy*  ( x y w h -- x*w y*h )  rot *  >r  * r>  ;
 
+0 value nand-block-limit
+
+: do-fill  ( color x y w h -- )  " fill-rectangle" $call-screen  ;
+
 \ States:  0:erased  1:bad  2:waiting for write  3:written
 
-: >loc  ( eblock# -- )  #cols /mod  grid-w grid-h xy*  ulhc d+  ;
+: >loc  ( eblock# -- x y )  #cols /mod  grid-w grid-h xy*  ulhc xy+  ;
 
-: show-state  ( eblock# state -- )
-   swap >loc  glyph-w glyph-h  " fill-rectangle" $call-screen
-;
+: show-state  ( eblock# state -- )  swap >loc  glyph-w glyph-h  do-fill  ;
 
 dev screen  : erase-screen erase-screen ;  dend
 
-h# 80 h# 80 h# 80  rgb>565 constant bbt-color
-    0     0     0  rgb>565 constant erased-color
-h# ff     0     0  rgb>565 constant bad-color
-    0     0 h# ff  rgb>565 constant clean-color
-h# ff h# ff     0  rgb>565 constant writing-color
-    0 h# ff     0  rgb>565 constant written-color
-h# ff h# ff h# ff  rgb>565 constant starting-color
+h# 80 h# 80 h# 80  rgb>565 constant bbt-color      \ gray
+    0     0     0  rgb>565 constant erased-color   \ black
+h# ff     0     0  rgb>565 constant bad-color      \ red
+    0     0 h# ff  rgb>565 constant clean-color    \ blue
+h# ff h# ff     0  rgb>565 constant pending-color  \ yellow
+    0 h# ff     0  rgb>565 constant written-color  \ green
+    0 h# ff h# ff  rgb>565 constant strange-color  \ cyan
+h# ff h# ff h# ff  rgb>565 constant starting-color \ white
 
-: gshow-erasing ( #eblocks -- )
-   cursor-off  " erase-screen" $call-screen  0 status-line at-xy
-   ." Erasing  "
+: gshow-init  ( #eblocks -- )
+   #nand-pages nand-pages/block /  to nand-block-limit
 
+   cursor-off  " erase-screen" $call-screen
+
    " bbt0" $call-nand nand-pages/block /  bbt-color show-state
    " bbt1" $call-nand nand-pages/block /  bbt-color show-state
 
    starting-color   ( #eblocks color )
    swap 0  ?do  i over show-state  loop
    drop
+   0 status-line at-xy  
 ;
 
+: gshow-erasing ( #eblocks -- )   drop  ." Erasing  "  ;
+
 : gshow-erased    ( eblock# -- )  erased-color  show-state  ;
 : gshow-bad       ( eblock# -- )  bad-color     show-state  ;
 : gshow-bbt-block ( eblock# -- )  bbt-color     show-state  ;
 : gshow-clean     ( eblock# -- )  clean-color   show-state  ;
+: gshow-strange   ( eblock# -- )  strange-color show-state  ;
 
-: gshow-cleaning ( -- )  ." Cleanmarkers"  cr  cursor-on  ;
+: gshow-cleaning ( -- )  d# 26 status-line at-xy  ." Cleanmarkers"  cr  ;
+: gshow-done  ( -- )  cursor-on  ;
 
+: gshow-pending  ( eblock# -- )  pending-color  show-state  ;
+
 : gshow-writing  ( #eblocks -- )
    ." Writing  "
-   writing-color   ( #eblocks color )
-   0  rot 0  ?do           ( color eblock# )
-      dup nand-pages/block * " block-bad?" $call-nand  0=  if  ( color eblock# )
-         2dup swap show-state  ( color eblock# )
-         1                     ( color eblock# increment )
-      else                     ( color eblock# )
-         0                     ( color eblock# increment )
-      then                     ( color eblock# increment )
-      swap 1+ swap             ( color eblock#' increment )
-   +loop                       ( color eblock#' )
-   2drop
+   0  rot 0  ?do           ( eblock# )
+      dup nand-pages/block * " block-bad?" $call-nand  0=  if  ( eblock# )
+         dup show-pending      ( eblock# )
+         1                     ( eblock# increment )
+      else                     ( eblock# )
+         0                     ( eblock# increment )
+      then                     ( eblock# increment )
+      swap 1+ swap             ( eblock#' increment )
+   +loop                       ( eblock#' )
+   drop
 ;
 
-: gshow-written  ( eblock# -- )  written-color  show-state  ;
+: gshow-written  ( eblock# -- )
+   dup  written-color  show-state
+   d# 20 status-line at-xy   .x
+;
 
 : gshow
+   ['] gshow-init      to show-init
    ['] gshow-erasing   to show-erasing
    ['] gshow-erased    to show-erased
    ['] gshow-bad       to show-bad
    ['] gshow-bbt-block to show-bbt-block
    ['] gshow-clean     to show-clean
    ['] gshow-cleaning  to show-cleaning
+   ['] gshow-pending   to show-pending
    ['] gshow-writing   to show-writing
    ['] gshow-written   to show-written
+   ['] gshow-strange   to show-strange
+   ['] gshow-done      to show-done
 ;
 
 gshow
+
+\ 0 - marked bad block : show-bad
+\ 1 - unreadable block : show-bad
+\ 2 - jffs2 w/  summary: show-written
+\ 3 - jffs2 w/o summary: show-pending
+\ 4 - clean            : show-clean
+\ 5 - non-jffs2 data   : show-strange
+\ 6 - erased           : show-erased
+\ 7 - primary   bad-block-table  : show-bbt-block
+\ 8 - secondary bad-block-table  : show-bbt-block
+: show-status  ( status eblock# -- )
+   swap case
+      0  of  show-bad        endof
+      1  of  show-bad        endof
+      2  of  show-written    endof
+      3  of  show-pending    endof
+      4  of  show-clean      endof
+      5  of  show-strange    endof
+      6  of  show-erased     endof
+      7  of  show-bbt-block  endof
+      8  of  show-bbt-block  endof
+   endcase
+;
+
+0 value nand-map
+0 value working-page
+: classify-block  ( page# -- status )
+   to working-page
+
+   \ Check for block marked bad in bad-block table
+   working-page  " block-bad?" $call-nand  if  0 exit  then
+
+   \ Try to read the first few bytes
+   load-base 4  working-page  0  " pio-read" $call-nand
+
+   \ Check for a JFFS2 node at the beginning
+   load-base w@ h# 1985 =  if
+      \ Look for a summary node
+      load-base 4  working-page h# 3f +  h# 7fc  " pio-read" $call-nand
+      load-base " "(85 18 85 02)" comp  if  3  else  2  then
+      exit
+   then
+
+   \ Check for non-erased, non-JFFS2 data
+   load-base l@ h# ffff.ffff <>  if  5 exit  then
+
+   \ Check for various signatures in the OOB area
+   working-page " read-oob" $call-nand  d# 14 +  ( adr )
+
+   \ .. Cleanmarker
+   dup  " "(85 19 03 20 08 00 00 00)" comp  0=  if  drop 4 exit  then
+
+   \ .. Bad block tables
+\ These can't happen because the BBT table blocks are marked "bad"
+\ so they get filtered out at the top of this routine.
+\   dup  " Bbt0" comp  0=  if  drop 7 exit  then
+\   dup  " 1tbB" comp  0=  if  drop 8 exit  then
+   drop
+
+   \ See if the whole thing is really completely erased
+   load-base  working-page  nand-pages/block  ( adr block# #blocks )
+   " read-blocks" $call-nand  nand-pages/block  <>  if  1 exit  then
+
+   \ Not completely erased
+   load-base  load-base h# 100000 +  /nand-block  comp  if  5 exit  then
+
+   \ Erased
+   6
+;
+
+0 value current-block
+0 value examine-done?
+
+string-array status-descriptions
+   ," Marked bad in Bad Block Table"  \ 0
+   ," Read error"                     \ 1
+   ," JFFS2 data with summary"        \ 2
+   ," JFFS2 data, no summary"         \ 3
+   ," Clean (erased with JFFS2 cleanmarker)"  \ 4
+   ," Dirty, with non-JFFS2 data"     \ 5 
+   ," Erased, no cleanmarker"         \ 6
+   ," Primary Bad Block Table"        \ 7
+   ," Secondary Bad Block Table"      \ 8
+end-string-array
+
+: show-block-status  ( block# -- )
+   d# 20 status-line at-xy   
+   dup .x
+   nand-map + c@  status-descriptions count type  kill-line
+;
+
+: cell-border  ( block# color -- )
+   swap >loc      ( color x y )
+   -1 -1 xy+
+   3dup  grid-w 1   do-fill                    ( color x y )
+   3dup  grid-w 0 xy+  1 grid-h  do-fill  ( color x y )
+   3dup  0 1 xy+  1 grid-h do-fill            ( color x y )
+   1 grid-h xy+  grid-w 1  do-fill
+;
+: lowlight  ( block# -- )  h# ffff cell-border  ;
+: highlight  ( block# -- )  0 cell-border  ;
+: +block  ( offset -- )
+   current-block +   nand-block-limit mod  ( new-block )
+   current-block lowlight
+   to current-block
+   current-block highlight
+   current-block  show-block-status
+;
+
+: process-key  ( char -- )
+   case
+      h# 9b     of  endof
+      [char] A  of  #cols negate +block  endof  \ up
+      [char] B  of  #cols        +block  endof  \ down
+      [char] C  of  1            +block  endof  \ right
+      [char] D  of  -1           +block  endof  \ left
+      [char] ?  of  #cols 8 * negate +block  endof  \ page up
+      [char] /  of  #cols 8 *        +block  endof  \ page down
+      [char] K  of  8                +block  endof  \ page right
+      [char] H  of  -8               +block  endof  \ page left
+      h# 1b     of  d# 20 ms key?  0=  if  true to examine-done?  then  endof
+   endcase
+;
+
+: examine-nand  ( -- )
+   0 status-line 1+ at-xy  ." Arrows, fn Arrows to move, Esc to exit" cr
+   0 to current-block
+   current-block highlight
+   false to examine-done?
+   begin key  process-key  examine-done? until
+   current-block lowlight
+;
+
+
+: scan-nand  ( -- )
+   open-nand
+   nand-map 0=  if
+      #nand-pages nand-pages/block /  alloc-mem  to nand-map
+   then
+
+   \ Something to compare against
+   load-base h# 100000 +  /nand-block  h# ff  fill
+
+   " usable-page-limit" $call-nand   
+   dup  nand-pages/block /  show-init  ( page-limit )
+
+   7 " bbt0" $call-nand  nand-pages/block /  nand-map + c!
+   8 " bbt1" $call-nand  nand-pages/block /  nand-map + c!
+
+   0  ?do
+      i classify-block       ( status )
+      i nand-pages/block /   ( status eblock# )
+      2dup nand-map + c!     ( status eblock# )
+      show-status
+   nand-pages/block +loop  ( )
+
+   show-done
+   close-nand-ihs
+
+   examine-nand
+;




More information about the OpenBIOS mailing list