Author: wmb
Date: 2009-12-09 16:04:23 +0100 (Wed, 09 Dec 2009)
New Revision: 1560
Added:
cpu/x86/pc/olpc/via/initsmt.fth
Modified:
cpu/x86/pc/olpc/via/smttags.fth
Log:
New version of smttags.fth
Added: cpu/x86/pc/olpc/via/initsmt.fth
===================================================================
--- cpu/x86/pc/olpc/via/initsmt.fth (rev 0)
+++ cpu/x86/pc/olpc/via/initsmt.fth 2009-12-09 15:04:23 UTC (rev 1560)
@@ -0,0 +1,12 @@
+\ Inject some tag values to get the manufacturing process started
+: no-restart ( -- ) no-kbc-reboot kbc-on d# 300 ms ;
+patch no-restart io-spi-reprogrammed io-spi-start
+
+h# 202 msr@ swap h# ff invert and swap h# 202 msr! \ Uncache flash
+
+add-tag TS SMT
+add-tag MS cifs:\\bekins:bekind2@10.60.0.2\nb2_fvs
+add-tag BD u:\boot\olpc.fth cifs:\\bekins:bekind2@10.60.0.2\nb2_fvs\olpc.fth
+add-tag NT 10.60.0.2" evaluate
+
+.( Wrote TS, MS, BD, and NT) cr
Modified: cpu/x86/pc/olpc/via/smttags.fth
===================================================================
--- cpu/x86/pc/olpc/via/smttags.fth 2009-12-09 15:03:46 UTC (rev 1559)
+++ cpu/x86/pc/olpc/via/smttags.fth 2009-12-09 15:04:23 UTC (rev 1560)
@@ -1,15 +1,11 @@
\ SMT test
-\ visible
+visible
-\ This is for testing, until we get the MS tag injected into the final image
-[ifdef] factory-server$
-: set-server ( -- )
- factory-server$ nip 0= if
- " cifs:\\bekins:bekind2@10.60.0.2\nb2_fvs" to factory-server$
- then
+: mfg-ntp-server ( -- name$ )
+ " NT" find-tag if ?-null else " 10.60.0.2" then
;
-[then]
+' mfg-ntp-server to ntp-servers
: .instructions ( adr len -- )
cr blue-letters type black-letters cr
@@ -19,7 +15,7 @@
;
d# 20 buffer: bn-buf \ Buffer for scanned-in board number string
-: scanned-board#$ ( -- adr len ) bn-buf count ;
+: board#$ ( -- adr len ) bn-buf count ;
: accept-to-buf ( buf len -- actual )
over 1+ swap accept ( buf actual )
@@ -34,7 +30,7 @@
" Please Input Board Number ......" .instructions
bn-buf d# 20 accept-to-buf ( n )
d# 14 <> if
- " Wrong length, try again" .problem
+ " Wrong length (must be 14 characters), try again" .problem
else
bn-buf 1+ c@ [char] Q = if exit then
" Must begin with Q, try again" .problem
@@ -43,7 +39,7 @@
;
d# 20 buffer: station#-buf
-: station#$ ( -- adr len ) station#-buf count ; \ e.g. 01
+: station#$ ( -- adr len ) station#-buf count ; \ e.g. J01
: get-station# ( -- )
." *****"
@@ -51,14 +47,11 @@
" Please Input Station Number ......" .instructions
station#-buf d# 20 accept-to-buf ( n )
- d# 2 <> if
- " Wrong length, try again" .problem
+ d# 3 <> if
+ " Wrong length (must be like J01), try again" .problem
else
- station#$ push-decimal $number pop-base if ( )
- " Must be a number, try again" .problem
- else ( n )
- drop exit
- then
+ station#-buf 1+ c@ [char] A [char] Z between if exit then
+ " Must begin with A-Z, try again" .problem
then
again
;
@@ -70,13 +63,16 @@
: get-opid ( -- )
." *****"
begin
- " Please Operator ID ......" .instructions
+ " Please Input Operator ID ......" .instructions
opid-buf d# 20 accept-to-buf ( n )
- d# 4 <> if
- " Wrong length, try again" .problem
+ d# 8 <> if
+ " Wrong length (must be 8 digits), try again" .problem
else
- opid-buf 1+ c@ [char] A = if exit then
- " Must begin with A, try again" .problem
+ opid$ push-decimal $number pop-base if ( )
+ " Must be a number, try again" .problem
+ else ( n )
+ drop exit
+ then
then
again
;
@@ -85,7 +81,7 @@
d# 20 buffer: filename-buf
: smt-filename$ ( -- ) filename-buf count ;
: set-filename ( -- )
- scanned-board#$ filename-buf place
+ board#$ filename-buf place
" .txt" filename-buf $cat
;
@@ -97,21 +93,21 @@
;
\ Upload the result data
-: smt-result ( pass? -- adr len )
+: smt-result ( pass? -- )
smt-filename$ open-temp-file
if " PASS" else " FAIL" then " RESULT=" put-key+value
" PROCESS=FVT" put-key-line
" STATION=" put-key-line
" OPID=" put-key-line
" GUID=" put-key-line
- scanned-board#$ " MB_NUM=" put-key+value
+ board#$ " MB_NUM=" put-key+value
" Result" submit-file
;
\ Send the board number as the request and return the response data
: smt-request$ ( -- adr len )
smt-filename$ open-temp-file
- scanned-board#$ " MB_NUM=" put-key+value
+ board#$ " MB_NUM=" put-key+value
opid$ " OPID=" put-key+value
station#$ " STATION=" put-key+value
" Request" submit-file
@@ -125,19 +121,57 @@
($add-tag) ( )
;
+\ 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
+;
+
+: put-tag ( value$ key$ -- )
+ 2swap dup if add-null then 2swap ( value$' key$ )
+ ($add-tag) ( )
+;
+
+0 0 2value response$
+
+\ If the server sends us tags in the response file, we put
+\ them in the mfg data
+: write-new-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$ )
+ else ( rem$ value$ key$ )
+ 4drop ( rem$ )
+ then ( rem$ )
+ repeat ( adr len )
+ 2drop ( )
+;
+
\ Decode the server's response and insert appropriate mfg data tags
-: parse-smt-response ( adr len -- error? )
- drop " Timeout" comp 0= if true exit then
+: parse-smt-response ( -- )
+ ." Server responded with: " cr response$ list cr ( )
+ response$ nip 0= if ." Null manufacturing data" cr exit then
+
+." Type q to skip tag write " key dup emit cr [char] q = if
+ 2drop false exit
+then
+
flash-write-enable
clear-mfg-buf ( )
-\ XXX propagate tag values from response - code in Notes/mfgtags.fth
- " " " ww" put-ascii-tag ( )
- " EN" " SS" put-ascii-tag ( )
- " ASSY" " TS" put-ascii-tag ( )
- " C1" " SG" put-ascii-tag ( )
- scanned-board#$ " B#" put-ascii-tag ( )
+ response$ write-new-tags ( )
+\ " " " ww" put-ascii-tag ( )
+\ " EN" " SS" put-ascii-tag ( )
+\ " ASSY" " TS" put-ascii-tag ( )
+\ " D3" " SG" put-ascii-tag ( )
+\ board#$ " B#" put-ascii-tag ( )
(put-mfg-data) ( )
\ check-tags
@@ -148,114 +182,109 @@
false
;
-\ Perform the exchange with the manufacturing server
-: smt-tag-exchange ( -- error? )
- smt-request$ ( adr len )
- 2>r 2r@ parse-smt-response ( error? r: adr len )
- 2r> free-mem ( error? )
-;
-
-d# 15 to #mfgtests
-
-: smt-tests ( -- pass? )
- 5 #mfgtests + 5 do
- i set-current-sq
- refresh
- d# 200 0 do
- d# 10 ms key? if unloop unloop exit then
- loop
- doit
- pass? 0= if unloop false exit then
- loop
- all-tests-passed
- true
-;
-
-0 value usb-ih
-: open-usb ( -- )
- " /usb:noprobe" open-dev to usb-ih
- usb-ih 0= abort" Can't open USB!"
-;
-: close-usb ( -- ) usb-ih close-dev 0 to usb-ih ;
: silent-probe-usb ( -- )
" /" ['] (probe-usb2) scan-subtree
" /" ['] (probe-usb1) scan-subtree
report-disk report-net report-keyboard
;
-: usb-ports-changed? ( -- flag )
- open-usb
- " ports-changed?" usb-ih $call-method ( changed? )
- close-usb
-;
-: ?reprobe-usb ( -- ) usb-ports-changed? if silent-probe-usb then ;
-: reprobe-usb ( -- )
- begin d# 100 ms usb-ports-changed? until
- silent-probe-usb
-;
: scanner? ( -- flag )
" usb-keyboard" expand-alias if 2drop true else false then
;
: wait-scanner ( -- )
- begin scanner? 0= while ( )
+ scanner? 0= if
" Connect USB barcode scanner" .instructions
- reprobe-usb
- repeat
+ begin d# 1000 ms silent-probe-usb scanner? until
+ then
;
: wired-lan? ( -- flag )
" /usb/ethernet" locate-device if false else drop true then
;
: wait-lan ( -- )
- begin wired-lan? 0= while
+ wired-lan? 0= if
" Connect USB Ethernet Adapter" .instructions
- reprobe-usb
- repeat
+ begin d# 1000 ms silent-probe-usb wired-lan? until
+ then
;
: usb-key? ( -- flag )
" /usb/disk" locate-device if false else drop true then
;
: wait-usb-key ( -- )
- begin usb-key? 0= while
+ usb-key? 0= if
" Connect USB memory stick" .instructions
- reprobe-usb
- repeat
+ begin d# 1000 ms silent-probe-usb usb-key? until
+ then
;
: wait-connections ( -- )
- ?reprobe-usb
+ silent-probe-usb
wait-scanner
wait-lan
wait-usb-key
;
-: do-smt-test ( -- )
+0 value test-passed?
+: show-result-screen ( -- )
+ restore-scroller
+ clear-screen
+ test-passed? if
+ ." Selftest passed." cr cr cr
+ d# 2000 ms
+ green-screen
+ else
+ ." Selftest failed." cr cr cr
+ d# 2000 ms
+ red-screen
+ then
+;
+
+: finish-smt-test ( pass? -- )
+ show-result-screen
+
+ cifs-connect
+ ." Uploading test result " test-passed? smt-result ." Done" cr
+ cifs-disconnect
+
+ test-passed? if
+ ." Writing tags " parse-smt-response ." Done" cr
+ 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 ( -- )
wait-connections
." Setting clock " ntp-set-clock ." Done" cr
get-info
+
." Connecting " cifs-connect ." Done" cr
+ ." Getting tags from server " smt-request$ to response$ ." Done" cr
+ cifs-disconnect
- ." Writing mfg data tags " smt-tag-exchange ." Done" cr
-
- ['] true is (diagnostic-mode?)
+ true to diag-switch?
" patch smt-tests play-item mfgtest-menu" evaluate
menu
- ['] false is (diagnostic-mode?)
-
- ." Uploading test result " smt-result ." Done" cr
-
- cifs-disconnect
+ false to diag-switch?
;
-\ patch do-smt-test play-item mfgtest-menu
-
-true value once?
-: doit-once ( -- )
- do-key
- once? if
- false to once?
-\ doit
- smt-tests
- then
-;
-patch doit-once do-key menu-interact
+\ Automatically run the sequence
+start-smt-test
