[openfirmware] r1590 - cpu/x86/pc/olpc/via ofw/gui

svn at openfirmware.info svn at openfirmware.info
Sun Dec 13 10:59:45 CET 2009


Author: wmb
Date: 2009-12-13 10:59:45 +0100 (Sun, 13 Dec 2009)
New Revision: 1590

Modified:
   cpu/x86/pc/olpc/via/assy.fth
   cpu/x86/pc/olpc/via/mfgtest.fth
   cpu/x86/pc/olpc/via/runin.fth
   cpu/x86/pc/olpc/via/smt.fth
   ofw/gui/iconmenu.fth
Log:
Via manufacturing tests - big cleanup to simplify running the menu and
sequencing the post-menu activities.


Modified: cpu/x86/pc/olpc/via/assy.fth
===================================================================
--- cpu/x86/pc/olpc/via/assy.fth	2009-12-12 06:34:50 UTC (rev 1589)
+++ cpu/x86/pc/olpc/via/assy.fth	2009-12-13 09:59:45 UTC (rev 1590)
@@ -237,12 +237,6 @@
    " Response" get-response to response$
 ;
 
-: silent-probe-usb  ( -- )
-   " /" ['] (probe-usb2) scan-subtree
-   " /" ['] (probe-usb1) scan-subtree
-   report-disk report-net report-keyboard
-;
-
 : wired-lan?  ( -- flag )
    " /usb/ethernet" locate-device  if  false  else  drop true  then
 ;

Modified: cpu/x86/pc/olpc/via/mfgtest.fth
===================================================================
--- cpu/x86/pc/olpc/via/mfgtest.fth	2009-12-12 06:34:50 UTC (rev 1589)
+++ cpu/x86/pc/olpc/via/mfgtest.fth	2009-12-13 09:59:45 UTC (rev 1590)
@@ -13,6 +13,21 @@
 
 0 value pass?
 
+: mfg-wait-return  ( -- )
+   ." ... Press any key to proceed ... "
+   cursor-off
+   gui-alerts
+   begin
+      key?  if  key drop  refresh exit  then
+      mouse-ih  if
+         10 get-event  if
+            \ Ignore movement, act only on a button down event
+            nip nip  if  wait-buttons-up  refresh exit  then
+         then
+      then
+   again
+;
+
 : mfg-test-dev  ( $ -- )
    restore-scroller
    find-device
@@ -25,7 +40,7 @@
          false to pass?
          red-screen
          flush-keyboard
-         wait-return
+         mfg-wait-return
       else
          green-letters
          ." Okay" cr
@@ -40,7 +55,7 @@
       false to pass?
       red-screen
       flush-keyboard
-      wait-return
+      mfg-wait-return
    then
    cursor-off  gui-alerts  refresh
    flush-keyboard
@@ -79,16 +94,26 @@
    flush-keyboard
 ;
 
-d# 14 value #mfgtests
+d# 15 value #mfgtests
 
-: play-item     ( -- )
-   5 #mfgtests +  5 do
+: mfg-test-autorunner  ( -- )  \ Unattended autorun of all tests
+   5 #mfgtests +  5  ?do
       i set-current-sq
       refresh
+      d# 1000 ms
+      run-menu-item
+      pass? 0= ?leave
+   loop
+;
+
+: play-item     ( -- )   \ Interactive autorun of all tests
+   5 #mfgtests +  5  ?do
+      i set-current-sq
+      refresh
       d# 200 0 do
          d# 10 ms  key? if  unloop unloop exit  then
       loop
-      doit
+      run-menu-item
       pass? 0= if  unloop exit  then
    loop
    all-tests-passed
@@ -112,15 +137,9 @@
 : switch-item   ( -- )  " /switches"  mfg-test-dev  ;
 : leds-item     ( -- )  " /leds"      mfg-test-dev  ;
 
-: mfgtest-menu  ( -- )
+: olpc-menu-items  ( -- )
    clear-menu
 
-   " Run all non-interactive tests. (Press a key between tests to stop.)"
-   ['] play-item     play.icon     0 1 selected install-icon
-
-   " Exit selftest mode."
-   ['] quit-item     quit.icon     0 3 install-icon
-
 \   " CPU"
 \   ['] cpu-item      cpu.icon      1 0 install-icon
 
@@ -173,9 +192,28 @@
    ['] switch-item   ebook.icon    3 4 install-icon
 ;
 
-' mfgtest-menu to root-menu
+: full-menu  ( -- )
+   olpc-menu-items
+
+   " Run all non-interactive tests. (Press a key between tests to stop.)"
+   ['] play-item     play.icon     0 1 selected install-icon
+
+   " Exit selftest mode."
+   ['] quit-item     quit.icon     0 3 install-icon
+;
+
+' full-menu to root-menu
 ' noop to do-title
 
+: autorun-mfg-tests  ( -- )
+   ['] mfg-test-autorunner to run-menu   \ Run menu automatically
+   true to diag-switch?
+   ['] olpc-menu-items  ['] nest-menu catch  drop
+   false to diag-switch?
+   restore-scroller
+;
+
+
 \ LICENSE_BEGIN
 \ Copyright (c) 2009 Luke Gorrie
 \ 

Modified: cpu/x86/pc/olpc/via/runin.fth
===================================================================
--- cpu/x86/pc/olpc/via/runin.fth	2009-12-12 06:34:50 UTC (rev 1589)
+++ cpu/x86/pc/olpc/via/runin.fth	2009-12-13 09:59:45 UTC (rev 1590)
@@ -3,7 +3,7 @@
 visible
 
 \ Location of the files containing KA tag data
-: ka-dir$  ( -- adr len )  " http:\\10.1.0.1\ka\"  ;
+: ka-dir$  ( -- adr len )  " http:\\10.0.0.1\ka\"  ;
 
 : nocase-$=  ( $1 $2 -- flag )
    rot tuck <>  if       ( adr1 adr2 len2 )
@@ -12,6 +12,13 @@
    caps-comp 0=          ( flag )
 ;
 
+: .instructions  ( adr len -- )
+   cr blue-letters  type  black-letters  cr
+;
+: .problem  ( adr len -- )
+   red-letters type  black-letters cr
+;
+
 \ 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
@@ -21,18 +28,19 @@
 d# 20 buffer: sn-buf
 : sn$  ( -- adr len )  sn-buf count  ;
 
-: try-get-sn  ( -- )
+: try-scan-sn  ( -- gotit? )
    sn-buf 1+ d# 20 accept   ( n )
    d# 12 <>  if
       " Wrong length, try again" .problem
-      exit
+      false exit
    then
    sn-buf 1+ " TSHC" comp  if
       " Must begin with TSHC, try again" .problem
-      exit
+      false exit
    then
    sn-buf 2+  sn-buf 1+  d# 11 move  \ Elide the T
    d# 11 sn-buf c!
+   true
 ;
 
 : scan-sn  ( -- )
@@ -40,8 +48,8 @@
 
    begin
       " Please Input Serial Number ......" .instructions
-      try-get-sn
-   sn-acquired? until
+      try-scan-sn
+   until
 ;
 
 : board#$  ( -- adr len )
@@ -65,18 +73,15 @@
    " Response" get-response  to response$ 
 ;
 
-0 value test-passed?
 : show-result-screen  ( -- )
-   restore-scroller
-   clear-screen
-   test-passed?  if
-      ." Selftest passed." cr cr cr
+   pass?  if
+      clear-screen
+      ." PASS" cr cr
       green-screen
    else
-      ." Selftest failed." cr cr cr
+      ." FAIL" cr cr
       red-screen
    then
-   d# 2000 ms
 ;
 
 : put-ascii-tag  ( value$ key$ -- )
@@ -118,7 +123,7 @@
    put-ascii-tag
 ;
 : show-tag  ( value$ -- )
-   tag-printable?  if  ?-null type  else  wrapped-cdump  then
+   $tag-printable?  if  ?-null type  else  wrapped-cdump  then
 ;
 : do-tag-error  ( -- )
    \ Don't know what to do here
@@ -140,6 +145,15 @@
    then
 ;
 
+\ Remove possible trailing carriage return from the line
+: ?remove-cr  ( adr len -- adr len' )
+   dup  if                        ( adr len )
+      2dup + 1- c@ carret =  if   ( adr len )
+         1-
+      then
+   then
+;
+
 : parse-tags  ( adr len -- )
    begin  dup  while              ( adr len )
       linefeed left-parse-string  ( rem$ line$ )
@@ -217,7 +231,7 @@
    then
 ;
 
-: put-key:value  ( value$ key$ -- )  " %s:%s" sprint put-key-line  ;
+: put-key:value  ( value$ key$ -- )  " %s:%s" sprintf put-key-line  ;
 
 : upload-tag  ( data$ tag$ -- )
    2dup " wp" $=  if                       ( data$ tag$ )
@@ -257,65 +271,10 @@
 : final-result  ( -- )
    final-filename$  open-temp-file
    upload-tags
-   test-passed?  if  " PASS"  else  " FAIL"  then  " RESULT="  put-key+value
+   pass?  if  " PASS"  else  " FAIL"  then  " RESULT="  put-key+value
    " Result" submit-file
 ;
 
-: finish-final-test  ( -- )
-   show-result-screen
-
-   test-passed?  0=  if
-      ." Type a key to power off "
-      key drop cr  power-off
-   then
-
-   wait-lan
-   wait-scanner
-
-   get-info
-
-   verify-rtc-date
-
-   ." 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
-
-   \ Ultimately this should just be delete of runin\olpc.fth
-   " int:\runin\olpc.fth" " int:\runin\final.fth" $rename
-
-   ." Powering off ..." d# 2000 ms
-   power-off
-;
-
-d# 15 to #mfgtests
-
-: final-tests  ( -- )
-   5 #mfgtests +  5 do
-      i set-current-sq
-      refresh
-      d# 1000 ms
-      doit
-      pass? 0= if  false to test-passed?  finish-final-test  unloop exit  then
-   loop
-   true to test-passed?  finish-final-test
-;
-
-\ Make the "wait for SD insertion" step highly visible 
-dev ext
-warning @  warning off
-: selftest  ( -- )  page show-pass  selftest  ;
-warning !
-dend
-
-\ This modifies the menu to be non-interactive
-: doit-once  ( -- )  do-key  final-tests  ;
-patch doit-once do-key menu-interact
-
 : scanner?  ( -- flag )
    " usb-keyboard" expand-alias  if  2drop true  else  false  then
 ;   
@@ -343,6 +302,7 @@
       begin  d# 1000 ms  silent-probe-usb  usb-key?  until
    then
 ;
+
 : wait-connections  ( -- )
    silent-probe-usb
    wait-scanner
@@ -350,6 +310,36 @@
 \   wait-usb-key
 ;             
 
+: finish-final-test  ( -- )
+   wait-connections
+
+   get-info
+
+   verify-rtc-date
+
+   ." 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
+
+   \ Ultimately this should just be delete of runin\olpc.fth
+   " int:\runin\olpc.fth" " int:\runin\final.fth" $rename
+;
+
+\ Make the "wait for SD insertion" step highly visible 
+dev ext
+warning @  warning off
+: wait&clear  ( -- error? )  wait-card? page  ;
+patch wait&clear wait-card? selftest
+: selftest  ( -- )  page show-pass  selftest  ;
+warning !
+dend
+
+
 : fail-log-file$  ( -- name$ )  " int:\runin\fail.log"   ;
 
 \ The operator can type this to reset the state to run
@@ -367,14 +357,9 @@
       key drop  cr cr
       list
    else
-      
-\     set-tags-for-fqa
-
-      " 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
+      autorun-mfg-tests
+      pass?  if  finish-final-test  then
+      show-result-screen
    then
 
    ." Type a key to power off"

Modified: cpu/x86/pc/olpc/via/smt.fth
===================================================================
--- cpu/x86/pc/olpc/via/smt.fth	2009-12-12 06:34:50 UTC (rev 1589)
+++ cpu/x86/pc/olpc/via/smt.fth	2009-12-13 09:59:45 UTC (rev 1590)
@@ -125,12 +125,10 @@
    get-opid
 ;
 
-0 value test-passed?
-
 \ Upload the result data 
 : smt-result  ( -- )
    smt-filename$  open-temp-file
-   test-passed?  if  " PASS"  else  " FAIL"  then  " RESULT="  put-key+value
+   pass?  if  " PASS"  else  " FAIL"  then  " RESULT="  put-key+value
    " PROCESS=FVT" put-key-line
    " STATION="    put-key-line
    " OPID="       put-key-line
@@ -205,7 +203,9 @@
 ;
 
 \ Decode the server's response and insert appropriate mfg data tags
-: parse-smt-response  ( -- )
+: update-tags ( -- )
+   pass?  0=  if  exit  then   \ XXX could write a failure log tag
+
    ." Server responded with:  "  cr  response$ list cr    ( )
 
    response$ nip 0=  if  ." Null manufacturing data" cr  exit  then
@@ -225,15 +225,14 @@
       (put-mfg-data)
       no-kbc-reboot
       kbc-on
+   else
+      cr cr cr
+      " WARNING: Invalid response from shop floor server - no tags." .problem
+      cr cr cr
+      begin  halt  again
    then
 ;
 
-: silent-probe-usb  ( -- )
-   " /" ['] (probe-usb2) scan-subtree
-   " /" ['] (probe-usb1) scan-subtree
-   report-disk report-net report-keyboard
-;
-
 : scanner?  ( -- flag )
    " usb-keyboard" expand-alias  if  2drop true  else  false  then
 ;   
@@ -277,57 +276,16 @@
 ;             
 
 : show-result-screen  ( -- )
-   restore-scroller
    clear-screen
-   test-passed?  if
-      ." Selftest passed." cr cr cr
+   pass?  if
+      ." PASS" cr cr cr
       green-screen
    else
-      ." Selftest failed." cr cr cr
+      ." FAIL" cr cr cr
       red-screen
    then
-   d# 2000 ms
 ;
 
-: finish-smt-test  ( pass? -- )
-   show-result-screen
-
-   ." Sending test result "
-   cifs-connect  smt-result  cifs-disconnect
-   ." Done" cr
-
-   test-passed?  if
-      ." Writing tags "  parse-smt-response  ." Done" cr
-   then
-
-   any-tag? 0=  if
-      cr cr cr
-      " WARNING: Invalid response from shop floor server - no tags." .problem
-      cr cr cr
-      begin  halt  again
-   then    ( )
-
-   ." Powering off ..." d# 2000 ms
-   power-off
-;
-
-d# 15 to #mfgtests
-
-: smt-tests  ( -- )
-   5 #mfgtests +  5 do
-      i set-current-sq
-      refresh
-      d# 1000 ms
-      doit
-      pass? 0= if  false to test-passed?  finish-smt-test  unloop exit  then
-   loop
-   true to test-passed?  finish-smt-test
-;
-
-\ This modifies the menu to be non-interactive
-: doit-once  ( -- )  do-key  smt-tests  ;
-patch doit-once do-key menu-interact
-
 : start-smt-test  ( -- )
    ?update-firmware
 
@@ -341,19 +299,30 @@
    ." Connecting .. "  cifs-connect ." Connected .. "
    smt-request$  to response$
    cifs-disconnect
-  ." Done" cr
+   ." Done" cr
 
-   true to diag-switch?
-   " patch smt-tests play-item mfgtest-menu" evaluate
-   menu
-   false to diag-switch?
+   autorun-mfg-tests
+
+   ." Sending test result "
+   cifs-connect  smt-result  cifs-disconnect
+   ." Done" cr
+
+   ." Writing tags "  update-tags  ." Done" cr
+
+   show-result-screen
+
+   ." Type a key to power off"
+   key cr
+   power-off
 ;
 
 dev /wlan
+warning @ warning off
 : selftest  ( -- error? )
    true to force-open?  open  false to force-open?  ( opened? )
    if  close false  else  true  then                ( error? )
 ;
+warning !
 dend
 
 \ Automatically run the sequence

Modified: ofw/gui/iconmenu.fth
===================================================================
--- ofw/gui/iconmenu.fth	2009-12-12 06:34:50 UTC (rev 1589)
+++ ofw/gui/iconmenu.fth	2009-12-13 09:59:45 UTC (rev 1590)
@@ -284,7 +284,7 @@
    highlight describe
 ;
 
-: doit  ( - )
+: run-menu-item  ( - )
    current-sq dup valid?  if
       sq >function @ ?dup  if
          guarded
@@ -353,7 +353,7 @@
          [char]  q of  menu-done        endof
          control C of  menu-done        endof
          tab       of  1 go-horizontal  endof
-         carret    of  doit             endof
+         carret    of  run-menu-item    endof
          esc       of  menu-done        endof
          csi       of  ( c ) do-csi     endof
      endcase
@@ -374,7 +374,7 @@
       ready?                                      ( buttons was-ready? )
       over 0<> to ready?                          ( buttons was-ready? )
       \ Execute the square's function on the button's up transition
-      swap 0=  and  if  false to ready?  doit  then  ( )
+      swap 0=  and  if  false to ready?  run-menu-item  then  ( )
    else                                           ( buttons new-square )
       over 0<> to ready?                          ( buttons new-square )
       dup active?  if                             ( buttons new-square )
@@ -459,6 +459,7 @@
 ;
 headerless
 
+defer run-menu
 : menu-interact  ( -- )
    default-selection set-current-sq
    refresh  false to ready?
@@ -470,6 +471,7 @@
  
    remove-mouse-cursor
 ;
+' menu-interact to run-menu
 
 : setup-graphics  ( -- )
    ?open-screen  set-menu-colors  ?open-mouse
@@ -490,7 +492,7 @@
    ['] current-menu behavior  current-sq 2>r
 
 
-   set-menu  menu-interact
+   set-menu  run-menu
 
    2r> to current-sq set-menu refresh
 ;




More information about the openfirmware mailing list