[openfirmware] r1548 - cpu/x86/pc/olpc cpu/x86/pc/olpc/via dev/olpc dev/usb2/hcd dev/usb2/hcd/ehci ofw/inet
svn at openfirmware.info
svn at openfirmware.info
Tue Dec 8 07:17:29 CET 2009
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 at 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 at 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 )
More information about the openfirmware
mailing list