Author: wmb Date: 2009-12-08 07:17:29 +0100 (Tue, 08 Dec 2009) New Revision: 1548
Modified: cpu/x86/pc/olpc/fw.bth cpu/x86/pc/olpc/via/fw.bth cpu/x86/pc/olpc/via/mfgtest.fth cpu/x86/pc/olpc/via/smttags.fth dev/olpc/confirm.fth dev/usb2/hcd/ehci/probe.fth dev/usb2/hcd/hcd.fth ofw/inet/dhcp.fth ofw/inet/ip.fth ofw/inet/sntp.fth Log: Suite of changes to support OLPC manufacturing tests.
Modified: cpu/x86/pc/olpc/fw.bth =================================================================== --- cpu/x86/pc/olpc/fw.bth 2009-12-08 06:12:45 UTC (rev 1547) +++ cpu/x86/pc/olpc/fw.bth 2009-12-08 06:17:29 UTC (rev 1548) @@ -468,7 +468,7 @@
fload ${BP}/ofw/inet/sntp.fth : olpc-ntp-servers ( -- ) - " time 172.18.0.1 0.pool.ntp.org 1.pool.ntp.org 2.pool.ntp.org" + " DHCP time 172.18.0.1 0.pool.ntp.org 1.pool.ntp.org 2.pool.ntp.org" ; ' olpc-ntp-servers to ntp-servers : ntp-time&date ( -- s m h d m y )
Modified: cpu/x86/pc/olpc/via/fw.bth =================================================================== --- cpu/x86/pc/olpc/via/fw.bth 2009-12-08 06:12:45 UTC (rev 1547) +++ cpu/x86/pc/olpc/via/fw.bth 2009-12-08 06:17:29 UTC (rev 1548) @@ -351,16 +351,9 @@ fload ${BP}/cpu/x86/pc/olpc/gui.fth fload ${BP}/cpu/x86/pc/olpc/via/suspend.fth \ Suspend/resume setup
-0 value test-station -\ 0 - not in diag mode -\ 1 - smt -\ 2 - assembly -\ 3 - download -\ 4 - runin -\ 5 - final test -\ 6 - ship image download -: smt-test? ( -- ) test-station 1 = ; -: final-test? ( -- ) test-station 5 = ; +fload ${BP}/cpu/x86/pc/olpc/via/switches.fth \ Lid and ebook switches +fload ${BP}/cpu/x86/pc/olpc/via/leds.fth \ LEDs +fload ${BP}/cpu/x86/pc/olpc/via/factory.fth \ Manufacturing tools
fload ${BP}/dev/olpc/keyboard/selftest.fth \ Keyboard diagnostic fload ${BP}/dev/olpc/touchpad/touchpad.fth \ Touchpad diagnostic @@ -513,7 +506,7 @@
fload ${BP}/ofw/inet/sntp.fth : olpc-ntp-servers ( -- ) - " time 172.18.0.1 0.pool.ntp.org 1.pool.ntp.org 2.pool.ntp.org" + " DHCP time 172.18.0.1 0.pool.ntp.org 1.pool.ntp.org 2.pool.ntp.org" ; ' olpc-ntp-servers to ntp-servers : ntp-time&date ( -- s m h d m y ) @@ -652,7 +645,7 @@ no-page
?factory-mode - ?factory-boot-sequence +\ ?factory-boot-sequence
disable-user-aborts console-start
Modified: cpu/x86/pc/olpc/via/mfgtest.fth =================================================================== --- cpu/x86/pc/olpc/via/mfgtest.fth 2009-12-08 06:12:45 UTC (rev 1547) +++ cpu/x86/pc/olpc/via/mfgtest.fth 2009-12-08 06:17:29 UTC (rev 1548) @@ -66,6 +66,8 @@ icon: keyboard.icon rom:keyboard.565 icon: timer.icon rom:timer.565 icon: clock.icon rom:clock.565 +icon: ebook.icon rom:ebook.565 +icon: leds.icon rom:leds.565
: all-tests-passed ( -- ) restore-scroller @@ -97,7 +99,8 @@ : flash-item ( -- ) " /flash" mfg-test-dev ; : memory-item ( -- ) " /memory" mfg-test-dev ; : usb-item ( -- ) " /usb" mfg-test-dev ; -: sd-item ( -- ) " /sd/disk:0" mfg-test-dev ; +: int-sd-item ( -- ) " int:0" mfg-test-dev ; +: ext-sd-item ( -- ) " ext:0" mfg-test-dev ; : rtc-item ( -- ) " /rtc" mfg-test-dev ; : display-item ( -- ) " /display" mfg-test-dev ; : audio-item ( -- ) " /audio" mfg-test-dev ; @@ -106,6 +109,8 @@ : timer-item ( -- ) " /timer" mfg-test-dev ; : touchpad-item ( -- ) " /8042/mouse" mfg-test-dev ; : keyboard-item ( -- ) " /8042/keyboard" mfg-test-dev ; +: switch-item ( -- ) " /switches" mfg-test-dev ; +: leds-item ( -- ) " /leds" mfg-test-dev ;
: mfgtest-menu ( -- ) clear-menu @@ -116,50 +121,56 @@ " Exit selftest mode." ['] quit-item quit.icon 0 3 install-icon
- " CPU" - ['] cpu-item cpu.icon 1 0 install-icon +\ " CPU" +\ ['] cpu-item cpu.icon 1 0 install-icon
" SPI Flash: Contains EC code, firmware, manufacturing data." - ['] flash-item spi.icon 1 1 install-icon + ['] flash-item spi.icon 1 0 install-icon
" RAM chips" - ['] memory-item ram.icon 1 2 install-icon + ['] memory-item ram.icon 1 1 install-icon
" Internal mass storage" - ['] sd-item sdcard.icon 1 3 install-icon + ['] int-sd-item sdcard.icon 1 2 install-icon
" Plug-in SD card" - ['] sd-item sdcard.icon 1 4 install-icon + ['] ext-sd-item sdcard.icon 1 3 install-icon
- " Battery" - ['] battery-item battery.icon 2 0 install-icon + " Wireless LAN" + ['] wlan-item wifi.icon 1 4 install-icon
+ " Display" + ['] display-item display.icon 2 0 install-icon + " Camera" ['] camera-item camera.icon 2 1 install-icon
- " Wireless LAN" - ['] wlan-item wifi.icon 2 2 install-icon - " Audio: Speaker and microphone" - ['] audio-item audio.icon 2 3 install-icon + ['] audio-item audio.icon 2 2 install-icon
- " Display" - ['] display-item display.icon 2 4 install-icon + " Battery" + ['] battery-item battery.icon 2 3 install-icon
" RTC (Real-Time Clock)" - ['] rtc-item clock.icon 3 0 install-icon + ['] rtc-item clock.icon 2 4 install-icon
" USB ports" - ['] usb-item usb.icon 3 1 install-icon + ['] usb-item usb.icon 3 0 install-icon
\ These are last because they require user participation. \ The earlier tests are all included in automatic batch-mode.
" Keyboard" - ['] keyboard-item keyboard.icon 3 2 install-icon + ['] keyboard-item keyboard.icon 3 1 install-icon
" Touchpad" - ['] touchpad-item touchpad.icon 3 3 install-icon + ['] touchpad-item touchpad.icon 3 2 install-icon + + " LEDs" + ['] leds-item leds.icon 3 3 install-icon + + " Switches" + ['] switch-item ebook.icon 3 4 install-icon ;
' mfgtest-menu to root-menu
Modified: cpu/x86/pc/olpc/via/smttags.fth =================================================================== --- cpu/x86/pc/olpc/via/smttags.fth 2009-12-08 06:12:45 UTC (rev 1547) +++ cpu/x86/pc/olpc/via/smttags.fth 2009-12-08 06:17:29 UTC (rev 1548) @@ -2,142 +2,123 @@
\ visible
-\ Needs: -\ sharename$ ( -- adr len ) CIFS URL of share and credentials, e.g.: -\ " cifs:\user:password@192.168.0.1\myshare" - -[ifndef] $read-file -\ Read entire file into allocated memory -: $read-file ( filename$ -- true | data$ false ) - open-dev ?dup 0= if true exit then >r ( r: ih ) - " size" r@ $call-method drop ( len r: ih ) - dup alloc-mem swap ( adr len r: ih ) - 2dup " read" r@ $call-method ( adr len actual r: ih ) - r> close-dev ( adr len actual ) - over <> if ( adr len ) - free-mem true exit - then ( adr len ) - false +\ 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 ; [then]
+: .instructions ( adr len -- ) + cr blue-letters type black-letters cr +; +: .problem ( adr len -- ) + red-letters type black-letters cr +; + d# 20 buffer: bn-buf \ Buffer for scanned-in board number string -0 value bn-acquired? \ True if we have the board number +: scanned-board#$ ( -- adr len ) bn-buf count ;
-\ Get a board number from the user and validate it -: try-get-bn ( -- ) - bn-buf 1+ d# 20 accept ( n ) - dup bn-buf c! ( n ) - d# 14 <> if - red-letters ." Wrong length, try again" black-letters cr - exit - then - bn-buf 1+ " Q" comp if - red-letters ." Must begin with Q, try again" black-letters cr - exit - then - true to bn-acquired? +: accept-to-buf ( buf len -- actual ) + over 1+ swap accept ( buf actual ) + tuck swap c! ( actual ) ;
\ Get a board number from the user, retrying until valid \ Usually the number is entered with a barcode scanner -: scanned-board#$ ( -- adr len ) - bn-acquired? if bn-buf count exit then +: get-board# ( -- ) ." *****" - begin - blue-letters ." Please Input Board Number ......" black-letters - cr cr cr + " Please Input Board Number ......" .instructions + bn-buf d# 20 accept-to-buf ( n ) + d# 14 <> if + " Wrong length, try again" .problem + else + bn-buf 1+ c@ [char] Q = if exit then + " Must begin with Q, try again" .problem + then + again +;
- try-get-bn - bn-acquired? until +d# 20 buffer: station#-buf +: station#$ ( -- adr len ) station#-buf count ; \ e.g. 01
- bn-buf count -; +: get-station# ( -- ) + ." *****" + begin + " Please Input Station Number ......" .instructions
-\ Construct the filename used for communicating with the server -\ We make an 8.3 name from the last 11 characters of the board number -d# 12 buffer: filename-buf -: smt-filename$ ( -- ) - scanned-board#$ drop 3 + filename-buf 1 + 8 move - [char] . filename-buf 8 + c! - scanned-board#$ drop d# 11 + filename-buf 9 + 3 move - d# 12 filename-buf c! - filename-buf count + station#-buf d# 20 accept-to-buf ( n ) + d# 2 <> if + " Wrong length, try again" .problem + else + station#$ push-decimal $number pop-base if ( ) + " Must be a number, try again" .problem + else ( n ) + drop exit + then + then + again ;
-0 value cifs-ih -d# 256 buffer: tempname-buf -: tempname$ ( -- adr len ) tempname-buf count ; -: $call-cifs ( ?? -- ?? ) cifs-ih $call-method ; +d# 20 buffer: opid-buf +: opid$ ( -- adr len ) opid-buf count ; \ e.g. A001
-: cifs-write ( adr len -- ) " write" $call-cifs ; - -: cifs-connect ( -- ) - sharename$ open-dev to cifs-ih - cifs-ih 0= abort" Cannot open SMB share" +\ Get and validate an operator ID +: get-opid ( -- ) + ." *****" + begin + " Please Operator ID ......" .instructions + opid-buf d# 20 accept-to-buf ( n ) + d# 4 <> if + " Wrong length, try again" .problem + else + opid-buf 1+ c@ [char] A = if exit then + " Must begin with A, try again" .problem + then + again ; -: cifs-disconnect ( -- ) - cifs-ih if cifs-ih close-dev 0 to cifs-ih then -;
-: open-temp-file ( filename$ -- ) - tempname-buf place - - tempname$ " $create" $call-cifs abort" Cannot open temp file" - cifs-ih 0= abort" Can't open temp file on manufacturing server" +\ Construct the filename used for communicating with the server +d# 20 buffer: filename-buf +: smt-filename$ ( -- ) filename-buf count ; +: set-filename ( -- ) + scanned-board#$ filename-buf place + " .txt" filename-buf $cat ;
-: put-key ( value$ key$ -- ) - cifs-write cifs-write " "r"n" cifs-write +: get-info ( -- ) + get-board# + set-filename + get-station# + get-opid ; -: submit-file ( subdir$ -- ) - " flush" $call-cifs abort" CIFS flush failed" - " close-file" $call-cifs abort" CIFS close-file failed" - tempname$ 2swap " %s\%s" sprintf ( new-name$ ) - tempname$ 2swap " $rename" $call-cifs abort" CIFS rename failed" -; -: get-response ( subdir$ -- adr len ) - tempname$ 2swap " %s\%s" sprintf ( response-name$ ) - d# 10 0 do ( response-name$ ) - d# 1000 ms ( response-name$ ) - 2dup 0 open-file 0= if ( response-name$ ) - 2drop ( ) - " size" $call-cifs ( d.size ) - abort" Size is > 4 GB" ( size ) - dup alloc-mem swap ( adr len ) - 2dup " read" $call-cifs ( adr len actual ) - over <> abort" CIFS read of response file filed" - unloop exit - then - loop ( response-name$ ) - 2drop ( ) - true abort" Server did not respond with 10 seconds" -;
\ Upload the result data : smt-result ( pass? -- adr len ) smt-filename$ open-temp-file - if " PASS" else " FAIL" then " RESULT=" put-key - " FVT" " PROCESS=" put-key - " " " STATION=" put-key - " " " OPID=" put-key - " " " GUID=" put-key - scanned-board#$ " MB_NUM=" put-key + 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 " 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 + scanned-board#$ " MB_NUM=" put-key+value + opid$ " OPID=" put-key+value + station#$ " STATION=" put-key+value " Request" submit-file " Response" get-response ;
-: clear-mfg-buf ( -- ) - mfg-data-buf /flash-block h# ff fill -; +: 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$ ) @@ -151,58 +132,31 @@ 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 ( ) (put-mfg-data) ( )
\ check-tags
no-kbc-reboot - flash-write-disable + kbc-on
false ;
\ Perform the exchange with the manufacturing server : smt-tag-exchange ( -- error? ) - smt-request$ $read-file dup if exit then ( adr len ) - 2>r 2r@ parse-smt-response ( r: adr len ) - 2r> free-mem + smt-request$ ( adr len ) + 2>r 2r@ parse-smt-response ( error? r: adr len ) + 2r> free-mem ( error? ) ;
-0 0 " 0" " /" begin-package -" gpios" device-name -: open ( -- okay? ) true ; -: close ( -- ) ; -: gpio-lo ( mask -- ) h# 4c acpi-l@ swap invert and h# 4c acpi-l! ; -: gpio-hi ( mask -- ) h# 4c acpi-l@ swap or h# 4c acpi-l! ; -: wlan-led-on ( -- ) h# 200000 gpio-lo ; -: wlan-led-off ( -- ) h# 200000 gpio-hi ; -: hdd-led-on ( -- ) h# 400000 gpio-lo ; -: hdd-led-off ( -- ) h# 400000 gpio-hi ; -: selftest ( -- ) - ." Flashing LEDs" cr - - confirm-selftest? -; +d# 15 to #mfgtests
-end-package - -: led-item ( -- ) " /leds" mfg-test-dev ; - - -\ XXX need a better icon -icon: led.icon rom:timer.565 - -: smt-test-menu ( -- ) - mfgtest-menu - " LEDs" - ['] led-item led.icon 3 4 install-icon -; -\ d# 15 to #mfgtests -\ ' smt-test-menu to root-menu - : smt-tests ( -- pass? ) 5 #mfgtests + 5 do i set-current-sq @@ -217,13 +171,83 @@ 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 ( ) + " Connect USB barcode scanner" .instructions + reprobe-usb + repeat + ; +: wired-lan? ( -- flag ) + " /usb/ethernet" locate-device if false else drop true then +; +: wait-lan ( -- ) + begin wired-lan? 0= while + " Connect USB Ethernet Adapter" .instructions + reprobe-usb + repeat +; +: usb-key? ( -- flag ) + " /usb/disk" locate-device if false else drop true then +; +: wait-usb-key ( -- ) + begin usb-key? 0= while + " Connect USB memory stick" .instructions + reprobe-usb + repeat +; +: wait-connections ( -- ) + ?reprobe-usb + wait-scanner + wait-lan + wait-usb-key +; + : do-smt-test ( -- ) - smt-tag-exchange - smt-tests smt-result + wait-connections + + ." Setting clock " ntp-set-clock ." Done" cr + + get-info + ." Connecting " cifs-connect ." Done" cr + + ." Writing mfg data tags " smt-tag-exchange ." Done" cr + + ['] true is (diagnostic-mode?) + " patch smt-tests play-item mfgtest-menu" evaluate + menu + ['] false is (diagnostic-mode?) + + ." Uploading test result " smt-result ." Done" cr + + cifs-disconnect ;
\ patch do-smt-test play-item mfgtest-menu -\ patch smt-tests play-item mfgtest-menu
true value once? : doit-once ( -- ) @@ -235,8 +259,3 @@ then ; patch doit-once do-key menu-interact - -' true to (diagnostic-mode?) -patch false diagnostic-mode? memory-test-suite - -\ menu
Modified: dev/olpc/confirm.fth =================================================================== --- dev/olpc/confirm.fth 2009-12-08 06:12:45 UTC (rev 1547) +++ dev/olpc/confirm.fth 2009-12-08 06:17:29 UTC (rev 1548) @@ -2,8 +2,8 @@
: confirm-selftest? ( -- error? ) diagnostic-mode? if - ." Did the test pass (n for FAIL) ? " - key dup emit cr upc [char] N = + ." Did the test pass (n or ESC for FAIL) ? " + key dup emit cr upc dup [char] N = swap h# 1b = or else false then
Modified: dev/usb2/hcd/ehci/probe.fth =================================================================== --- dev/usb2/hcd/ehci/probe.fth 2009-12-08 06:12:45 UTC (rev 1547) +++ dev/usb2/hcd/ehci/probe.fth 2009-12-08 06:17:29 UTC (rev 1548) @@ -72,6 +72,13 @@ external : power-usb-ports ( -- ) ;
+: ports-changed? ( -- flag ) + #ports 0 ?do + i portsc@ 2 and if true unloop exit then + loop + false +; + : probe-root-hub ( -- ) \ Set active-package so device nodes can be added and removed my-self ihandle>phandle push-package
Modified: dev/usb2/hcd/hcd.fth =================================================================== --- dev/usb2/hcd/hcd.fth 2009-12-08 06:12:45 UTC (rev 1547) +++ dev/usb2/hcd/hcd.fth 2009-12-08 06:17:29 UTC (rev 1548) @@ -23,6 +23,7 @@
0 instance value target false value debug? +false instance value noprobe?
\ Setup and descriptor DMA data buffers 0 value setup-buf \ SETUP packet buffer @@ -128,7 +129,14 @@ ;
: parse-my-args ( -- ) - my-args " debug" $= if debug-on then + my-args + begin dup while + ascii , left-parse-string ( rem$' opt$ ) + 2dup " debug" $= if debug-on then + 2dup " noprobe" $= if true to noprobe? then + 2drop ( rem$ ) + repeat ( rem$ ) + 2drop ( ) ;
headers
Modified: ofw/inet/dhcp.fth =================================================================== --- ofw/inet/dhcp.fth 2009-12-08 06:12:45 UTC (rev 1547) +++ ofw/inet/dhcp.fth 2009-12-08 06:17:29 UTC (rev 1548) @@ -262,6 +262,7 @@ 0 file-name-buf c! unknown-ip-addr name-server-ip copy-ip-addr unknown-ip-addr dhcp-server-ip copy-ip-addr + unknown-ip-addr ntp-server-ip copy-ip-addr ;
also forth definitions @@ -530,6 +531,7 @@ d# 28 find-option if drop broadcast-ip-addr copy-ip-addr then d# 15 find-option if 'domain-name place-cstr drop then d# 12 find-option if 'client-name place-cstr drop then + d# 42 find-option if drop ntp-server-ip copy-ip-addr then d# 43 find-option if parse-vendor 'vendor-options place-cstr drop then d# 17 find-option if 'root-path place-cstr drop then
@@ -550,6 +552,9 @@ 'root-path c@ if indent indent ." Root path: " 'root-path cscount type cr then + ntp-server-ip known? if + indent indent ." NTP server: " ntp-server-ip .ipaddr cr + then 'vendor-options c@ if indent indent ." Vendor options: " 'vendor-options cscount type cr then
Modified: ofw/inet/ip.fth =================================================================== --- ofw/inet/ip.fth 2009-12-08 06:12:45 UTC (rev 1547) +++ ofw/inet/ip.fth 2009-12-08 06:17:29 UTC (rev 1548) @@ -42,6 +42,7 @@ headers /i buffer: his-ip-addr /i buffer: name-server-ip +/i buffer: ntp-server-ip ' 'domain-name " domain-name" chosen-string
headerless
Modified: ofw/inet/sntp.fth =================================================================== --- ofw/inet/sntp.fth 2009-12-08 06:12:45 UTC (rev 1547) +++ ofw/inet/sntp.fth 2009-12-08 06:17:29 UTC (rev 1548) @@ -45,14 +45,24 @@ then
d# 5,000 " set-timeout" $call-ip - " $set-host" $call-ip + + 2dup " DHCP" $= if ( hostname$ ) + 2drop " ntp-server-ip" $call-ip ( 'ipaddr ) + dup " known?" $call-ip 0= if ( 'ipaddr ) + drop ip-ih close-dev true exit + then ( 'ipaddr ) + " set-dest-ip" $call-ip ( ) + else ( hostname$ ) + " $set-host" $call-ip ( ) + then ( ) + send-sntp-request receive-sntp-reply ip-ih close-dev ;
defer ntp-servers -: default-ntp-servers " 0.pool.ntp.org 1.pool.ntp.org 2.pool.ntp.org" ; +: default-ntp-servers " DHCP 0.pool.ntp.org 1.pool.ntp.org 2.pool.ntp.org" ; ' default-ntp-servers to ntp-servers
: ntp-timestamp ( -- true | d.timestamp false )