r576 - forth/kernel
by svn＠openbios.org
Author: wmb
Date: 2007-08-24 01:31:44 +0200 (Fri, 24 Aug 2007)
New Revision: 576
Modified:
forth/kernel/kernel.fth
Log:
Fixed a longstanding bug that caused misleading error messages when
interpreting from files. The problem is that the line buffer memory
has been freed and possibly overwritten before the undefined word name
is displayed. The solution is to copy the word name to a dedicated
buffer.
Modified: forth/kernel/kernel.fth
===================================================================
--- forth/kernel/kernel.fth 2007-08-23 23:28:07 UTC (rev 575)
+++ forth/kernel/kernel.fth 2007-08-23 23:31:44 UTC (rev 576)
@@ -995,9 +995,11 @@
then
;
headers
+0 value 'error-word
: .not-found ( adr len -- ) where type ." ?" cr ;
\ Abort after an undefined word in interpret state
: $interpret-do-undefined ( adr len -- )
+ d# 32 min 'error-word pack count
set-abort-message d# -13 throw
;
\ Compile a surrogate for an undefined word in compile state
@@ -1532,6 +1534,7 @@
init
d# 20 alloc-mem is fake-name-buf
d# 32 alloc-mem is canonical-word
+ d# 34 alloc-mem is 'error-word
;
headers
11 years, 12 months
- 1
- 0
r575 - dev/olpc/cafenand
by svn＠openbios.org
Author: wmb
Date: 2007-08-24 01:28:07 +0200 (Fri, 24 Aug 2007)
New Revision: 575
Modified:
dev/olpc/cafenand/badblock.fth
Log:
Changed the name of "scrub" to "scrub!" and made "scrub" issue a
warning message.
Modified: dev/olpc/cafenand/badblock.fth
===================================================================
--- dev/olpc/cafenand/badblock.fth 2007-08-23 16:08:37 UTC (rev 574)
+++ dev/olpc/cafenand/badblock.fth 2007-08-23 23:28:07 UTC (rev 575)
@@ -286,7 +286,7 @@
\ Completely erase the device, ignoring any existing bad-block info
\ This is fairly severe, not recommended except in exceptional situations
-: scrub ( -- )
+: scrub! ( -- )
release-bbt
total-pages 0 ?do
(cr i .
@@ -294,6 +294,11 @@
pages/eblock +loop
make-bbt
;
+: scrub ( -- )
+ ." scrub is dangerous because it discards factory bad block information." cr
+ ." That can cause bad problems with later use of the NAND FLASH device." cr
+ ." Type scrub! if you really want to do it." cr
+;
: .bn ( -- ) (cr . ;
11 years, 12 months
- 1
- 0
r574 - ofw/inetv6
by svn＠openbios.org
Author: lwalter
Date: 2007-08-23 18:08:37 +0200 (Thu, 23 Aug 2007)
New Revision: 574
Modified:
ofw/inetv6/icmperr.fth
ofw/inetv6/ipv6.fth
ofw/inetv6/neighdis.fth
ofw/inetv6/netloadv6.fth
ofw/inetv6/tcpv6.fth
Log:
/prefix does not have to be multiple of 8 any more; some cleanup
Modified: ofw/inetv6/icmperr.fth
===================================================================
--- ofw/inetv6/icmperr.fth 2007-08-22 16:31:41 UTC (rev 573)
+++ ofw/inetv6/icmperr.fth 2007-08-23 16:08:37 UTC (rev 574)
@@ -58,6 +58,10 @@
icmp-code c@ -rot ( code adr len )
icmp-type c@ -rot ( code type adr len )
icmpv6-err-callback-xt execute
+
+ \ Abort because, most likely, the error condition is caused by
+ \ erroneous networking code.
+ true abort" Fix cause of error and retry"
;
headers
Modified: ofw/inetv6/ipv6.fth
===================================================================
--- ofw/inetv6/ipv6.fth 2007-08-22 16:31:41 UTC (rev 573)
+++ ofw/inetv6/ipv6.fth 2007-08-23 16:08:37 UTC (rev 574)
@@ -96,25 +96,6 @@
: unknown-ipv6-addr? ( adr-buf -- flag ) unknown-ipv6-addr ipv6= ;
: knownv6? ( adr-buf -- flag ) unknown-ipv6-addr? 0= ;
-: bits>mask ( bits -- mask )
- ?dup 0= if 0 exit then
- 0 swap 0 7 ?do ( mask bits )
- 1 i << rot or swap ( mask' bits )
- 1- dup 0= if leave then ( mask bits' )
- -1 +loop drop ( mask )
-;
-
-: prefix-match? ( ip1 ip2 -- flag )
- /prefix 8 /mod 2over 2 pick ( ip1 ip2 rem quot ip1 ip2 quot )
- comp 0= if
- swap bits>mask >r ( ip1 ip2 quot ) ( R: mask )
- tuck + c@ r@ and ( ip1 quot [ip2+quot]&mask ) ( R: mask )
- -rot + c@ r> and = ( flag )
- else
- 4drop false
- then
-;
-
: set-his-ipv6-addr-mc ( -- )
his-ipv6-addr /ipv6 + 3 - his-ipv6-addr-mc-sol-node /ipv6 + 3 - 3 move
;
@@ -142,6 +123,35 @@
his-ipv6-addr ipv6-addr-local? not if use-routerv6? and then
;
+: bits>mask ( bits -- mask ) h# ff 8 rot - << h# ff and ;
+: copy-ipv6-prefix ( prefix ip /prefix -- )
+ 8 /mod 2over 2 pick move ( prefix ip rem quot )
+ swap ?dup if ( prefix ip quot rem )
+ bits>mask ( prefix ip quot mask )
+ -rot ( prefix mask ip quot )
+ tuck + dup c@ ( prefix mask quot ip+quot ip[quot] )
+ 3 pick invert and 2>r ( prefix mask quot ) ( R: ip+quot ip[quot]&~mask )
+ rot + c@ and ( prefix[quot]&mask ) ( R: ip+quot ip[quot]&~mask )
+ 2r> rot or swap c! ( )
+ else
+ 3drop ( )
+ then
+;
+: (prefix-match?) ( ip1 ip2 /prefix -- flag )
+ 8 /mod 2over 2 pick ( ip1 ip2 rem quot ip1 ip2 quot )
+ comp 0= if
+ swap bits>mask >r ( ip1 ip2 quot ) ( R: mask )
+ tuck + c@ r@ and ( ip1 quot ip2[quot]&mask ) ( R: mask )
+ -rot + c@ r> and = ( flag )
+ else
+ 4drop false
+ then
+;
+: prefix-match? ( ip1 ip2 -- flag )
+ dup ipv6-addr-local? if d# 64 else /prefix then
+ (prefix-match?)
+;
+
/ipv6 buffer: server-ipv6-addr
: use-serverv6? ( -- flag ) server-ipv6-addr knownv6? ;
: use-server? ( -- flag )
Modified: ofw/inetv6/neighdis.fth
===================================================================
--- ofw/inetv6/neighdis.fth 2007-08-22 16:31:41 UTC (rev 573)
+++ ofw/inetv6/neighdis.fth 2007-08-23 16:08:37 UTC (rev 574)
@@ -160,12 +160,11 @@
;
: auto-cfg-global? ( -- flag )
my-prefix unknown-ipv6-addr? if false exit then
- prefix-flag h# 40 and 0= if false exit then
- /prefix d# 64 = \ XXX What to do with /prefix other than 64?
+ prefix-flag h# 40 and \ Prefix can be used for autocfg
;
: discover-router ( -- )
- unknown-ipv6-addr my-ipv6-addr-global copy-ipv6-addr
- ipv6-addr-mc-all-routers his-ipv6-addr copy-ipv6-addr
+ unknown-ipv6-addr my-ipv6-addr-global copy-ipv6-addr
+ ipv6-addr-mc-all-routers his-ipv6-addr copy-ipv6-addr
set-his-en-addr-mc
send-router-sol
@@ -173,11 +172,11 @@
begin
IP_HDR_ICMPV6 receive-ip-packet ?dup 0= if process-rd? then
until
- auto-cfg-global? not if exit then
+ auto-cfg-global? 0= if exit then
\ DAD on the global IPv6 address
my-ipv6-addr-link-local my-ipv6-addr-global copy-ipv6-addr
- my-prefix my-ipv6-addr-global /prefix 8 / move \ XXX assume prefix multiple of 8 bits
+ my-prefix my-ipv6-addr-global /prefix copy-ipv6-prefix
ipv6-addr-mc-all-nodes his-ipv6-addr copy-ipv6-addr
set-his-en-addr-mc
Modified: ofw/inetv6/netloadv6.fth
===================================================================
--- ofw/inetv6/netloadv6.fth 2007-08-22 16:31:41 UTC (rev 573)
+++ ofw/inetv6/netloadv6.fth 2007-08-23 16:08:37 UTC (rev 574)
@@ -12,22 +12,27 @@
d# 256 buffer: 'root-path
d# 32 buffer: tmpname
false instance value bootp-only?
+[then]
+: (.ipv6) ( buf -- adr len )
+ push-hex
+ <# dup /ipv6 + 1- do i c@ u# u# drop -1 +loop 0 u#>
+ pop-base
+;
+
\ Construct the file name for the second-stage boot program from
\ the IP address and the architecture.
-: boot-filename ( -- adr len )
+: boot-filenamev6 ( -- adr len )
file-name-buf cscount dup if exit then ( adr len )
2drop
- push-hex
- \ XXX Questionable code for IPv6
- my-ipv6-addr be-l@ (.8) 2dup upper ( adr len )
- pop-base
+ my-ipv6-addr (.ipv6) 2dup upper ( adr len )
tmpname place
cpu-arch dup if " ." tmpname $cat tmpname $cat else 2drop then
tmpname count file-name-buf place-cstr drop
file-name-buf cscount
;
+[ifndef] include-ipv4
headers
true instance value use-bootp?
@@ -116,7 +121,7 @@
headers
: next-xid ( -- id ) rpc-xid 1+ dup to rpc-xid ;
-: load ( adr -- len ) boot-filename read-file ;
+: load ( adr -- len ) boot-filenamev6 read-file ;
\ LICENSE_BEGIN
\ Copyright (c) 2006 FirmWorks
Modified: ofw/inetv6/tcpv6.fth
===================================================================
--- ofw/inetv6/tcpv6.fth 2007-08-22 16:31:41 UTC (rev 573)
+++ ofw/inetv6/tcpv6.fth 2007-08-23 16:08:37 UTC (rev 574)
@@ -2413,7 +2413,6 @@
use-ipv6? if acceptv6 else accept then
;
-\ XXX new args: ipv4, ipv6
[ifndef] include-ipv4
: parse-args ( -- )
my-args
11 years, 12 months
- 1
- 0
r573 - ofw/inetv6
by svn＠openbios.org
Author: lwalter
Date: 2007-08-22 18:31:41 +0200 (Wed, 22 Aug 2007)
New Revision: 573
Modified:
ofw/inetv6/dhcpv6.fth
ofw/inetv6/dnsv6.fth
ofw/inetv6/ipv6.fth
ofw/inetv6/neighdis.fth
Log:
Obtain DNS IPv6 address from router advertisement
Modified: ofw/inetv6/dhcpv6.fth
===================================================================
--- ofw/inetv6/dhcpv6.fth 2007-08-22 01:05:10 UTC (rev 572)
+++ ofw/inetv6/dhcpv6.fth 2007-08-22 16:31:41 UTC (rev 573)
@@ -1,6 +1,56 @@
\ See license at end of file
purpose: Dynamic Host Configuration Protocol for IPv6 (DHCPv6) (RFC 3315)
+d# 1000 constant dhcpv6-timeout \ 1 second timeout
+
+d# 546 constant client-port
+d# 547 constant dhcpv6-port
+
+struct ( dhcpv6 packet )
+ 1 sfield dh6-op \ DHCPv6 message type
+ 3 sfield dh6-xid \ Transaction ID
+ 0 sfield dh6-options \ DHCPv6 options
+constant /dhcpv6-hdr
+
+: dh6-xid@ ( -- xid ) dh6-xid 2 + c@ dh6-xid 1+ c@ dh6-xid c@ 0 bljoin ;
+: dh6-xid! ( xid -- ) lbsplit drop dh6-xid c! dh6-xid 1+ c! dh6-xid 2 + c! ;
+
+\ dh6-op values
+\ 1 SOLICIT Used by clients to locate DHCP servers
+\ 2 ADVERTISE Used by servers as response to SOLICIT
+\ 3 REQUEST Used by clients to get info from servers
+\ 4 CONFIRM Used by clients to verify validity of params
+\ 5 RENEW Used by clients to extend lifetime
+\ 6 REBIND Used by clients to extend lifetime if no reply to RENEW
+\ 7 REPLY Used by servers to respond
+\ 8 RELEASE Used by clients to release their IPv6 addresses
+\ 9 DECLINE Used by clients to decline assigned addresses
+\ 10 RECONFIGURE Used by DHCP servers to inform clients of new cfg
+\ 11 INFO_REQUEST Used by clients to request additional cfg params
+\ 12 RELAY_FORWARD Used by DHCP relays to forward client msgs to servers
+\ 13 RELAY_REPLY Used by DHCP servers to send msgs to clients via a relay
+
+struct ( dhcpv6 option )
+ 2 sfield do6-code \ Option code
+ 2 sfield do6-len \ Option len
+ 0 sfield do6-data \ Option data
+constant /do6-hdr
+
+d# 1024 constant /dhcpv6-packet
+
+\ do6-code values
+\ 1 client ID
+\ 2 server ID
+\ 3 ID association for nontemporary address (IA_NA)
+\ 4 ID association for temporary address (IA_TA)
+\ 5 IA address
+\ 6 option request
+\ 7 preference
+\ 8 elapse time
+\ 9 relay message
+\ 11 authentication
+\ 12 server unicast
+
[ifndef] include-ipv4
d# 256 buffer: 'root-path
d# 256 buffer: 'client-name
@@ -12,9 +62,29 @@
: domain-name ( -- adr len ) 'domain-name cscount ;
[then]
-\ tubes.laptop.org
-create default-name-server-ipv6 h# 20 c, 1 c, h# 48 c, h# 30 c, h# 24 c, h# 46 c, h# ff c, 0 c, 0 l, 0 w, 0 c, 1 c,
+0 instance value dhcpv6-packet
+0 instance value dhcpv6-len \ Actual length of received DHCPv6 packet
+0 instance value dhcpv6-option \ Pointer to option field in dhcpv6-packet
+: /dhcpv6-packet ( -- len ) dhcpv6-option dhcpv6-packet - ;
+: set-dhcpv6-option ( -- ) dh6-options to dhcpv6-option ;
+: +dhcpv6-option ( n -- ) dhcpv6-option + to dhcpv6-option ;
+: opc! ( c -- ) dhcpv6-option c! 1 +dhcpv6-option ;
+: opw! ( w -- ) dhcpv6-option be-w! 2 +dhcpv6-option ;
+: opl! ( l -- ) dhcpv6-option be-l! 4 +dhcpv6-option ;
+: op$! ( $ -- ) tuck dhcpv6-option swap move +dhcpv6-option ;
+
+: allocate-dhcpv6 ( size -- )
+ allocate-udp dup is dhcpv6-packet set-struct
+ set-dhcpv6-option
+
+ get-msecs start-time !
+
+ \ Set "random" transaction ID and random number generator seed
+ my-en-addr 2 + xl@ get-msecs xor dup xid ! rn !
+;
+: free-dhcpv6 ( size -- ) dhcpv6-packet swap free-udp ;
+
: init-dhcpv6 ( -- )
[ifndef] include-ipv4
0 'domain-name c!
@@ -23,7 +93,6 @@
0 'vendor-options c!
\ 0 file-name-buf c!
[then]
- default-name-server-ipv6 name-server-ipv6 copy-ipv6-addr
;
also forth definitions
@@ -32,9 +101,72 @@
;
previous definitions
-: do-dhcp ( -- )
+: send-dhcpv6-packet ( size op -- )
+ dh6-op c!
+ xid dh6-xid!
+ dhcpv6-packet swap client-port dhcpv6-port send-udpv6-packet
;
+: detect-dhcpv6-packet ( op -- timeout? )
+ >r
+ dhcpv6-timeout set-timeout
+ begin client-port receive-udp-packet 0= while ( adr,len src-port )
+ drop to dhcpv6-len set-struct
+the-struct dhcpv6-len dump cr
+ dh6-xid@ xid @ h# ff.ffff = dh6-op c@ r@ = and if r> drop false exit then
+ repeat
+ r> drop true
+;
+
+: option-client-id ( -- )
+ 1 opw! \ Client ID option
+ /e 4 + opw! \ Option len
+ 3 opw! \ DUID type: link-layer address
+ 1 opw! \ Hardware type: ethernet
+ my-en-addr /e op$! \ My mac address
+;
+
+: option-req-option ( -- )
+ 6 opw! \ Option request option
+ 2 opw! \ Option len
+ d# 23 opw! \ OPTION_DNS_SERVERS
+;
+
+: dhcpv6-solicit ( -- )
+ ipv6-addr-mc-all-dhcp his-ipv6-addr copy-ipv6-addr
+ set-his-en-addr-mc
+ option-client-id
+ \ option-ia to which server will assign addresses
+ option-req-option
+ /dhcpv6-packet d# 11 send-dhcpv6-packet
+ 2 detect-dhcpv6-packet abort" Timeout soliciting DHCPv6 server"
+;
+: dhcpv6-req-info ( -- )
+ ipv6-addr-mc-all-dhcp his-ipv6-addr copy-ipv6-addr
+ set-his-en-addr-mc
+ option-client-id
+ option-req-option
+ /dhcpv6-packet d# 11 send-dhcpv6-packet
+ 7 detect-dhcpv6-packet abort" Timeout waiting for requested info"
+;
+
+: do-dhcpv6-stateless ( -- )
+ ." DHCPv6 stateless auto configuration not supported yet" cr exit
+
+ bootnet-debug if
+ ." DHCPv6 protocol: Getting network information" cr
+ then
+ /dhcpv6-packet allocate-dhcpv6
+
+ ['] dhcpv6-req-info catch drop
+
+ /dhcpv6-packet free-dhcpv6
+;
+
+: do-dhcpv6-stateful ( -- )
+ true abort" Stateful autoconfiguration not supported yet"
+;
+
\ LICENSE_BEGIN
\ Copyright (c) 2007 FirmWorks
\
Modified: ofw/inetv6/dnsv6.fth
===================================================================
--- ofw/inetv6/dnsv6.fth 2007-08-22 01:05:10 UTC (rev 572)
+++ ofw/inetv6/dnsv6.fth 2007-08-22 16:31:41 UTC (rev 573)
@@ -224,6 +224,8 @@
[then]
: resolvev6 ( hostname$ -- )
+ name-server-ipv6 unknown-ipv6-addr? if true abort" Unknown DNS server IPv6 address" then
+
bootnet-debug if ( hostname$ )
." Using IPv6 DNS to find the IPv6 address of " ( hostname$ )
2dup type cr ( hostname$ )
Modified: ofw/inetv6/ipv6.fth
===================================================================
--- ofw/inetv6/ipv6.fth 2007-08-22 01:05:10 UTC (rev 572)
+++ ofw/inetv6/ipv6.fth 2007-08-22 16:31:41 UTC (rev 573)
@@ -78,6 +78,7 @@
/ipv6 buffer: my-ipv6-addr-global
/ipv6 buffer: router-ipv6-addr
/ipv6 buffer: name-server-ipv6
+/ipv6 buffer: dhcp-ipv6-addr
headerless
@@ -86,6 +87,7 @@
create default-ipv6-addr h# fe c, h# 80 c, 0 w, 0 l, 0 w, 0 c, h# ff c, h# fe c, 0 c, 0 w,
create ipv6-addr-mc-all-nodes h# ff c, 2 c, 0 w, 0 l, 0 l, 0 w, 0 c, 1 c,
create ipv6-addr-mc-all-routers h# ff c, 2 c, 0 w, 0 l, 0 l, 0 w, 0 c, 2 c,
+create ipv6-addr-mc-all-dhcp h# ff c, 2 c, 0 w, 0 l, 0 l, 0 c, 1 c, 0 c, 2 c,
create my-ipv6-addr-mc-sol-node h# ff c, 2 c, 0 w, 0 l, 0 w, 0 c, 1 c, h# ff c, 0 c, 0 w,
create his-ipv6-addr-mc-sol-node h# ff c, 2 c, 0 w, 0 l, 0 w, 0 c, 1 c, h# ff c, 0 c, 0 w,
@@ -168,10 +170,11 @@
: .my-ipv6-addr-global ( -- )
." My IPv6 (global): " my-ipv6-addr-global .ipv6
;
-: .his-ipv6-addr ( -- ) ." His IP: " his-ipv6-addr .ipv6 ;
+: .his-ipv6-addr ( -- ) ." His IPv6: " his-ipv6-addr .ipv6 ;
: .my-prefix ( -- )
." My prefix (global): " my-prefix .ipv6 ." /" /prefix .d
;
+: .name-server-ipv6 ( -- ) ." DNS IPv6: " name-server-ipv6 .ipv6 ;
[ifndef] include-ipv4
0 instance value last-ip-packet
Modified: ofw/inetv6/neighdis.fth
===================================================================
--- ofw/inetv6/neighdis.fth 2007-08-22 01:05:10 UTC (rev 572)
+++ ofw/inetv6/neighdis.fth 2007-08-22 16:31:41 UTC (rev 573)
@@ -86,6 +86,7 @@
then
indent .my-link-addr cr
use-routerv6? if indent .routerv6-en-addr cr then
+ name-server-ipv6 knownv6? if indent .name-server-ipv6 cr then
then
;
@@ -98,6 +99,7 @@
;
: set-my-ipv6-addr-link-local ( -- )
\ Duplicate Address Discovery
+ d# 64 to /prefix
unknown-ipv6-addr my-ipv6-addr copy-ipv6-addr
default-ipv6-addr my-ipv6-addr-link-local copy-ipv6-addr
@@ -114,17 +116,33 @@
my-ipv6-addr-link-local my-ipv6-addr copy-ipv6-addr
;
+: discover-me ( -- )
+ ipv6-address " stateless" $= if
+ set-my-ipv6-addr-link-local
+ else
+ do-dhcpv6-stateful
+ then
+;
+: ?discover-dns ( -- )
+ ipv6-address " stateless" $= if
+ name-server-ipv6 unknown-ipv6-addr? if
+ do-dhcpv6-stateless
+ then
+ then
+;
+
: process-rd-options ( adr len -- )
begin dup 0> while
over c@ case
- 1 of over 2 + routerv6-en-addr copy-en-addr endof \ Source link-layer address option
- 3 of over 2 + c@ to /prefix \ Prefix option
+ 1 of over 2 + routerv6-en-addr copy-en-addr endof \ Source link-layer address option
+ 3 of over 2 + c@ to /prefix \ Prefix option
over 3 + c@ to prefix-flag
- over 8 + be-l@ to prefix-lifetime \ XXX lifetime
- over d# 16 + my-prefix copy-ipv6-addr \ Prefix
+ over 8 + be-l@ to prefix-lifetime \ XXX lifetime
+ over d# 16 + my-prefix copy-ipv6-addr \ Prefix
endof
- 5 of over 4 + be-l@ to (link-mtu) endof \ MTU option
+ 5 of over 4 + be-l@ to (link-mtu) endof \ MTU option
+ d# 25 of over 8 + name-server-ipv6 copy-ipv6-addr endof \ RDNSS option
endcase
over 1+ c@ 8 * /string
repeat 2drop
@@ -173,11 +191,12 @@
['] 4drop to icmpv6-err-callback-xt
['] 2drop to icmpv6-info-callback-xt
+ unknown-ipv6-addr name-server-ipv6 copy-ipv6-addr
- d# 64 to /prefix
- set-my-ipv6-addr-link-local
-
+ discover-me
discover-router
+ ?discover-dns
+
to use-ipv6? \ Restore IPv6 flag
;
11 years, 12 months
- 1
- 0
r572 - cpu/x86/pc/olpc
by svn＠openbios.org
Author: wmb
Date: 2007-08-22 03:05:10 +0200 (Wed, 22 Aug 2007)
New Revision: 572
Modified:
cpu/x86/pc/olpc/devices.fth
cpu/x86/pc/olpc/gpioinit.fth
cpu/x86/pc/olpc/micin.fth
Log:
OLPC trac #2767 - finish the job started by r571.
Modified: cpu/x86/pc/olpc/devices.fth
===================================================================
--- cpu/x86/pc/olpc/devices.fth 2007-08-21 20:49:43 UTC (rev 571)
+++ cpu/x86/pc/olpc/devices.fth 2007-08-22 01:05:10 UTC (rev 572)
@@ -324,7 +324,7 @@
" SN" find-tag if 1- else " Unknown" then " serial-number" string-property
[ifndef] lx-devel
- 8 ec-cmd " ec-version" integer-property
+ 8 ec-cmd-b@ " ec-version" integer-property
" PQ2" h# fff0.0000 h# 1.0000 sindex dup 0>= if ( offset )
h# fff0.0000 + cscount ( name )
Modified: cpu/x86/pc/olpc/gpioinit.fth
===================================================================
--- cpu/x86/pc/olpc/gpioinit.fth 2007-08-21 20:49:43 UTC (rev 571)
+++ cpu/x86/pc/olpc/gpioinit.fth 2007-08-22 01:05:10 UTC (rev 572)
@@ -190,7 +190,7 @@
: fix-sirq ( -- )
[ifdef] lx-devel exit [then]
- 9 ec-cmd 9 <> if
+ 9 ec-cmd-b@ 9 <> if
h# 5140.004e rdmsr swap h# 40 or swap h# 5140.004e wrmsr
then
;
Modified: cpu/x86/pc/olpc/micin.fth
===================================================================
--- cpu/x86/pc/olpc/micin.fth 2007-08-21 20:49:43 UTC (rev 571)
+++ cpu/x86/pc/olpc/micin.fth 2007-08-22 01:05:10 UTC (rev 572)
@@ -10,14 +10,14 @@
post-b1? if
2 >clr OUT_VAL gpio! \ 5536 GPIO01
else
- 2 ec-cmd drop \ EC GPIO18
+ 2 ec-cmd-b@ drop \ EC GPIO18
then
;
: dc-mode ( -- )
post-b1? if
2 OUT_VAL gpio! \ 5536 GPIO01
else
- 1 ec-cmd drop \ EC GPIO18
+ 1 ec-cmd-b@ drop \ EC GPIO18
then
;
11 years, 12 months
- 1
- 0
r571 - dev/olpc/kb3700
by svn＠openbios.org
Author: wmb
Date: 2007-08-21 22:49:43 +0200 (Tue, 21 Aug 2007)
New Revision: 571
Modified:
dev/olpc/kb3700/ecio.fth
Log:
OLPC trac #2767 - retry EC commands after timeout.
Modified: dev/olpc/kb3700/ecio.fth
===================================================================
--- dev/olpc/kb3700/ecio.fth 2007-08-20 19:37:58 UTC (rev 570)
+++ dev/olpc/kb3700/ecio.fth 2007-08-21 20:49:43 UTC (rev 571)
@@ -28,7 +28,7 @@
: ec-cmd-out ( cmd -- ) wait-ib-empty h# 6c pc! ;
: ec-wb ( -- ) wait-ib-empty h# 68 pc! ;
: ec-rb ( -- b )
- d# 1000 0 do
+ d# 200 0 do
h# 6c pc@ 3 and 1 = if
h# 68 pc@
unloop exit
@@ -38,8 +38,6 @@
true abort" EC port 6c output buffer timeout"
;
-: ec-cmd ( cmd -- response ) ec-cmd-out ec-rb ;
-
: ec-cmd66 ( byte -- )
h# 66 pc!
\ It typically requires about 200 polls
@@ -50,10 +48,52 @@
: ec-rw ( -- w ) ec-rb ec-rb swap bwjoin ;
: ec-ww ( -- w ) wbsplit ec-wb ec-wb ;
-: ec-cmd-w@ ( cmd -- w ) ec-cmd-out ec-rw ;
-: ec-cmd-b@ ( cmd -- b ) ec-cmd ;
-: ec-cmd-b! ( b cmd -- ) ec-cmd-out ec-wb ;
+: (ec-cmd-b!) ( b cmd -- ) ec-cmd-out ec-wb ;
+: (ec-cmd-b@) ( cmd -- b ) ec-cmd-out ec-rb ;
+: (ec-cmd-w@) ( cmd -- w ) ec-cmd-out ec-rw ;
+: too-many-retries ( -- ) true abort" Too many EC command retries" ;
+d# 10 constant #ec-retries
+
+: ec-cmd ( cmd -- )
+ #ec-retries 0 do ( cmd )
+ dup ['] ec-cmd-out catch 0= if ( cmd )
+ drop unloop exit
+ then ( cmd x )
+ drop ( cmd )
+ loop ( cmd )
+ too-many-retries
+;
+
+\ Hideous retries to work around race conditions in the EC code
+: ec-cmd-b! ( b cmd -- )
+ #ec-retries 0 do ( b cmd )
+ 2dup ['] (ec-cmd-b!) catch 0= if ( b cmd )
+ 2drop unloop exit
+ then ( b cmd x x )
+ 2drop ( b cmd )
+ loop ( b cmd )
+ too-many-retries
+;
+: ec-cmd-b@ ( cmd -- b )
+ #ec-retries 0 do ( cmd )
+ dup ['] (ec-cmd-b@) catch 0= if ( cmd b )
+ nip unloop exit
+ then ( cmd x )
+ drop ( cmd )
+ loop ( cmd )
+ too-many-retries
+;
+: ec-cmd-w@ ( cmd -- w )
+ #ec-retries 0 do ( cmd )
+ dup ['] (ec-cmd-w@) catch 0= if ( cmd w )
+ nip unloop exit
+ then ( cmd x )
+ drop ( cmd )
+ loop ( cmd )
+ too-many-retries
+;
+
: bat-voltage@ ( -- w ) h# 10 ec-cmd-w@ ;
: bat-current@ ( -- w ) h# 11 ec-cmd-w@ ;
: bat-acr@ ( -- w ) h# 12 ec-cmd-w@ ;
@@ -61,31 +101,60 @@
: ambient-temp@ ( -- w ) h# 14 ec-cmd-w@ ;
: bat-status@ ( -- b ) h# 15 ec-cmd-b@ ;
: bat-soc@ ( -- b ) h# 16 ec-cmd-b@ ;
-: bat-gauge-id@ ( -- sn0 .. sn7 ) h# 17 ec-cmd-out 8 0 do ec-rb loop ;
-: bat-gauge@ ( -- b ) h# 18 ec-cmd-out h# 31 ec-wb ec-rb ; \ 31 is the EEPROM address
-: bat-type@ ( -- b ) h# 18 ec-cmd-out h# 5f ec-wb ec-rb ; \ 5f is the EEPROM address
+: (bat-gauge-id@) ( -- sn0 .. sn7 ) h# 17 ec-cmd-out 8 0 do ec-rb loop ;
+: bat-gauge-id@ ( -- sn0 .. sn7 )
+ #ec-retries 0 do
+ ['] (bat-gauge-id@) catch 0= if unloop exit then
+ loop
+ too-many-retries
+;
+: (bat-gauge@) ( -- b ) h# 18 ec-cmd-out h# 31 ec-wb ec-rb ; \ 31 is the EEPROM address
+: bat-gauge@ ( -- b )
+ #ec-retries 0 do
+ ['] (bat-gauge@) catch 0= if unloop exit then
+ loop
+ too-many-retries
+;
+
+: (bat-type@) ( -- b ) h# 18 ec-cmd-out h# 5f ec-wb ec-rb ; \ 5f is the EEPROM address
+: bat-type@ ( -- b )
+ #ec-retries 0 do
+ ['] (bat-type@) catch 0= if unloop exit then
+ loop
+ too-many-retries
+;
+
: board-id@ ( -- b ) h# 19 ec-cmd-b@ ;
: sci-source@ ( -- b ) h# 1a ec-cmd-b@ ;
: sci-mask! ( b -- ) h# 1b ec-cmd-b! ;
: sci-mask@ ( -- b ) h# 1c ec-cmd-b@ ;
-: game-key@ ( -- w ) h# 1d ec-cmd-out ec-rw ;
-: ec-date! ( day month year -- ) h# 1e ec-cmd-out ec-wb ec-wb ec-wb ;
+: game-key@ ( -- w ) h# 1d ec-cmd-w@ ;
+: (ec-date!) ( day month year -- ) h# 1e ec-cmd-out ec-wb ec-wb ec-wb ;
+: ec-date! ( day month year -- )
+ #ec-retries 0 do ( d m y )
+ 3dup ['] (ec-date!) catch 0= if 3drop unloop exit then ( d m y x x x )
+ 3drop ( d m y )
+ loop ( d m y )
+ too-many-retries
+;
+
: ec-abnormal@ ( -- b ) h# 1f ec-cmd-b@ ;
-: bat-init-nimh-gp ( -- ) h# 20 ec-cmd-out ;
-: bat-init-lifepo4-byd ( -- ) h# 21 ec-cmd-out ;
-: bat-init-lifepo4-gp ( -- ) h# 22 ec-cmd-out ;
+: bat-init-nimh-gp ( -- ) h# 20 ec-cmd ;
+: bat-init-lifepo4-byd ( -- ) h# 21 ec-cmd ;
+: bat-init-lifepo4-gp ( -- ) h# 22 ec-cmd ;
: wlan-off ( -- ) 0 h# 23 ec-cmd-b! ;
: wlan-on ( -- ) 1 h# 23 ec-cmd-b! ;
-: wlan-wake ( -- ) h# 24 ec-cmd-out ;
-: wlan-reset ( -- ) h# 25 ec-cmd-out ;
+: wlan-wake ( -- ) h# 24 ec-cmd ;
+: wlan-reset ( -- ) h# 25 ec-cmd ;
: dcon-disable ( -- ) 0 h# 26 ec-cmd-b! ;
: dcon-enable ( -- ) 1 h# 26 ec-cmd-b! ;
-: reset-ec-warm ( -- ) h# 27 ec-cmd-out ;
-: reset-ec ( -- ) h# 28 ec-cmd-out ;
-: write-protect-fw ( -- ) h# 29 ec-cmd-out ;
+: reset-ec-warm ( -- ) h# 27 ec-cmd ;
+: reset-ec ( -- ) h# 28 ec-cmd ;
+: write-protect-fw ( -- ) h# 29 ec-cmd ;
: ebook-mode? ( -- b ) h# 2a ec-cmd-b@ ;
+0 [if]
\ EC mailbox access words
: ec-mb-adr@ ( -- w ) h# 80 ec-cmd-out ec-rw ;
@@ -96,6 +165,7 @@
: ec-mb-w@ ( adr -- w ) h# 88 ec-mb-setup h# 82 ec-cmd-w@ ;
: ec-mb-b! ( b adr -- ) h# 85 ec-mb-setup ec-wb h# 8b ec-cmd-out ;
: ec-mb-w! ( w adr -- ) h# 83 ec-mb-setup ec-ww h# 89 ec-cmd-out ;
+[then]
\ SCI source codes:
\ SCI_WAKEUP_EVENT 0x01 // Game button,
@@ -109,9 +179,9 @@
\ This command hard-resets the EC deeply enough for the SP write-protect to
\ be off when the system is powered up again.
-: ec-reset ( -- ) 5 ec-cmd ;
+: ec-reset ( -- ) 5 ec-cmd-b@ drop ;
-: kb3920? ( -- flag ) h# 6c pc@ h# ff = if true exit then 9 ec-cmd 9 = ;
+: kb3920? ( -- flag ) h# 6c pc@ h# ff = if true exit then 9 ec-cmd-b@ 9 = ;
\ This makes the EC stop generating a flood of SCIs every time you do
\ the port 66 command sequence.
11 years, 12 months
- 1
- 0
r570 - forth/lib
by svn＠openbios.org
Author: wmb
Date: 2007-08-20 21:37:58 +0200 (Mon, 20 Aug 2007)
New Revision: 570
Added:
forth/lib/tofile.fth
Log:
forth/lib/tofile.fth - Initial checkin
Added: forth/lib/tofile.fth
===================================================================
--- forth/lib/tofile.fth (rev 0)
+++ forth/lib/tofile.fth 2007-08-20 19:37:58 UTC (rev 570)
@@ -0,0 +1,97 @@
+purpose: Redirect the output stream.
+\ See license at end of file
+
+\ to-file \ filename ( -- )
+\ causes output to be temporarily diverted to the named file.
+\ The file is created if it doesn't exist, and overwritten if it does.
+\ Output is restored to the console just before Forth prompts for a
+\ new line of input.
+\ append-to-file \ filename ( -- )
+\ Similar to to-file but if the file already exists, the new stuff is
+\ tacked onto the end, rather than overwriting the file.
+
+\ We really need to make the output stream a multi-field structure, and
+\ keep a stack of output streams.
+
+only forth also hidden also definitions
+variable old-status ' noop old-status token!
+variable old-(emit ' noop old-(emit token!
+variable old-(type ' noop old-(type token!
+variable old-cr ' noop old-cr token!
+variable old-exit? ' noop old-exit? token!
+variable old-#out 0 old-#out !
+variable old-#line 0 old-#line !
+variable saved-output-valid saved-output-valid off
+
+forth definitions
+: save-output ( -- )
+ ['] status behavior old-status token!
+ ['] (emit behavior old-(emit token!
+ ['] (type behavior old-(type token!
+ ['] cr behavior old-cr token!
+ ['] exit? behavior old-exit? token!
+ #out @ old-#out !
+ #line @ old-#line !
+ saved-output-valid on
+;
+: unsave-output ( -- )
+ saved-output-valid @ if
+ old-(emit token@ is (emit
+ old-(type token@ is (type
+ old-status token@ is status
+ old-cr token@ is cr
+ old-exit? token@ is exit?
+ old-#out @ #out !
+ old-#line @ #line !
+ saved-output-valid off
+ then
+;
+hidden definitions
+: undo-file-output ( -- ) unsave-output ofd @ fclose ;
+: file-(emit ( char -- ) ofd @ fputc ;
+: file-(type ( adr len -- ) ofd @ fputs ;
+: file-cr ( adr len -- )
+ #out off 1 #line +! newline-string ofd @ fputs
+;
+forth definitions
+: file-output ( -- )
+ save-output
+ ['] undo-file-output is status
+ ['] file-(emit is (emit
+ ['] file-(type is (type
+ ['] file-cr is cr
+ ['] false is exit?
+ #out off #line off
+;
+
+: to-file \ filename ( -- )
+ writing file-output
+;
+: append-to-file \ filename ( -- )
+ appending file-output
+;
+only forth also definitions
+
+\ LICENSE_BEGIN
+\ Copyright (c) 2007 FirmWorks
+\
+\ Permission is hereby granted, free of charge, to any person obtaining
+\ a copy of this software and associated documentation files (the
+\ "Software"), to deal in the Software without restriction, including
+\ without limitation the rights to use, copy, modify, merge, publish,
+\ distribute, sublicense, and/or sell copies of the Software, and to
+\ permit persons to whom the Software is furnished to do so, subject to
+\ the following conditions:
+\
+\ The above copyright notice and this permission notice shall be
+\ included in all copies or substantial portions of the Software.
+\
+\ THE SOFTWARE IS PROVIDED "AS IS", WITHOUT WARRANTY OF ANY KIND,
+\ EXPRESS OR IMPLIED, INCLUDING BUT NOT LIMITED TO THE WARRANTIES OF
+\ MERCHANTABILITY, FITNESS FOR A PARTICULAR PURPOSE AND
+\ NONINFRINGEMENT. IN NO EVENT SHALL THE AUTHORS OR COPYRIGHT HOLDERS BE
+\ LIABLE FOR ANY CLAIM, DAMAGES OR OTHER LIABILITY, WHETHER IN AN ACTION
+\ OF CONTRACT, TORT OR OTHERWISE, ARISING FROM, OUT OF OR IN CONNECTION
+\ WITH THE SOFTWARE OR THE USE OR OTHER DEALINGS IN THE SOFTWARE.
+\
+\ LICENSE_END
12 years
- 1
- 0
r569 - dev/ne2000
by svn＠openbios.org
Author: wmb
Date: 2007-08-19 20:13:20 +0200 (Sun, 19 Aug 2007)
New Revision: 569
Modified:
dev/ne2000/ne2000.fth
Log:
ne2000 driver - fixed a typo - OVR was spelled OVER, thus possibly
causing a bug in the "overrun" routine.
Modified: dev/ne2000/ne2000.fth
===================================================================
--- dev/ne2000/ne2000.fth 2007-08-19 01:51:23 UTC (rev 568)
+++ dev/ne2000/ne2000.fth 2007-08-19 18:13:20 UTC (rev 569)
@@ -433,7 +433,7 @@
\ updated the boundary register, or determined that there really were
\ no new packets in the ring.
- OVER isr! \ Clear the overrun interrupt bit
+ OVR isr! \ Clear the overrun interrupt bit
set-tx-mode \ Take the NIC out of loopback
\ Resend any incomplete transmission
@@ -446,7 +446,7 @@
: recv-690-overrun ( -- )
false to is-overrun-690
boundary@ boundary! \ rewrite bndry with itself
- OVER isr! \ Clear overrun interrupt bit
+ OVR isr! \ Clear overrun interrupt bit
;
[then]
12 years
- 1
- 0
r568 - cpu/x86/pc/olpc
by svn＠openbios.org
Author: wmb
Date: 2007-08-19 03:51:23 +0200 (Sun, 19 Aug 2007)
New Revision: 568
Modified:
cpu/x86/pc/olpc/versions.fth
Log:
Q2C25
Modified: cpu/x86/pc/olpc/versions.fth
===================================================================
--- cpu/x86/pc/olpc/versions.fth 2007-08-19 01:39:34 UTC (rev 567)
+++ cpu/x86/pc/olpc/versions.fth 2007-08-19 01:51:23 UTC (rev 568)
@@ -2,7 +2,7 @@
\ The overall firmware revision
macro: FW_MAJOR C
-macro: FW_MINOR 24
+macro: FW_MINOR 25
\ The EC microcode
macro: EC_VERSION c24
12 years
- 1
- 0
r567 - in dev/olpc: kb3700 spiflash
by svn＠openbios.org
Author: wmb
Date: 2007-08-19 03:39:34 +0200 (Sun, 19 Aug 2007)
New Revision: 567
Modified:
dev/olpc/kb3700/ecserial.fth
dev/olpc/spiflash/recover.fth
dev/olpc/spiflash/spiui.fth
Log:
OLPC - reliability improvements in "clone" (for debricking machines).
a) Eliminate EC watchdog resets by reading the SPI FLASH slowly (c.f. Trac #2636)
b) Tell user when and how to reset the target machine.
Modified: dev/olpc/kb3700/ecserial.fth
===================================================================
--- dev/olpc/kb3700/ecserial.fth 2007-08-19 01:13:03 UTC (rev 566)
+++ dev/olpc/kb3700/ecserial.fth 2007-08-19 01:39:34 UTC (rev 567)
@@ -17,11 +17,22 @@
['] noop to spi-reprogrammed
d# 57600 baud
+
+ \ We have to reset the target here because it is probably confused by having
+ \ received other characters from our serial line
+ ." Reset the target system with a full power-cycle, then type a key to continue" cr
+ begin key? until key drop
+
h# 5a uemit ( divisor ) \ ( wait-tx )
h# 88 spicfg! ( divisor ) \ Write enable for SPICMD register
h# 45 spibaud! ( )
+
+ d# 50 ms \ Settling time
+
d# 115200 baud
+ d# 50 ms \ Settling time
+
-1 to flash-base
;
: use-serial-ec ( -- ) ['] serial-spi-start to spi-start ;
Modified: dev/olpc/spiflash/recover.fth
===================================================================
--- dev/olpc/spiflash/recover.fth 2007-08-19 01:13:03 UTC (rev 566)
+++ dev/olpc/spiflash/recover.fth 2007-08-19 01:39:34 UTC (rev 567)
@@ -28,7 +28,7 @@
: clone ( -- )
." Getting a copy of this machine's FLASH" cr
- h# fff0.0000 flash-buf /flash move
+ slow-flash-read
true to file-loaded?
(serial-flash)
Modified: dev/olpc/spiflash/spiui.fth
===================================================================
--- dev/olpc/spiflash/spiui.fth 2007-08-19 01:13:03 UTC (rev 566)
+++ dev/olpc/spiflash/spiui.fth 2007-08-19 01:39:34 UTC (rev 567)
@@ -203,6 +203,12 @@
/flash mfg-data-end-offset write-flash-range \ Write last part
;
+: .verify-msg ( -- )
+ ." Type verify if you want to verify the data just written." cr
+ ." Verification will take about 17 minutes if the host is running Linux" cr
+ ." or about 5 minutes if the host is running OFW." cr
+;
+
: reflash ( -- ) \ Flash from data already in memory
?file
spi-start
@@ -222,8 +228,7 @@
then
spi-reprogrammed
else
- ." Type verify if you want to verify the data just written." cr
- ." Verification will take about 17 minutes..." cr
+ .verify-msg
then
;
@@ -238,21 +243,26 @@
: flash ( ["filename"] -- ) get-file reflash ;
-[ifdef] dev
-dev /flash
+\ This is a slower version of "rom-va flash-buf /flash lmove"
+\ It works around the problem that continuous CPU access to the
+\ SPI FLASH starves the EC of instruction fetch cycles, often
+\ causing it to turn off the system.
0 value rom-va
-: selftest ( -- error? )
- rom-va 0= if rom-pa /flash root-map-in to rom-va then
-
- \ This is a slower version of "rom-va flash-buf /flash lmove"
- \ It works around the problem that continuous CPU access to the
- \ SPI FLASH starves the EC of instruction fetch cycles, often
- \ causing it to turn off the system.
+: slow-flash-read ( -- )
+ rom-pa /flash root-map-in to rom-va
/flash 0 do
rom-va i + flash-buf i + h# 1.0000 lmove
d# 200 ms
h# 1.0000 +loop
+ rom-va /flash root-map-out 0 to rom-va
+;
+[ifdef] dev
+dev /flash
+: selftest ( -- error? )
+
+ slow-flash-read
+
\ Replace the manufacturing data block with all FF
flash-buf mfg-data-offset + /flash-block h# ff fill
@@ -261,7 +271,6 @@
-1 swap l!
flash-buf /flash crc <>
- rom-va /flash root-map-out 0 to rom-va
;
device-end
[then]
@@ -291,8 +300,7 @@
\ Don't overwrite the EC code
flash-buf /flash /ec write-flash-range
- ." Type verify-bios if you want to verify the data just written." cr
- ." Verification will take about 17 minutes..." cr
+ .verify-msg
;
: verify-bios ( -- ) flash-buf /flash /ec verify-flash-range ;
12 years
- 1
- 0