[openfirmware] r1586 - cpu/x86/pc/olpc/via

svn at openfirmware.info svn at openfirmware.info
Sat Dec 12 03:49:14 CET 2009


Author: wmb
Date: 2009-12-12 03:49:14 +0100 (Sat, 12 Dec 2009)
New Revision: 1586

Modified:
   cpu/x86/pc/olpc/via/assy.fth
   cpu/x86/pc/olpc/via/runin.fth
   cpu/x86/pc/olpc/via/smt.fth
Log:
OLPC manufacturing test scripts - checkpoint.


Modified: cpu/x86/pc/olpc/via/assy.fth
===================================================================
--- cpu/x86/pc/olpc/via/assy.fth	2009-12-11 22:49:18 UTC (rev 1585)
+++ cpu/x86/pc/olpc/via/assy.fth	2009-12-12 02:49:14 UTC (rev 1586)
@@ -40,13 +40,21 @@
    then
 ;
 
-: put-tag  ( value$ key$ -- )
+: special-tag?  ( value$ key$ -- true | value$ key$ false )
    2dup " KA" $=  if                      ( value$ key$ )
-      put-ka-tag  exit
+      put-ka-tag  true  exit
    then                                   ( value$ key$ )
+   false
+;
+
+: put-ascii-tag  ( value$ name$ -- )
    2swap  dup  if  add-null  then  2swap  ( value$' key$ )
    ($add-tag)                             ( )
 ;
+: put-tag  ( value$ key$ -- )
+   special-tag?  if  exit  then           ( value$ key$ )
+   put-ascii-tag
+;
 
 : .instructions  ( adr len -- )
    cr blue-letters  type  black-letters  cr
@@ -192,9 +200,13 @@
 
 : inject-tags  ( -- )
    flash-write-enable
-   clear-mfg-buf
+   get-mfg-data
 
-   " "          " ww"  put-tag
+   " TS"  ($delete-tag)
+   " MS"  ($delete-tag)
+   " BD"  ($delete-tag)
+   " NT"  ($delete-tag)
+
    sn$          " SN"  put-tag
    fwver$       " BV"  put-tag
    swid$        " T#"  put-tag
@@ -202,12 +214,12 @@
    mac$         " WM"  put-tag
    swdl-date$   " SD"  put-tag
 
-\  " EN"        " SS"  put-tag
-\  " NA"        " FQ"  put-tag
+   response$ parse-tags
 
-   response$ parse-tags
+   flash-write-enable
    (put-mfg-data)
-   flash-write-disable
+   no-kbc-reboot
+   kbc-on
 ;
 
 : make-assy-request  ( -- )

Modified: cpu/x86/pc/olpc/via/runin.fth
===================================================================
--- cpu/x86/pc/olpc/via/runin.fth	2009-12-11 22:49:18 UTC (rev 1585)
+++ cpu/x86/pc/olpc/via/runin.fth	2009-12-12 02:49:14 UTC (rev 1586)
@@ -2,6 +2,16 @@
 
 visible
 
+\ Location of the files containing KA tag data
+: ka-dir$  ( -- adr len )  " http:\\10.1.0.1\ka\"  ;
+
+: nocase-$=  ( $1 $2 -- flag )
+   rot tuck <>  if       ( adr1 adr2 len2 )
+      3drop false exit   ( -- false )
+   then                  ( adr1 adr2 len2 )
+   caps-comp 0=          ( flag )
+;
+
 \ The Linux-based runin selftests put this file at int:\runin\olpc.fth
 \ after they have finished.  On the next reboot, OFW thus boots this
 \ script instead of int:\boot\olpc.fth .  This script either displays
@@ -67,32 +77,110 @@
    d# 2000 ms
 ;
 
+: put-ascii-tag  ( value$ key$ -- )
+   2swap  dup  if  add-null  then  2swap  ( value$' key$ )
+   ($add-tag)                             ( )
+;
+: put-ka-tag  ( value$ key$ -- )
+   2over  8 min  ka-dir$ " %s%s" sprintf  ( value$ key$ filename$ )
+   $read-file  if                     ( value$ key$ )
+      ." ERROR: No KA tag file for " 2swap type cr  ( key$ )
+      2drop                           ( )
+   else                               ( value$ key$ file-data$ )
+      2swap ($add-tag)                ( value$ )
+      2drop                           ( )
+   then
+;
+
+false value write-protect?
+
+: special-tag?  ( value$ key$ -- true | value$ key$ false )
+   2dup " KA" $=  if                       ( value$ key$ )
+      put-ka-tag                           ( )
+      true  exit                           ( -- true )
+   then                                    ( value$ key$ )
+   2dup " WP" nocase-$=  if                ( value$ key$ )
+      2drop " 0" $=  0= to write-protect?  ( )
+      true exit                            ( -- true )
+   then                                    ( value$ key$ )
+   2dup " ak" nocase-$=  if                ( value$ key$ )
+      2drop " 0" $=  0=  if                ( )
+         " "  " ak"  ($add-tag)            ( )
+      then                                 ( )
+      true exit                            ( -- true )
+   then                                    ( value$ key$ )
+   false                                   ( value$ key$ false )
+;
+: put-tag  ( value$ key$ -- )
+   special-tag?  if  exit  then
+   put-ascii-tag
+;
+: show-tag  ( value$ -- )
+   tag-printable?  if  ?-null type  else  wrapped-cdump  then
+;
+: handle-tag  ( value$ key$ -- )
+   2dup find-tag  if  ( value$ key$ old-value$ )       \ Tag already exists, check it
+      2over " KA" $=  0=  if  ?-null  then   ( value$ key$ old-value$' )
+      2>r 2over 2r@ $=  if                   ( value$ key$ r: old-value$' )
+         2drop 2drop r> 2drop                ( )
+      else                                   ( value$ key$ r: old-value$' )
+         type ." tag changed!" cr            ( value$ r: old-value$' )
+         ."   Old: " r> show-tag cr          ( value$ )
+         ."   New: " show-tag cr             ( )
+      then
+   else                                      ( value$ key$ )   \ New tag, add it
+      put-tag
+   then
+;
+
 : parse-tags  ( adr len -- )
    begin  dup  while              ( adr len )
       linefeed left-parse-string  ( rem$ line$ )
       ?remove-cr                  ( rem$ line$ )
       [char] : left-parse-string  ( rem$ value$ key$ )
       dup 2 =  if                 ( rem$ value$ key$ )
-         put-tag                  ( rem$ )
+         handle-tag               ( rem$ )
       else                        ( rem$ value$ key$ )
          4drop                    ( rem$ )
       then                        ( rem$ )
    repeat                         ( adr len )
    2drop                          ( )
 ;
-
+: format-date  ( s m h d m y -- adr len )
+   push-decimal
+   >r >r >r >r >r >r
+   <#
+   [char] Z hold
+   r> u# u# drop
+   r> u# u# drop
+   r> u# u# drop
+   [char] T hold
+   r> u# u# drop
+   r> u# u# drop
+   r> u# u# u# u#
+   u#>
+   pop-base
+;
+: make-md-tag  ( -- )
+   ntp>time&date  ( s m h d m y )  format-date  " MD" put-ascii-tag
+;
 : inject-tags  ( -- )
    get-mfg-data
 
    " TS" ($delete-tag)
    " MS" ($delete-tag)
    " BD" ($delete-tag)
-
+   make-md-tag
    " SHIP"  " TS" ($add-tag)
 
    response$ parse-tags
 
-   put-mfg-data
+   flash-write-enable
+   (put-mfg-data)
+   \ Change "ww" to "wp" if we want security to be enabled
+   write-protect?  if  " wp"  h# efffe  write-spi-flash  then
+   no-kbc-reboot
+   kbc-on
 ;
 
 : mfg-ntp-server  ( -- name$ )
@@ -102,6 +190,7 @@
 
 d# 4 constant rtc-threshold
 : verify-rtc-date  ( -- )
+\ XXX check RTC power lost bit
    ." Getting time from NTP server "
    begin  ntp-timestamp  while  ." Retry "  repeat  ( d.timestamp )
    cr
@@ -121,6 +210,50 @@
    then
 ;
 
+: put-key:value  ( value$ key$ -- )  " %s:%s" sprint put-key-line  ;
+
+: upload-tag  ( data$ tag$ -- )
+   2dup " wp" $=  if                       ( data$ tag$ )
+      4drop  " 1" " WP" put-key:value      ( )
+      exit
+   then
+   2dup " ww" $=  if                       ( data$ tag$ )
+      4drop  " 0" " WP" put-key:value      ( )
+      exit
+   then
+   2dup " ak" $=  if                       ( data$ tag$ )
+      4drop  " 1" " ak" put-key:value      ( )
+      exit
+   then
+   2dup " KA" $=  if                       ( data$ tag$ )
+      4drop                                ( )
+      exit
+   then
+   2dup " SG" $=  if                       ( data$ tag$ )
+      4drop                                ( )
+      exit
+   then                                    ( data$ tag$ )
+
+   put-key:value                           ( )
+;
+
+: upload-tags  ( -- )
+   mfg-data-top                 ( adr )
+   begin  another-tag?  while   ( adr' data$ tname-adr )
+      2 upload-tag              ( adr )
+   repeat                       ( adr )
+   drop
+;
+
+
+\ Upload the result data 
+: final-result  ( -- )
+   smt-filename$  open-temp-file
+   upload-tags
+   test-passed?  if  " PASS"  else  " FAIL"  then  " RESULT="  put-key+value
+   " Result" submit-file
+;
+
 : finish-final-test  ( -- )
    show-result-screen
 
@@ -136,12 +269,17 @@
 
    verify-rtc-date
 
-   cifs-connect
-   ." Connecting to server "  final-tag-exchange  ." Done" cr
-   cifs-disconnect
+   ." Getting final tags .. "
+   cifs-connect final-tag-exchange cifs-disconnect
+   ." Done" cr
 
    inject-tags
 
+   cifs-connect final-result cifs-disconnect
+   \ " int:\runin\olpc.fth" $delete-all
+
+   " int:\runin\olpc.fth" " int:\runin\final.fth" $rename
+
    ." Powering off ..." d# 2000 ms
    power-off
 ;
@@ -206,6 +344,13 @@
 
 : fail-log-file$  ( -- name$ )  " int:\runin\fail.log"   ;
 
+\ The operator can type this to reset the state to run
+\ the Linux-based runin tests again.
+: rerunin  ( -- )
+   " int:\runin\olpc.fth" $delete-all
+   " int:\runin\fail.log" $delete-all
+;
+
 : after-runin  ( -- )
    fail-log-file$ $read-file  0=  if  ( adr len )
       page
@@ -214,11 +359,13 @@
       key drop  cr cr
       list
    else
+      
 \     set-tags-for-fqa
-\      " int:\runin\olpc.fth" $delete-all
 
       " patch final-tests play-item mfgtest-menu" evaluate
+      true to diag-switch?
       menu
+      false to diag-switch?
       \ Shouldn't get here because the menu never exits
    then
 
@@ -229,6 +376,8 @@
 
 after-runin
 
+0 [if]
+
 SN:SHC946009D3
 B#:QTFJCA94400297
 P#:1CL11ZU0KDU
@@ -244,11 +393,11 @@
 BV:Q2E34
 U#:A4112195-98FE-419A-A77B-9F33C08FF913
 SD:241109
-IM_IP:10.1.0.2
-IM_ROOT:CL1XL00802000
-IM_NAME:CL1XL00802000
+  IM_IP:10.1.0.2
+  IM_ROOT:CL1XL00802000
+  IM_NAME:CL1XL00802000
 WP:0
-Countries:Alabama
+  Countries:Alabama
 LO:en_US.UTF-8
 KA:USInternational_Keyboard
 KM:olpc
@@ -276,29 +425,33 @@
 Send the following information to shop flow
 
 SN:
+B#:
+P#:
 M#:
-U#:
-P#:
-B#:
 LA:
 CC:
 F#:
 L#:
 S#:
 T#:
+WM:
+MN:
 BV:
-TS:
-SS:
-FQ:
+U#:
 SD:
-WM:
-MN:
+WP:
+LO:
+  KA
+KM:
 KL:
 KV:
-KM:
-LO:
-WP:
+  ak
+  sk
+  SG
+  DT
+     TS:  test station
+     SS:  smt status
+     FQ:  ??
+
 RESULT:PASS
-
- 
-
+[then]

Modified: cpu/x86/pc/olpc/via/smt.fth
===================================================================
--- cpu/x86/pc/olpc/via/smt.fth	2009-12-11 22:49:18 UTC (rev 1585)
+++ cpu/x86/pc/olpc/via/smt.fth	2009-12-12 02:49:14 UTC (rev 1586)
@@ -125,10 +125,12 @@
    get-opid
 ;
 
+0 value test-passed?
+
 \ Upload the result data 
-: smt-result  ( pass? -- )
+: smt-result  ( -- )
    smt-filename$  open-temp-file
-   if  " PASS"  else  " FAIL"  then  " RESULT="  put-key+value
+   test-passed?  if  " PASS"  else  " FAIL"  then  " RESULT="  put-key+value
    " PROCESS=FVT" put-key-line
    " STATION="    put-key-line
    " OPID="       put-key-line
@@ -149,11 +151,6 @@
 
 : clear-mfg-buf  ( -- )  mfg-data-buf  /flash-block  h# ff fill  ;
 
-: put-ascii-tag  ( value$ key$ -- )
-   2swap  dup  if  add-null  then  2swap  ( value$' key$ )
-   ($add-tag)                             ( )
-;
-
 \ Remove possible trailing carriage return from the line
 : ?remove-cr  ( adr len -- adr len' )
    dup  if                        ( adr len )
@@ -163,11 +160,29 @@
    then
 ;
 
-: put-tag  ( value$ key$ -- )
+: put-ascii-tag  ( value$ key$ -- )
    2swap  dup  if  add-null  then  2swap  ( value$' key$ )
    ($add-tag)                             ( )
 ;
 
+1 buffer: sg-buf
+: special-tag?  ( value$ key$ -- true | value$ key$ false )
+   2dup " SG" $=  if                            ( value$ key$ )
+      2swap                                     ( key$ value$ )
+      over " 0x" comp  0=  if  2 /string  then  ( key$ value$' )
+      push-hex $number pop-base  abort" Invalid tag value: SG tag value is not a hex number"  ( key$ n )
+      dup  h# ff u>  abort" Invalid tag value: SG tag value will not fit in one byte"         ( key$ n )
+      sg-buf c!  sg-buf 1  2swap  ($add-tag)    ( )
+      true  exit
+   then                                         ( value$ key$ )
+   false
+;
+
+: put-tag  ( value$ key$ -- )
+   special-tag?  if  exit  then
+   put-ascii-tag
+;
+
 0 0 2value response$
 
 false value any-tags?
@@ -195,21 +210,22 @@
 
    response$ nip 0=  if  ." Null manufacturing data" cr  exit  then
 
-   flash-write-enable
+   clear-mfg-buf                          ( )
+   " "      " ww"  ($add-tag)             ( )
 
-   clear-mfg-buf                          ( )
    response$ write-new-tags               ( )
-\   " "      " ww"  put-ascii-tag         ( )
+
+\   board#$  " B#"  put-ascii-tag         ( )
 \   " EN"    " SS"  put-ascii-tag         ( )
 \   " ASSY"  " TS"  put-ascii-tag         ( )
-\   " D3"    " SG"  put-ascii-tag         ( )
-\   board#$  " B#"  put-ascii-tag         ( )
-   any-tags?  if  (put-mfg-data)  then
+\   " "(D3)" " SG"  ($add-tag)            ( )
 
-   \ check-tags
-
-   no-kbc-reboot
-   kbc-on
+   any-tags?  if
+      flash-write-enable
+      (put-mfg-data)
+      no-kbc-reboot
+      kbc-on
+   then
 ;
 
 : silent-probe-usb  ( -- )
@@ -260,7 +276,6 @@
    wait-usb-key
 ;             
 
-0 value test-passed?
 : show-result-screen  ( -- )
    restore-scroller
    clear-screen
@@ -277,9 +292,9 @@
 : finish-smt-test  ( pass? -- )
    show-result-screen
 
-   cifs-connect
-   ." Sending test result "  test-passed? smt-result  ." Done" cr
-   cifs-disconnect
+   ." Sending test result "
+   cifs-connect  smt-result  cifs-disconnect
+   ." Done" cr
 
    test-passed?  if
       ." Writing tags "  parse-smt-response  ." Done" cr
@@ -322,9 +337,11 @@
 
    get-info
 
-   ." Connecting to shop floor server "  cifs-connect ." Done" cr
-   ." Getting tags "  smt-request$  to response$  ." Done" cr
+   ." Getting SMT tags .. "
+   ." Connecting .. "  cifs-connect ." Connected .. "
+   smt-request$  to response$
    cifs-disconnect
+  ." Done" cr
 
    true to diag-switch?
    " patch smt-tests play-item mfgtest-menu" evaluate




More information about the openfirmware mailing list