r1340 - ofw/gui
by svn＠openfirmware.info
Author: wmb
Date: 2009-08-31 18:33:21 +0200 (Mon, 31 Aug 2009)
New Revision: 1340
Modified:
ofw/gui/mouse.fth
Log:
Fixed comment typo, tip o' the hat to James Cameron.
Modified: ofw/gui/mouse.fth
===================================================================
--- ofw/gui/mouse.fth 2009-08-30 01:33:45 UTC (rev 1339)
+++ ofw/gui/mouse.fth 2009-08-31 16:33:21 UTC (rev 1340)
@@ -72,8 +72,8 @@
00000000011000001100000000000000 ,
00000000011000000110000000000000 ,
00000000001100011000000000000000 ,
- 00000000000111110000000000000000 ,
00000000000111110000000000000000 ,
+ 00000000000111110000000000000000 ,
create black-bits
00000000000000000000000000000000 ,
@@ -148,7 +148,7 @@
: update-position ( x y -- )
2dup or 0= if 2drop exit then \ Avoid flicker if there is no movement
- \ Minimize the time the cursor is down by doing computa1000000000000000000 ,tion in advance
+ \ Minimize the time the cursor is down by doing computation in advance
\ Considering the amount of code that is executed to put up the cursor,
\ this optimization is probable unnoticeable, but it doesn't cost much.
negate ypos + 0 max-y cursor-h - clamp ( x y' )
9 years, 6 months
r1339 - cpu/x86/pc cpu/x86/pc/olpc cpu/x86/pc/olpc/via dev/olpc/spiflash ofw/core
by svn＠openfirmware.info
Author: wmb
Date: 2009-08-30 03:33:45 +0200 (Sun, 30 Aug 2009)
New Revision: 1339
Modified:
cpu/x86/pc/biosints.fth
cpu/x86/pc/olpc/biosresume.fth
cpu/x86/pc/olpc/devices.fth
cpu/x86/pc/olpc/fw.bth
cpu/x86/pc/olpc/gui.fth
cpu/x86/pc/olpc/via/devices.fth
cpu/x86/pc/olpc/via/fw.bth
dev/olpc/spiflash/recover.fth
ofw/core/muxdev.fth
Log:
Fixed some residual dependencies on the dualconsole scheme, hopefully
completing the transition to full console multiplexing.
Modified: cpu/x86/pc/biosints.fth
===================================================================
--- cpu/x86/pc/biosints.fth 2009-08-28 21:54:40 UTC (rev 1338)
+++ cpu/x86/pc/biosints.fth 2009-08-30 01:33:45 UTC (rev 1339)
@@ -126,7 +126,7 @@
;
: set-mode3 ( -- )
- stdout off \ Stop using OFW driver
+ text-off \ Stop using OFW screen output
" text-mode3" screen-ih $call-method
;
\ VBE status: AL = 4f -> function supported else not supported
@@ -419,7 +419,7 @@
: set-mode12 ( -- )
" graphics-mode12" " screen-ih" eval $call-method
- stdout off
+ text-off \ Stop using OFW output to screen
;
: set-video-mode ( mode -- )
case
@@ -846,17 +846,17 @@
;
0 value the-key
-0 value kbd-ih
+: $call-keyboard ( ?? method-name$ -- ?? ) keyboard-ih $call-method ;
: poll-key ( -- false | scan,ascii true )
the-key ?dup if true exit then
d# 50 ms \ I don't know why this is necessary, but without it, you don't see the key
- 0 " get-scancode" kbd-ih $call-method if ( scancode )
+ 0 " get-scancode" $call-keyboard if ( scancode )
dup h# 80 and if ( scancode )
\ Discard release events and escapes (e0)
drop false ( false )
else
- dup " scancode->char" kbd-ih $call-method 0= if 0 then ( scancode ascii )
+ dup " scancode->char" $call-keyboard 0= if 0 then ( scancode ascii )
dup h# 80 and if drop 0 then \ Don't return e.g. 9B for arrows
swap bwjoin to the-key
the-key true
@@ -1000,7 +1000,7 @@
: #hard-drives ( -- n ) 1 ;
: make-bda ( -- )
- h# 400 h# 200 erase
+ h# 400 h# 101 erase
'ebda h# 400 erase
h# 3f8 h# 400 w!
'ebda 4 rshift h# 40e w!
@@ -1058,9 +1058,6 @@
'ebda 4 rshift h# 40e w! \ Extended BIOS data area segment address
- \ The USB keyboard is unsuitable for this purpose, as USB is
- \ turned off when control is transferred to the Windows booter.
- " /isa/keyboard" open-dev to kbd-ih
populate-memory-map
rm-platform-fixup
;
Modified: cpu/x86/pc/olpc/biosresume.fth
===================================================================
--- cpu/x86/pc/olpc/biosresume.fth 2009-08-28 21:54:40 UTC (rev 1338)
+++ cpu/x86/pc/olpc/biosresume.fth 2009-08-30 01:33:45 UTC (rev 1339)
@@ -51,14 +51,14 @@
[then]
: suspend-ps2 ( -- )
- " default-disable-kbd" kbd-ih $call-method \ Stop keyboard
- 1 " set-port" kbd-ih $call-method \ Select mouse (touchpad) port
- " default-disable-kbd" kbd-ih $call-method \ Stop mouse
+ " default-disable-kbd" $call-keyboard \ Stop keyboard
+ 1 " set-port" $call-keyboard \ Select mouse (touchpad) port
+ " default-disable-kbd" $call-keyboard \ Stop mouse
;
: resume-ps2 ( -- )
- " enable-scan" kbd-ih $call-method \ Restart mouse
- 0 " set-port" kbd-ih $call-method \ Select keyboard port
- " enable-scan" kbd-ih $call-method \ Restart keyboard
+ " enable-scan" $call-keyboard \ Restart mouse
+ 0 " set-port" $call-keyboard \ Select keyboard port
+ " enable-scan" $call-keyboard \ Restart keyboard
;
: enable-uoc ( -- )
Modified: cpu/x86/pc/olpc/devices.fth
===================================================================
--- cpu/x86/pc/olpc/devices.fth 2009-08-28 21:54:40 UTC (rev 1338)
+++ cpu/x86/pc/olpc/devices.fth 2009-08-30 01:33:45 UTC (rev 1339)
@@ -241,6 +241,11 @@
h# 3f8 is uart-base
fload ${BP}/forth/lib/sysuart.fth \ Use UART for key and emit
+0 value keyboard-ih
+0 value screen-ih
+
+fload ${BP}/ofw/core/muxdev.fth \ I/O collection/distribution device
+
[ifndef] save-flash
: save-flash ;
: restore-flash ;
Modified: cpu/x86/pc/olpc/fw.bth
===================================================================
--- cpu/x86/pc/olpc/fw.bth 2009-08-28 21:54:40 UTC (rev 1338)
+++ cpu/x86/pc/olpc/fw.bth 2009-08-30 01:33:45 UTC (rev 1339)
@@ -222,11 +222,6 @@
fload ${BP}/cpu/x86/pc/boot.fth
fload ${BP}/cpu/x86/pc/linux.fth
-0 value keyboard-ih
-0 value screen-ih
-
-fload ${BP}/ofw/core/muxdev.fth \ I/O collection/distribution device
-
: usb-port-power-map ( -- n )
board-revision h# b10 h# b2f between if \ B1 and B2
h# 3ab \ USB4:PWR1 USB3:PWR1 USB2:PWR1 USB1:PWR2
@@ -325,13 +320,13 @@
true value text-on?
: text-off ( -- )
text-on? if
- screen-ih remove-mux
+ screen-ih remove-output
false to text-on?
then
;
: text-on ( -- )
text-on? 0= if
- screen-ih add-mux
+ screen-ih add-output
cursor-on
true to text-on?
then
@@ -375,11 +370,11 @@
[ifdef] use-ega
: ega-output ( -- )
- \ This only works if stdout is currently /display
- stdout @ if
- " text-mode3" screen-ih $call-method
+ screen-ih if
+ screen-ih remove-output
+ " text-mode3" screen-ih ['] $call-method catch if 3drop then
then
- " /ega-text" output
+ " /ega-text" open-dev add-output
;
[then]
Modified: cpu/x86/pc/olpc/gui.fth
===================================================================
--- cpu/x86/pc/olpc/gui.fth 2009-08-28 21:54:40 UTC (rev 1338)
+++ cpu/x86/pc/olpc/gui.fth 2009-08-30 01:33:45 UTC (rev 1339)
@@ -297,7 +297,7 @@
;
: logo-banner ( -- error? )
- display? 0= if true exit then
+ screen-ih 0= if true exit then
\ Do this later...
\ diagnostic-mode? 0= if ['] visual-error to .error then
Modified: cpu/x86/pc/olpc/via/devices.fth
===================================================================
--- cpu/x86/pc/olpc/via/devices.fth 2009-08-28 21:54:40 UTC (rev 1338)
+++ cpu/x86/pc/olpc/via/devices.fth 2009-08-30 01:33:45 UTC (rev 1339)
@@ -197,6 +197,11 @@
h# 3f8 is uart-base
fload ${BP}/forth/lib/sysuart.fth \ Use UART for key and emit
+0 value keyboard-ih
+0 value screen-ih
+
+fload ${BP}/ofw/core/muxdev.fth \ I/O collection/distribution device
+
[ifndef] save-flash
: save-flash ;
: restore-flash ;
Modified: cpu/x86/pc/olpc/via/fw.bth
===================================================================
--- cpu/x86/pc/olpc/via/fw.bth 2009-08-28 21:54:40 UTC (rev 1338)
+++ cpu/x86/pc/olpc/via/fw.bth 2009-08-30 01:33:45 UTC (rev 1339)
@@ -233,11 +233,6 @@
fload ${BP}/cpu/x86/pc/boot.fth
fload ${BP}/cpu/x86/pc/linux.fth
-0 value keyboard-ih
-0 value screen-ih
-
-fload ${BP}/ofw/core/muxdev.fth \ I/O collection/distribution device
-
fload ${BP}/cpu/x86/pc/olpc/via/usb.fth
false to stand-init-debug?
@@ -325,13 +320,13 @@
true value text-on?
: text-off ( -- )
text-on? if
- screen-ih remove-mux
+ screen-ih out-mux-ih remove-mux
false to text-on?
then
;
: text-on ( -- )
text-on? 0= if
- screen-ih add-mux
+ screen-ih out-mux-ih add-mux
cursor-on
true to text-on?
then
Modified: dev/olpc/spiflash/recover.fth
===================================================================
--- dev/olpc/spiflash/recover.fth 2009-08-28 21:54:40 UTC (rev 1338)
+++ dev/olpc/spiflash/recover.fth 2009-08-30 01:33:45 UTC (rev 1339)
@@ -17,8 +17,10 @@
\ ok recover disk:\file.rom \ Copies a ROM file to the dead one
: (serial-flash) ( -- )
- stdin @ 0= stdout @ 0= or abort" Can't use a serial console for this"
- console-io
+ \ Disconnect serial port from console multiplexor
+ ." Disconnecting serial port from OFW console" cr
+ fallback-in-ih remove-input
+ fallback-out-ih remove-output
." Connecting to dead machine. (Merging will take about 25 seconds.)" cr
use-serial-ec
Modified: ofw/core/muxdev.fth
===================================================================
--- ofw/core/muxdev.fth 2009-08-28 21:54:40 UTC (rev 1338)
+++ ofw/core/muxdev.fth 2009-08-30 01:33:45 UTC (rev 1339)
@@ -137,42 +137,53 @@
finish-device
device-end
-0 value mux-ih
+0 value in-mux-ih
+0 value out-mux-ih
-: open-mux ( -- )
- mux-ih 0= if
- " " " mux" $open-package
- dup 0= abort" Can't open mux package"
- to mux-ih
- then
+: new-mux ( -- ih )
+ " " " mux" $open-package
+ dup 0= abort" Can't open mux package"
;
-: add-mux ( ih -- )
- ?dup if " add-device" mux-ih $call-method then
+: add-mux ( ih mux-ih -- )
+ over if >r " add-device" r> $call-method else 2drop then
;
-: remove-mux ( ih -- ) " remove-device" mux-ih $call-method ;
+: remove-mux ( ih mux-ih -- ) >r " remove-device" r> $call-method ;
+: add-output ( ih -- ) out-mux-ih add-mux ;
+: remove-output ( ih -- ) out-mux-ih remove-mux ;
+: add-input ( ih -- ) in-mux-ih add-mux ;
+: remove-input ( ih -- ) in-mux-ih remove-mux ;
+
: .mux ( -- )
- mux-ih if
- " show-devices" mux-ih $call-method
- else
- ." Mux isn't open" cr
+ in-mux-ih if
+ ." Input mux:" cr
+ " show-devices" in-mux-ih $call-method
then
+ out-mux-ih if
+ ." Output mux:" cr
+ " show-devices" out-mux-ih $call-method
+ then
;
+0 value fallback-in-ih
+0 value fallback-out-ih
+
: install-mux-io ( -- )
- open-mux
+ new-mux to in-mux-ih
+ new-mux to out-mux-ih
- fallback-device open-dev add-mux
+ fallback-device open-dev dup to fallback-in-ih add-input
+ fallback-device open-dev dup to fallback-out-ih add-output
screen open-dev to screen-ih
- screen-ih add-mux
+ screen-ih add-output
keyboard open-dev to keyboard-ih
- keyboard-ih add-mux
+ keyboard-ih add-input
- mux-ih set-stdin mux-ih set-stdout
+ in-mux-ih set-stdin out-mux-ih set-stdout
console-io
;
9 years, 6 months
r1338 - cpu/x86/pc/olpc
by svn＠openfirmware.info
Author: wmb
Date: 2009-08-28 23:54:40 +0200 (Fri, 28 Aug 2009)
New Revision: 1338
Modified:
cpu/x86/pc/olpc/devices.fth
cpu/x86/pc/olpc/fw.bth
Log:
OLPC XO-1 - Updated XO-1 build to match changes to XO-1.5 build,
particularly relating to the use of full console multiplexing
instead of dualconsole.
Modified: cpu/x86/pc/olpc/devices.fth
===================================================================
--- cpu/x86/pc/olpc/devices.fth 2009-08-28 21:40:06 UTC (rev 1337)
+++ cpu/x86/pc/olpc/devices.fth 2009-08-28 21:54:40 UTC (rev 1338)
@@ -82,6 +82,8 @@
;
warning !
+fload ${BP}/dev/olpc/spiflash/flashif.fth \ Generic FLASH interface
+
\ Create the top-level device node to access the entire boot FLASH device
0 0 " fff00000" " /" begin-package
" flash" device-name
@@ -248,7 +250,6 @@
fload ${BP}/dev/geode/acpi.fth \ Power management
-fload ${BP}/dev/olpc/spiflash/flashif.fth \ Generic FLASH interface
fload ${BP}/dev/olpc/spiflash/memflash.fth \ Memory-mapped FLASH access
warning @ warning off
Modified: cpu/x86/pc/olpc/fw.bth
===================================================================
--- cpu/x86/pc/olpc/fw.bth 2009-08-28 21:40:06 UTC (rev 1337)
+++ cpu/x86/pc/olpc/fw.bth 2009-08-28 21:54:40 UTC (rev 1338)
@@ -222,6 +222,11 @@
fload ${BP}/cpu/x86/pc/boot.fth
fload ${BP}/cpu/x86/pc/linux.fth
+0 value keyboard-ih
+0 value screen-ih
+
+fload ${BP}/ofw/core/muxdev.fth \ I/O collection/distribution device
+
: usb-port-power-map ( -- n )
board-revision h# b10 h# b2f between if \ B1 and B2
h# 3ab \ USB4:PWR1 USB3:PWR1 USB2:PWR1 USB1:PWR2
@@ -238,10 +243,10 @@
hex
: i-key-wait ( ms -- pressed? )
- cr ." Type 'i' to interrupt stand-init sequence" cr
+ cr ." Type 'i' to interrupt stand-init sequence" cr ( ms )
0 do
- key? if
- key upc ascii I = if true unloop exit then
+ ukey? if
+ ukey upc ascii I = if true unloop exit then
then
1 ms
loop
@@ -252,7 +257,6 @@
: protect-fw ( -- ) secure? if ec-indexed-io-off then ;
-\ stand-init-debug? [if]
warning @ warning off
: init
\ initial-heap add-memory
@@ -274,7 +278,7 @@
[then]
then
;
-\ warning !
+warning !
[then]
: (.firmware) ( -- )
@@ -292,7 +296,6 @@
fload ${BP}/dev/null.fth
fload ${BP}/ofw/core/bailout.fth
-[ifdef] olpc
\ GUI
false value gui-safeboot?
@@ -303,13 +306,11 @@
true value user-mode?
fload ${BP}/cpu/x86/pc/olpc/banner.fth
-[then]
fload ${BP}/ofw/gui/loadmenu.fth
fload ${BP}/cpu/x86/pc/olpc/disptest.fth
\ fload ${BP}/ofw/gui/insticon.fth
-[ifdef] olpc
: setup-for-linux ( -- )
[ ' linux-hook behavior compile, ] \ Chain to old behavior
vpci-devices-on \ Do this after quieting USB
@@ -321,6 +322,21 @@
;
' screen-#lines to lines/page
+true value text-on?
+: text-off ( -- )
+ text-on? if
+ screen-ih remove-mux
+ false to text-on?
+ then
+;
+: text-on ( -- )
+ text-on? 0= if
+ screen-ih add-mux
+ cursor-on
+ true to text-on?
+ then
+;
+
fload ${BP}/cpu/x86/pc/olpc/help.fth
fload ${BP}/cpu/x86/pc/olpc/gui.fth
fload ${BP}/cpu/x86/pc/olpc/suspend.fth \ Suspend/resume setup
@@ -332,7 +348,6 @@
fload ${BP}/cpu/x86/pc/olpc/crypto.fth \ Cryptographic image validation
fload ${BP}/cpu/x86/pc/olpc/lzip.fth \ Access zip images from memory
fload ${BP}/cpu/x86/pc/olpc/gamekeys.fth
-fload ${BP}/cpu/x86/pc/olpc/memtest.fth
: emacs ( -- )
false to already-go?
@@ -357,7 +372,6 @@
[then]
fload ${BP}/cpu/x86/pc/olpc/rtcwake.fth
' gx-power-off to power-off
-[then]
[ifdef] use-ega
: ega-output ( -- )
@@ -419,7 +433,7 @@
then
ec-reboot \ Tell the EC to reboot us, so the EC can reset too
- begin again
+ begin halt again
;
' dcon-reset-all to reset-all
@@ -440,6 +454,7 @@
fload ${BP}/ofw/inet/http.fth \ HTTP client
end-support-package
+fload ${BP}/cpu/x86/pc/olpc/memtest.fth
fload ${BP}/ofw/wifi/wifi-cfg.fth
support-package: supplicant
@@ -486,8 +501,8 @@
" dhcp" ' ip-address set-config-string-default
-\ fload ${BP}/cpu/x86/pc/report.fth
-fload ${BP}/ofw/core/dualconsole.fth
+: c1-idle ( -- ) interrupts-enabled? if halt then ;
+' c1-idle to stdin-idle
: fast-boot? ( -- flag )
[ifdef] rom-loaded
@@ -503,6 +518,21 @@
1 h# 61 cmos! 1 h# 60 cmos!
;
+: console-start ( -- )
+ video-map cr
+
+ install-mux-io
+ cursor-off
+ true to text-on?
+
+
+ " //null" open-dev to null-ih \ For text-off state
+
+ ?gui-banner
+\ ." nvramrc" cr
+\ use-nvramrc? if nvramrc safe-evaluate then
+;
+
: interpreter-init ( -- )
hex
warning on
@@ -531,24 +561,6 @@
then ( )
;
-
-: console-start ( -- )
-[ifdef] rom-loaded
- video-map cr
-[then]
- " screen" open-dev ?dup if
- set-stdout
-\ logo-banner drop
-\ close-dev
-\ 0 stdout !
- then
-
- install-dual-console
-
- ?gui-banner
-\ ." nvramrc" cr
-\ use-nvramrc? if nvramrc safe-evaluate then
-;
: debug-interact ( -- )
early-interact? if
" Interrupting startup sequence prior to probing" .because
@@ -586,9 +598,6 @@
button-check button-x or button-o or button-square or ( mask )
game-key-mask = if protect-fw try-fs-update then
;
-: open-keyboard ( -- )
- " keyboard" open-dev ?dup if set-stdin then
-;
: ?resume-botch
h# 1454 pl@ 2 and if
@@ -619,17 +628,22 @@
then
read-game-keys
- stdout off \
+ text-off
+
" probe-" do-drop-in
probe-pci
+ show-child
+ install-alarm
sound
- open-keyboard
?games
+
['] false to interrupt-auto-boot?
probe-usb
" probe+" do-drop-in
+ report-disk
+ report-keyboard
setup-smbios \ Must be done after build-date is defined via do-drop-in
@@ -641,10 +655,12 @@
unblock-exceptions
['] (interrupt-auto-boot?) to interrupt-auto-boot?
?usb-keyboard
+ auto-banner? if banner then
+
auto-boot
- frozen? ( frozen? )
- unfreeze visible ( frozen? )
+ frozen? text-on? 0= and ( no-banner? )
+ unfreeze visible ( no-banner? )
if banner then \ Reissue banner if it was suppressed
blue-letters ." Type 'help' for more information." black-letters
9 years, 6 months
r1337 - in cpu/x86/pc/olpc: . via
by svn＠openfirmware.info
Author: wmb
Date: 2009-08-28 23:40:06 +0200 (Fri, 28 Aug 2009)
New Revision: 1337
Modified:
cpu/x86/pc/olpc/crypto.fth
cpu/x86/pc/olpc/security.fth
cpu/x86/pc/olpc/versions.fth
cpu/x86/pc/olpc/via/versions.fth
Log:
OLPC trac 9045 - added support for delegated keys - sig02: format.
Modified: cpu/x86/pc/olpc/crypto.fth
===================================================================
--- cpu/x86/pc/olpc/crypto.fth 2009-08-28 20:10:46 UTC (rev 1336)
+++ cpu/x86/pc/olpc/crypto.fth 2009-08-28 21:40:06 UTC (rev 1337)
@@ -19,8 +19,10 @@
: signature-bad? ( data$ sig$ key$ hashname$ -- mismatch? )
$cstr
- verify-bss /verify-bss erase ( data$ sig$ key$ 'hashname )
- verify-base verify-stack sp-call >r 3drop 4drop r> ( result )
+ verify-bss /verify-bss erase ( 0 data$ sig$ key$ 'hashname )
+ verify-base verify-stack sp-call >r ( 0 data$ sig$ key$ 'hashname )
+ 3drop 4drop begin 0= until ( )
+ r> ( result )
;
\ This is a hack that saves a lot of memory. The crypto verifier
@@ -33,7 +35,7 @@
variable hashlen
d# 128 buffer: hashbuf
: crypto-hash ( data$ hashname$ -- result$ )
- 2>r hashbuf d# 128 hashlen 0 2r> ( data$ sig$ key$ hashname$ )
+ 2>r 0 -rot hashbuf d# 128 hashlen 0 2r> ( 0 data$ sig$ key$ hashname$ )
signature-bad? abort" Hash failed" ( )
hashbuf hashlen @
;
Modified: cpu/x86/pc/olpc/security.fth
===================================================================
--- cpu/x86/pc/olpc/security.fth 2009-08-28 20:10:46 UTC (rev 1336)
+++ cpu/x86/pc/olpc/security.fth 2009-08-28 21:40:06 UTC (rev 1337)
@@ -196,90 +196,6 @@
sig-buf tuck - false ( sig$ false )
;
-\ parse-sig parses a "sig01:" format signature string, returning its
-\ hashname and signature substrings. It converts the signature
-\ substring from ASCII hex to binary bytes.
-
-: parse-sig ( sig01$ -- true | hashname$ sig$ false )
- dup d# 89 < if 2drop true exit then
- bl left-parse-string " sig01:" $= 0= if 2drop true exit then ( rem$ )
- bl left-parse-string dup d# 6 <> if 4drop true exit then 2swap ( hash$ rem$ )
- bl left-parse-string nip d# 64 <> if 4drop true exit then ( hash$ rem$ )
- newline left-parse-string 2swap nip 0<> if 4drop true exit then ( hash$ data$ )
- dup /sig 2* <> if ( ." Bad signature length" cr ) 2drop true exit then ( hash$ data$ )
-
- hex-decode if 2drop true else false then
-;
-
-\ zip-extent looks inside a memory-resident ZIP archive and returns
-\ the address,length of a given component of that archive. This
-\ assumes that the components are "stored", not "deflated". It
-\ depends on the existence of a support package named "/lzip" to
-\ do the work.
-
-: zip-extent ( name$ -- adr len )
- expand$ open-dev ?dup 0= if " " exit then
- >r
- " offset" r@ $call-method load-base +
- " size" r@ $call-method drop
- r> close-dev
-;
-
-\ sig$ and img$ find the signature and signed-image components of
-\ a ZIP bundle image that is already in memory.
-
-: sig$ ( -- adr len ) " /lzip:\data.sig" zip-extent ;
-: img$ ( -- adr len ) " /lzip:\data.img" zip-extent ;
-
-\ bundle-name$ returns the full OFW pathname of a signed image
-\ bundle, piecing it together from the device (DN), path (PN),
-\ filename head (CN), and filename body (FN) macros.
-
-: bundle-name$ ( -- $ ) " ${DN}${PN}\${CN}${FN}.zip" expand$ ;
-
-\ bundle-present? determines the existence (or not) of a signed image
-\ bundle whose name is constructed from the current settings of the
-\ device (DN), path (PN), filename head (CN), and filename body (FN).
-
-: .trying ( name$ -- name$ )
- " Trying " ?lease-debug 2dup ?lease-debug-cr
-;
-: bundle-present? ( fn$ -- flag )
- fn-buf place
- bundle-name$ .trying
- ['] (boot-read) catch if 2drop false exit then
- true
-;
-
-\ hashname remembers the most recently used hashname to guard against
-\ attacks based on reuse of the same (presumably compromized) hash.
-
-\ signature-invalid? checks the validity of data$ against the ASCII signature
-\ record sig01$, using the public key that thiskey$ points to.
-\ It also verifies that the hashname contained in sig01$ is the
-\ expected one.
-
-: signature-invalid? ( data$ sig01$ exp-hashname$ -- error? )
- 2>r
- parse-sig if
- ." Bad signature format" cr
- 2r> 2drop true exit
- then ( data$ hashname$ sig$ r: exp$ )
-
- \ Check for duplicate hashname attacks
- 2swap 2dup 2r> $= 0= if ( data$ sig$ hashname$ )
- ." Wrong hash name" cr
- 4drop 2drop true exit
- then ( data$ sig$ hashname$ )
-
- thiskey$ 2swap signature-bad? ( error? )
- dup if
- " Signature invalid" ?lease-error-cr
- else
- " Signature valid" ?lease-debug-cr
- then
-;
-
\ cut$ splits a string into an initial substring of length n
\ (head$) and the residual substring (tail$). If the input
\ string is shorter than n, head$ is the input string and tail$ is
@@ -291,12 +207,23 @@
over r@ - r> ( tail$ head$ )
;
-: sig01$>key$ ( sig01$ -- true | binary-key$ false )
- bl left-parse-string " sig01:" $= 0= if 2drop true exit then ( rem$ )
- bl left-parse-string 2drop \ Discard hash name ( rem$ )
- bl left-parse-string 2nip \ Get key signature ( key$ )
- /sig 2* min hex-decode if 2drop true exit then ( binary-key$ )
- false
+: sig$>key$ ( sig0N$ -- true | binary-key$ false )
+ bl left-parse-string ( rem$ signame$ )
+ 2dup " sig01:" $= if ( rem$ signame$ )
+ 2drop ( rem$ )
+ else ( rem$ signame$ )
+ " sig02:" $= 0= if ( rem$ )
+ 2drop true ( true )
+ exit
+ then ( rem$ )
+ then ( rem$ )
+ bl left-parse-string 2drop ( rem$ ) \ Discard hash name
+ bl left-parse-string 2nip ( key$ ) \ Get key signature
+ /sig 2* min hex-decode if ( key$ )
+ 2drop true ( true )
+ exit
+ then ( binary-key$ )
+ false ( binary-key$ false )
;
\ True if short$ matches the end of long$
@@ -316,19 +243,14 @@
2r> 4drop false
;
-: in-pubkey-list? ( sig01$ -- flag )
- sig01$>key$ if false exit then ( key$ )
- key-in-list? ( flag )
+: in-pubkey-list? ( sig0N$ -- flag )
+ sig$>key$ if false exit then ( key$ )
+ key-in-list? ( flag )
;
-: our-pubkey? ( sig01$ -- flag )
- sig01$>key$ if false exit then ( key$ )
- thiskey$ tail$= ( flag )
-;
-
-\ Look for a line that starts with "sig01: " whose key signature
+\ Look for a line that starts with "sig0N: " whose key signature
\ matches the trailing bytes of a public key in our current list.
-: next-sig01-in-list$ ( sig$ -- true | rem$ sig01$ false )
+: next-sig-in-list$ ( sig$ -- true | rem$ sig0N$ false )
begin dup while ( rem$ )
newline left-parse-string ( rem$' line$ )
2dup in-pubkey-list? if false exit then ( rem$ line$ )
@@ -338,36 +260,27 @@
2drop true
;
-\ Look for a line that starts with "sig01: " whose key signature
+\ Look for a line that starts with "sig0N: " whose key signature
\ matches the trailing bytes of our currently-selected public key.
-: next-sig01$ ( sig$ -- true | rem$ sig01$ false )
- begin dup while ( rem$ )
- newline left-parse-string ( rem$' line$ )
- 2dup our-pubkey? if false exit then ( rem$ line$ )
- 2drop ( rem$ )
- repeat ( rem$ )
+\ This differs from next-sig-in-list$ in that next-sig-in-list$
+\ looks for a signature that matches any public key in our list,
+\ whereas this looks for a second signature that matches the public
+\ key that next-sig-in-list$ already found.
+: next-sig$ ( sig$ -- true | rem$ sig0N$ false )
+ begin dup while ( rem$ )
+ newline left-parse-string ( rem$' line$ )
+ 2dup sig$>key$ 0= if ( rem$ line$ binary-key$ )
+ thiskey$ tail$= if ( rem$ line$ )
+ false ( rem$ sig0N$ false )
+ exit
+ then ( rem$ line$ )
+ then ( rem$ line$ )
+ 2drop ( rem$ )
+ repeat ( rem$ )
" No signature for our key" ?lease-error-cr
2drop true
;
-\ Find a sig01: line and check its sha256/rsa signature
-: sha-valid? ( data$ sig01$ -- okay? )
- next-sig01-in-list$ if 2drop false exit then ( data$ rem$ sig01$ )
- 2nip " sha256" signature-invalid? 0=
-;
-
-\ Find two sig01: lines, the first with sha256 and the second with rmd160,
-\ and check their signatures
-: fw-valid? ( data$ sig$ -- okay? )
- 2swap 2>r ( sig$ r: data$ )
- next-sig01-in-list$ if 2r> 2drop false exit then ( rem$ sig01$ )
- 2r@ 2swap sha-valid? 0= if ( rem$ r: data$ )
- 2r> 4drop false exit
- then ( rmd-sig$ r: data$ )
- next-sig01$ if 2r> 2drop false exit then ( rem$ sig01$ )
- 2nip 2r> 2swap " rmd160" signature-invalid? 0=
-;
-
\ numfield is a factor used for parsing 2-digit fields from date/time strings.
: numfield ( exp$ min max -- exp$' )
>r >r ( exp$ r: max min )
@@ -409,7 +322,7 @@
\ earliest is the earliest acceptable date value (in seconds).
\ It is the date that the first test version of this code was
- \ deployed. If a laptop has any earlier date that than, that
+ \ deployed. If a laptop has any earlier date, the
\ date is presumed bogus.
current-seconds [ " 20070101T000000Z" expiration-to-seconds drop ] literal - 0<
@@ -420,6 +333,9 @@
\ earlier than this machine's current time (from the real time clock).
: expired? ( expiration$ -- bad? )
+ \ Check for non-expiring case
+ 2dup " 00000000T000000Z" $= if 2drop false exit then
+
expiration-to-seconds if true exit then ( seconds )
\ If the date is bad, leases are deemed to have expired
@@ -428,9 +344,6 @@
current-seconds - 0<
;
-d# 1024 constant /sec-line-max
-/sec-line-max buffer: sec-line-buf
-
\ machine-id-buf is a buffer into which the machine signature string,
\ including serial number, UUID, and expiration time, is place.
\ That string is the signed object for lease and developer key verification.
@@ -478,10 +391,259 @@
: my-sn$ ( -- adr len ) machine-id-buf d# 11 ;
+\ parse-sig parses a "sig01:" format signature string, returning its
+\ hashname and signature substrings. It converts the signature
+\ substring from ASCII hex to binary bytes.
+
+: parse-sig ( sig01$ -- true | hashname$ sig$ false )
+ dup d# 89 < if 2drop true exit then
+ bl left-parse-string " sig01:" $= 0= if 2drop true exit then ( rem$ )
+ bl left-parse-string dup d# 6 <> if 4drop true exit then 2swap ( hash$ rem$ )
+ bl left-parse-string nip d# 64 <> if 4drop true exit then ( hash$ rem$ )
+ newline left-parse-string 2swap nip 0<> if 4drop true exit then ( hash$ data$ )
+ dup /sig 2* <> if ( ." Bad signature length" cr ) 2drop true exit then ( hash$ data$ )
+
+ hex-decode if 2drop true else false then
+;
+
+\ zip-extent looks inside a memory-resident ZIP archive and returns
+\ the address,length of a given component of that archive. This
+\ assumes that the components are "stored", not "deflated". It
+\ depends on the existence of a support package named "/lzip" to
+\ do the work.
+
+: zip-extent ( name$ -- adr len )
+ expand$ open-dev ?dup 0= if " " exit then
+ >r
+ " offset" r@ $call-method load-base +
+ " size" r@ $call-method drop
+ r> close-dev
+;
+
+\ sig$ and img$ find the signature and signed-image components of
+\ a ZIP bundle image that is already in memory.
+
+: sig$ ( -- adr len ) " /lzip:\data.sig" zip-extent ;
+: img$ ( -- adr len ) " /lzip:\data.img" zip-extent ;
+
+\ bundle-name$ returns the full OFW pathname of a signed image
+\ bundle, piecing it together from the device (DN), path (PN),
+\ filename head (CN), and filename body (FN) macros.
+
+: bundle-name$ ( -- $ ) " ${DN}${PN}\${CN}${FN}.zip" expand$ ;
+
+\ bundle-present? determines the existence (or not) of a signed image
+\ bundle whose name is constructed from the current settings of the
+\ device (DN), path (PN), filename head (CN), and filename body (FN).
+
+: .trying ( name$ -- name$ )
+ " Trying " ?lease-debug 2dup ?lease-debug-cr
+;
+: bundle-present? ( fn$ -- flag )
+ fn-buf place
+ bundle-name$ .trying
+ ['] (boot-read) catch if 2drop false exit then
+ true
+;
+
+\ hashname remembers the most recently used hashname to guard against
+\ attacks based on reuse of the same (presumably compromized) hash.
+
+0 [if]
+\ signature-invalid? checks the validity of data$ against the ASCII signature
+\ record sig0N$, using the public key that thiskey$ points to.
+\ It also verifies that the hashname contained in sig01$ is the
+\ expected one.
+
+: signature-invalid? ( data$ sig0N$ exp-hashname$ -- error? )
+ 2>r
+ parse-sig if
+ ." Bad signature format" cr
+ 2r> 2drop true exit
+ then ( data$ hashname$ sig$ r: exp$ )
+
+ \ Check for duplicate hashname attacks
+ 2swap 2dup 2r> $= 0= if ( data$ sig$ hashname$ )
+ ." Wrong hash name" cr
+ 4drop 2drop true exit
+ then ( data$ sig$ hashname$ )
+
+ 2>r 2>r 2>r 0 2r> 2r> 2r> ( 0 data$ sig$ hashname$ )
+ pubkey$ 2swap signature-bad? ( error? )
+ dup if
+ " Signature invalid" ?lease-error-cr
+ else
+ " Signature valid" ?lease-debug-cr
+ then
+;
+[then]
+
+0 0 2value exp-hashname$
+0 0 2value signed-data$
+
+\ sig01: hashname keyid signature
+: sig01-good? ( line$ -- good? )
+ \ Check that the hashname is as expected
+ bl left-parse-string ( line$ this-hashname$ )
+ exp-hashname$ $= 0= if ( line$ )
+ 2drop false exit
+ then ( line$' )
+
+ \ Check that the keyid matches our pubkey
+ bl left-parse-string ( line$' keyid$ )
+ /sig 2* min hex-decode if ( line$ )
+ 2drop false exit
+ then ( line$ binary-key$ )
+
+ key-in-list? 0= if ( line$ )
+ 2drop false exit
+ then ( line$ )
+
+ \ Check that the signature occupies the rest of the line
+ bl left-parse-string ( line$' sig$ )
+ 2swap nip 0<> if ( sig$ )
+ \ Trailing junk at the end
+ 2drop false exit
+ then ( sig$ )
+
+ dup /sig 2* <> if ( sig$ )
+ 2drop false exit
+ then ( sig$ )
+
+ hex-decode if ( )
+ false exit
+ then ( binary-sig$ )
+
+ \ Cryptographically verify the data against the signature
+ 2>r 0 signed-data$ 2r> thiskey$ exp-hashname$ signature-bad? 0=
+;
+
+h# 10e constant /key
+/key buffer: keybuf
+
+0 0 2value sig02-key$
+
+0 0 2value expiry$
+
+: sig02-good? ( line$ -- good? )
+ d# 100 0 do
+ \ Check that the hashname is as expected
+ bl left-parse-string ( line$' this-hashname$ )
+ exp-hashname$ $= 0= if ( line$ )
+ 2drop false unloop exit
+ then ( line$' )
+
+ \ Check that the keyid matches our pubkey, but only if it's
+ \ the first one
+ bl left-parse-string ( line$' pubkey$ )
+ hex-decode if ( line$ )
+ 2drop false unloop exit
+ then ( line$ binary-key$ )
+
+ i if ( line$ binary-key$ )
+ dup /key <> if ( line$ binary-key$ )
+ 4drop false unloop exit
+ then ( line$ binary-key$ )
+ tuck keybuf swap move ( line$ binary-keylen )
+ keybuf swap ( line$ binary-key$' )
+ else ( line$ binary-keyid$ )
+ key-in-list? 0= if ( line$ )
+ 2drop false unloop exit
+ then ( line$ )
+ thiskey$ ( line$ key$ )
+ then ( line$ key$ )
+ to sig02-key$ ( line$ )
+
+ \ Check the expiration date
+ bl left-parse-string to expiry$ ( line$' )
+ expiry$ expired? if ( line$ )
+ 2drop false unloop exit
+ then ( line$ )
+
+ \ Get the signature
+ bl left-parse-string ( line$ sig$)
+
+ dup /sig 2* <> if ( line$ sig$ )
+ 4drop false unloop exit
+ then ( line sig$ )
+
+ hex-decode if ( line$ )
+ 2drop false unloop exit
+ then ( line$ binary-sig$ )
+
+ 2>r ( line$' r: binary-sig$ )
+
+ \ If it's the final signature, check the signed data
+ dup 0= if ( line$ r: sig$ )
+ 2drop ( r: sig$ )
+ 0 signed-data$ " :" expiry$ " :" my-sn$ 2r> ( 0 data$ .. sig$ )
+ sig02-key$ exp-hashname$ signature-bad? 0= ( good? )
+ unloop exit
+ then ( line$ r: sig$ )
+
+ \ Otherwise check the next key in the list
+ 2dup bl left-parse-string 2drop ( line$ line$' r: sig$ ) \ Discard the hashname
+ bl left-parse-string 2nip 2>r ( line$ r: sig$ key$ )
+
+ 0 " "n" 2r> " :key01: " expiry$ " :" my-sn$ 2r> ( 0 data$ .. sig$ )
+ sig02-key$ exp-hashname$ signature-bad? if ( line$ )
+ 2drop false unloop exit
+ then ( line$ )
+ loop
+ true abort" Delegation too long"
+;
+
+: this-sig-line-good? ( line$ -- good? )
+ bl left-parse-string ( line$' tag$ )
+ 2dup " sig01:" $= if ( line$' tag$ )
+ 2drop sig01-good? ( good? )
+ exit
+ then ( line$' )
+ 2dup " sig02:" $= if ( line$' tag$ )
+ 2drop sig02-good? ( good? )
+ exit
+ then ( line$' tag$ )
+ 4drop false ( good? )
+;
+
+: signature-good? ( data$ sig$ hashname$ -- good? )
+ to exp-hashname$ ( data$ sig$ )
+ 2swap to signed-data$ ( sig$ )
+ begin dup while ( rem$ )
+ newline left-parse-string ( rem$' line$ )
+
+ this-sig-line-good? if ( rem$ )
+ 2drop true exit
+ then ( rem$ )
+
+ repeat ( rem$ )
+ 2drop false ( good? )
+;
+
+\ Find a sig0N: line and check its sha256/rsa signature
+: sha-valid? ( data$ sig01$ -- okay? )
+ next-sig-in-list$ if 2drop false exit then ( data$ rem$ sig01$ )
+ \ 2nip " sha256" signature-invalid? 0=
+ 2nip " sha256" signature-good?
+;
+
+\ Find two sig0N: lines, the first with sha256 and the second with rmd160,
+\ and check their signatures
+: fw-valid? ( data$ sig$ -- okay? )
+ 2swap 2>r ( sig$ r: data$ )
+ next-sig-in-list$ if 2r> 2drop false exit then ( rem$ sig01$ )
+ 2r@ 2swap sha-valid? 0= if ( rem$ r: data$ )
+ 2r> 4drop false exit
+ then ( rmd-sig$ r: data$ )
+ next-sig$ if 2r> 2drop false exit then ( rem$ sig01$ )
+\ 2nip 2r> 2swap " rmd160" signature-invalid? 0=
+ 2nip 2r> 2swap " rmd160" signature-good?
+;
+
+d# 1024 constant /sec-line-max
+/sec-line-max buffer: sec-line-buf
+
: check-expiry ( exp$ -- exp$ -1|0 )
- \ Check for non-expiring case
- 2dup " 00000000T000000Z" $= if 0 exit then
-
dup d# 16 <> if ( expiration$ )
" has bad expiration format" ?lease-error-cr
-1 exit
@@ -504,7 +666,8 @@
2over in-pubkey-list? if ( sig$ exp$ )
machine-id-buf d# 51 + swap move ( sig$ )
machine-id-buf d# 67 2swap ( id$ sig$ )
- " sha256" signature-invalid? if -1 else 1 then ( -1|1 )
+ \ " sha256" signature-invalid? if -1 else 1 then ( -1|1 )
+ " sha256" signature-good? if 1 else -1 then ( -1|1 )
else ( sig$ exp$ )
4drop 0 ( 0 )
then ( -1|0|1 )
Modified: cpu/x86/pc/olpc/versions.fth
===================================================================
--- cpu/x86/pc/olpc/versions.fth 2009-08-28 20:10:46 UTC (rev 1336)
+++ cpu/x86/pc/olpc/versions.fth 2009-08-28 21:40:06 UTC (rev 1337)
@@ -19,7 +19,7 @@
macro: WLAN_VERSION 5.110.22.p23
\ The bios_verify image
-macro: CRYPTO_VERSION 0.2
+macro: CRYPTO_VERSION 0.4
\ The multicast NAND updater code version
\ Use a specific git commit ID for a formal release or "test" for development.
Modified: cpu/x86/pc/olpc/via/versions.fth
===================================================================
--- cpu/x86/pc/olpc/via/versions.fth 2009-08-28 20:10:46 UTC (rev 1336)
+++ cpu/x86/pc/olpc/via/versions.fth 2009-08-28 21:40:06 UTC (rev 1337)
@@ -2,7 +2,7 @@
\ The overall firmware revision
macro: FW_MAJOR A
-macro: FW_MINOR 10
+macro: FW_MINOR 10a
\ The EC microcode
macro: EC_VERSION 1_9_9
@@ -23,7 +23,7 @@
\ macro: GET_WLAN cp "/c/Documents and Settings/Mitch Bradley/My Documents/OLPC/DiskImages/sd8686-9.70.7.p0.bin" sd8686.bin; cp "/c/Documents and Settings/Mitch Bradley/My Documents/OLPC/DiskImages/sd8686_helper.bin" sd8686_helper.bin
\ The bios_verify image
-macro: CRYPTO_VERSION 0.2
+macro: CRYPTO_VERSION 0.4
\ The multicast NAND updater code version
\ Use a specific git commit ID for a formal release or "test" for development.
9 years, 6 months
r1336 - cpu/x86/pc/olpc/via
by svn＠openfirmware.info
Author: wmb
Date: 2009-08-28 22:10:46 +0200 (Fri, 28 Aug 2009)
New Revision: 1336
Modified:
cpu/x86/pc/olpc/via/fw.bth
Log:
Via - call install-alarm earlier to ensure that the startup sound
turns off reliably.
Modified: cpu/x86/pc/olpc/via/fw.bth
===================================================================
--- cpu/x86/pc/olpc/via/fw.bth 2009-08-28 20:09:23 UTC (rev 1335)
+++ cpu/x86/pc/olpc/via/fw.bth 2009-08-28 20:10:46 UTC (rev 1336)
@@ -378,7 +378,6 @@
[ifdef] wlan-wackup
fload ${BP}/cpu/x86/pc/olpc/wlantest.fth
[then]
-
fload ${BP}/cpu/x86/pc/olpc/rtcwake.fth
" /xp u:\boot\olpc.fth ext:\boot\olpc.fth int:\boot\olpc.fth /prober /usb/ethernet /usb/wlan"
@@ -548,6 +547,8 @@
warning on
only forth also definitions
+ install-alarm
+
page-mode
#line off
@@ -641,8 +642,7 @@
install-alarm
sound
?games
- \ XXX we should put up the splash screen here
-
+
['] false to interrupt-auto-boot?
probe-usb
" probe+" do-drop-in
9 years, 6 months
r1335 - cpu/x86/pc/olpc/via
by svn＠openfirmware.info
Author: wmb
Date: 2009-08-28 22:09:23 +0200 (Fri, 28 Aug 2009)
New Revision: 1335
Modified:
cpu/x86/pc/olpc/via/devices.fth
Log:
Via - implemented ignore-power-button .
Modified: cpu/x86/pc/olpc/via/devices.fth
===================================================================
--- cpu/x86/pc/olpc/via/devices.fth 2009-08-28 20:08:38 UTC (rev 1334)
+++ cpu/x86/pc/olpc/via/devices.fth 2009-08-28 20:09:23 UTC (rev 1335)
@@ -213,7 +213,17 @@
fload ${BP}/dev/olpc/spiflash/spiif.fth \ Generic low-level SPI bus access
fload ${BP}/dev/olpc/spiflash/spiflash.fth \ SPI FLASH programming
fload ${BP}/dev/olpc/kb3700/ecspi.fth \ EC chip SPI FLASH access
-.( XXX Implement ignore-power-button) cr : ignore-power-button ( -- ) ;
+
+\ ignore-power-button is unnecessary on XO-1.5 because the PWR_BUT_OUT# signal
+\ is driven by the EC. If the EC is turned off for SPI FLASH writing, it won't
+\ assert PWR_BUT_OUT# . When the EC is on, it will "pull the plug" on the CPU
+\ after the power button has been held down for several seconds, regardless of
+\ what the CPU is doing. So the following implementation of ignore-power-button
+\ is mostly pointless in the system context. It does prevent the CPU from
+\ shutting down of its own accord, but the EC override pretty much masks that.
+
+: ignore-power-button ( -- ) h# 889b config-b@ 2 or h# 889b config-b! ;
+
fload ${BP}/dev/olpc/kb3700/ecio.fth \ I/O space access to EC chip
fload ${BP}/dev/via/spi/spi.fth \ Driver for Via SPI controller
fload ${BP}/dev/via/spi/bbspi.fth \ Tethered SPI FLASH programming
9 years, 6 months
r1334 - cpu/x86/pc/olpc/via
by svn＠openfirmware.info
Author: wmb
Date: 2009-08-28 22:08:38 +0200 (Fri, 28 Aug 2009)
New Revision: 1334
Modified:
cpu/x86/pc/olpc/via/usb.fth
Log:
Got rid of some stack cruft.
Modified: cpu/x86/pc/olpc/via/usb.fth
===================================================================
--- cpu/x86/pc/olpc/via/usb.fth 2009-08-28 20:07:46 UTC (rev 1333)
+++ cpu/x86/pc/olpc/via/usb.fth 2009-08-28 20:08:38 UTC (rev 1334)
@@ -59,6 +59,8 @@
" usb-keyboard" open-dev add-mux
exit
then
+ else ( devspec$ )
+ 2drop
then
" /usb/serial" open-dev ?dup if
red-letters ." Using USB serial console." cr black-letters
9 years, 6 months
r1333 - cpu/x86/pc cpu/x86/pc/olpc cpu/x86/pc/olpc/via dev/olpc/keyboard
by svn＠openfirmware.info
Author: wmb
Date: 2009-08-28 22:07:46 +0200 (Fri, 28 Aug 2009)
New Revision: 1333
Modified:
cpu/x86/pc/biosints.fth
cpu/x86/pc/olpc/acpi.fth
cpu/x86/pc/olpc/copynand.fth
cpu/x86/pc/olpc/disptest.fth
cpu/x86/pc/olpc/fsupdate.fth
cpu/x86/pc/olpc/nandstat.fth
cpu/x86/pc/olpc/suspend.fth
cpu/x86/pc/olpc/via/copynand.fth
dev/olpc/keyboard/selftest.fth
Log:
Eliminated "isn't unique" messages during compilation by fixing
some name collisions and adding "warning off" for intentional redefinitions.
Modified: cpu/x86/pc/biosints.fth
===================================================================
--- cpu/x86/pc/biosints.fth 2009-08-28 20:03:29 UTC (rev 1332)
+++ cpu/x86/pc/biosints.fth 2009-08-28 20:07:46 UTC (rev 1333)
@@ -1084,6 +1084,7 @@
mbr-boot? 0= if 2drop false exit then
+ 2 - le-w@ h# aa55 =
;
+warning @ warning off
: init-program ( -- )
loaded is-mbr? if
prep-rm
@@ -1095,7 +1096,6 @@
then
init-program
;
-
\ " rm-go" ' boot-command set-config-string-default
: execute-buffer ( adr len -- )
rm-prepped? if ( adr len )
@@ -1106,6 +1106,7 @@
then
execute-buffer
;
+warning !
0 value boot-sector#
1 value boot-#sectors
Modified: cpu/x86/pc/olpc/acpi.fth
===================================================================
--- cpu/x86/pc/olpc/acpi.fth 2009-08-28 20:03:29 UTC (rev 1332)
+++ cpu/x86/pc/olpc/acpi.fth 2009-08-28 20:07:46 UTC (rev 1333)
@@ -147,7 +147,7 @@
negate h# ff and r> r> + c!
;
-: memory-limit ( -- limit )
+: acpi-memory-limit ( -- limit )
" /memory" find-package 0= abort" No /memory node" ( phandle )
" available" rot get-package-property abort" No available property" ( $ )
-1 >r ( $ ) ( r: limit )
@@ -164,7 +164,7 @@
: setup-acpi ( -- )
\ This has to agree with the _SB's _INI method, which gets the memory size
\ from offset h# 180 in the EBDA
- memory-limit d# 10 rshift 'ebda h# 180 + l!
+ acpi-memory-limit d# 10 rshift 'ebda h# 180 + l!
\ Copy rsdt and fadt to low memory
rsdp rsdp-adr /rsdp move rsdp-adr h# 14 8 fix-checksum rsdp-adr /rsdp h# 20 fix-checksum
Modified: cpu/x86/pc/olpc/copynand.fth
===================================================================
--- cpu/x86/pc/olpc/copynand.fth 2009-08-28 20:03:29 UTC (rev 1332)
+++ cpu/x86/pc/olpc/copynand.fth 2009-08-28 20:07:46 UTC (rev 1333)
@@ -311,7 +311,7 @@
\ 6 - erased : show-erased
\ 7 - primary bad-block-table : show-bbt-block
\ 8 - secondary bad-block-table : show-bbt-block
-: show-status ( status eblock# -- )
+: show-block-type ( status eblock# -- )
swap case
0 of show-bad endof
1 of show-bad endof
@@ -391,11 +391,6 @@
," Secondary Bad Block Table" \ 8
end-string-array
-: show-block-status ( block# -- )
- dup show-eblock#
- nand-map + c@ status-descriptions count type kill-line
-;
-
: cell-border ( block# color -- )
swap >loc ( color x y )
-1 -1 xy+
@@ -404,19 +399,20 @@
3dup 0 1 xy+ 1 grid-h do-fill ( color x y )
1 grid-h xy+ grid-w 1 do-fill
;
-: lowlight ( block# -- ) background-rgb rgb>565 cell-border ;
-: highlight ( block# -- ) 0 cell-border ;
+: lowlight-block ( block# -- ) background-rgb rgb>565 cell-border ;
+: highlight-block ( block# -- ) 0 cell-border ;
: point-block ( block# -- )
- current-block lowlight
+ current-block lowlight-block
to current-block
- current-block highlight
+ current-block highlight-block
;
0 value nand-block-limit
: +block ( offset -- )
- current-block + nand-block-limit mod ( new-block )
- point-block
- current-block show-block-status
+ current-block + nand-block-limit mod ( new-block# )
+ dup point-block ( new-block# )
+ dup show-eblock# ( new-block# )
+ nand-map + c@ status-descriptions count type kill-line
;
: process-key ( char -- )
@@ -438,10 +434,10 @@
0 status-line 1- at-xy red-letters ." Arrows, fn Arrows to move, Esc to exit" black-letters cr
#nand-pages nand-pages/block / to nand-block-limit
0 to current-block
- current-block highlight
+ current-block highlight-block
false to examine-done?
begin key process-key examine-done? until
- current-block lowlight
+ current-block lowlight-block
;
: (scan-nand) ( -- )
@@ -459,7 +455,7 @@
i classify-block ( status )
i nand-pages/block / ( status eblock# )
2dup nand-map + c! ( status eblock# )
- show-status
+ show-block-type
nand-pages/block +loop ( )
show-done
Modified: cpu/x86/pc/olpc/disptest.fth
===================================================================
--- cpu/x86/pc/olpc/disptest.fth 2009-08-28 20:03:29 UTC (rev 1332)
+++ cpu/x86/pc/olpc/disptest.fth 2009-08-28 20:07:46 UTC (rev 1333)
@@ -68,6 +68,7 @@
drop
;
+warning @ warning off
: selftest ( -- error? )
depth d# 16 <> if false exit then
.horizontal-bars16
@@ -79,6 +80,7 @@
random-selftest
false
;
+warning !
device-end
Modified: cpu/x86/pc/olpc/fsupdate.fth
===================================================================
--- cpu/x86/pc/olpc/fsupdate.fth 2009-08-28 20:03:29 UTC (rev 1332)
+++ cpu/x86/pc/olpc/fsupdate.fth 2009-08-28 20:07:46 UTC (rev 1333)
@@ -11,13 +11,13 @@
0 value partition-map-offset
0 value next-partition-start
-0 value partition#
+0 value fs-partition#
d# 256 constant /partition-entry
-: partition-adr ( -- adr ) partition# /partition-entry * load-base + ;
+: partition-adr ( -- adr ) fs-partition# /partition-entry * load-base + ;
: max-nand-offset ( -- n ) " usable-page-limit" $call-nand /nand-page * ;
: add-partition ( name$ #eblocks -- )
- partition# " max#partitions" $call-nand >= abort" Partition map overflow"
+ fs-partition# " max#partitions" $call-nand >= abort" Partition map overflow"
-rot ( #eblocks name$ )
partition-adr /partition-entry erase ( #eblocks name$ )
@@ -36,11 +36,11 @@
next-partition-start + to next-partition-start ( )
next-partition-start max-nand-offset > abort" NAND size overflow"
- partition# 1+ to partition#
+ fs-partition# 1+ to fs-partition#
;
: start-partition-map ( -- )
load-base /nand-block h# ff fill
- 0 to partition#
+ 0 to fs-partition#
\ 0 to next-partition-start
" partition-map-page#" $call-nand /nand-page * to partition-map-offset
Modified: cpu/x86/pc/olpc/nandstat.fth
===================================================================
--- cpu/x86/pc/olpc/nandstat.fth 2009-08-28 20:03:29 UTC (rev 1332)
+++ cpu/x86/pc/olpc/nandstat.fth 2009-08-28 20:07:46 UTC (rev 1333)
@@ -3,8 +3,6 @@
d# 24 d# 24 2value ulhc
-d# 22 constant status-line
-
8 constant glyph-w
8 constant glyph-h
@@ -15,8 +13,6 @@
: xy+ ( x1 y1 x2 y2 -- x3 y3 ) rot + -rot + swap ;
: xy* ( x y w h -- x*w y*h ) rot * >r * r> ;
-0 value nand-block-limit
-
: do-fill ( color x y w h -- ) " fill-rectangle" $call-screen ;
\ States: 0:erased 1:bad 2:waiting for write 3:written
@@ -36,6 +32,9 @@
0 h# ff h# ff rgb>565 constant strange-color \ cyan
h# ff h# ff h# ff rgb>565 constant starting-color \ white
+0 value nand-block-limit
+d# 22 constant status-line
+
: gshow-init ( #eblocks -- )
#nand-pages nand-pages/block / to nand-block-limit
@@ -108,7 +107,7 @@
\ 6 - erased : show-erased
\ 7 - primary bad-block-table : show-bbt-block
\ 8 - secondary bad-block-table : show-bbt-block
-: show-status ( status eblock# -- )
+: show-block-status ( status eblock# -- )
swap case
0 of show-bad endof
1 of show-bad endof
@@ -197,16 +196,16 @@
3dup 0 1 xy+ 1 grid-h do-fill ( color x y )
1 grid-h xy+ grid-w 1 do-fill
;
-: lowlight ( block# -- ) background-rgb rgb>565 cell-border ;
-: highlight ( block# -- ) 0 cell-border ;
-: highlight-block ( block# -- )
- current-block lowlight
+: lowlight-block ( block# -- ) background-rgb rgb>565 cell-border ;
+: highlight-block ( block# -- ) 0 cell-border ;
+: point-block ( block# -- )
+ current-block lowlight-block
to current-block
- current-block highlight
+ current-block highlight-block
;
: +block ( offset -- )
current-block + nand-block-limit mod ( new-block )
- highlight-block
+ point-block
current-block show-block-status
;
@@ -228,10 +227,10 @@
: examine-nand ( -- )
0 status-line 1- at-xy red-letters ." Arrows, fn Arrows to move, Esc to exit" black-letters cr
0 to current-block
- current-block highlight
+ current-block highlight-block
false to examine-done?
begin key process-key examine-done? until
- current-block lowlight
+ current-block lowlight-block
;
: (scan-nand) ( -- )
@@ -253,7 +252,7 @@
i classify-block ( status )
i nand-pages/block / ( status eblock# )
2dup nand-map + c! ( status eblock# )
- show-status
+ show-block-status
nand-pages/block +loop ( )
show-done
Modified: cpu/x86/pc/olpc/suspend.fth
===================================================================
--- cpu/x86/pc/olpc/suspend.fth 2009-08-28 20:03:29 UTC (rev 1332)
+++ cpu/x86/pc/olpc/suspend.fth 2009-08-28 20:07:46 UTC (rev 1333)
@@ -74,13 +74,13 @@
s3
again
;
-: suspend
+: s3-suspend
" video-save" screen-ih $call-method \ Freeze display
s3
" video-restore" screen-ih $call-method \ Unfreeze display
" /usb@f,5" open-dev ?dup if " do-resume" 2 pick $call-method close-dev then
;
-alias s suspend
+alias s s3-suspend
\ LICENSE_BEGIN
\ Copyright (c) 2007 FirmWorks
Modified: cpu/x86/pc/olpc/via/copynand.fth
===================================================================
--- cpu/x86/pc/olpc/via/copynand.fth 2009-08-28 20:03:29 UTC (rev 1332)
+++ cpu/x86/pc/olpc/via/copynand.fth 2009-08-28 20:07:46 UTC (rev 1333)
@@ -249,11 +249,6 @@
," Secondary Bad Block Table" \ 8
end-string-array
-: show-block-status ( block# -- )
- dup show-eblock#
- nand-map + c@ status-descriptions count type kill-line
-;
-
: cell-border ( block# color -- )
swap >loc ( color x y )
-1 -1 xy+
@@ -272,9 +267,10 @@
0 value nand-block-limit
: +block ( offset -- )
- current-block + nand-block-limit mod ( new-block )
- point-block
- current-block show-block-status
+ current-block + nand-block-limit mod ( new-block# )
+ dup point-block ( new-block# )
+ dup show-eblock# ( new-block# )
+ nand-map + c@ status-descriptions count type kill-line
;
: process-key ( char -- )
Modified: dev/olpc/keyboard/selftest.fth
===================================================================
--- dev/olpc/keyboard/selftest.fth 2009-08-28 20:03:29 UTC (rev 1332)
+++ dev/olpc/keyboard/selftest.fth 2009-08-28 20:07:46 UTC (rev 1333)
@@ -417,6 +417,7 @@
: toss-keys ( -- ) begin key? while key drop repeat ;
+warning @ warning off
: selftest ( -- error? )
open 0= if true exit then
make-keys
@@ -430,6 +431,7 @@
close
false
;
+warning !
device-end
9 years, 6 months
r1332 - cpu/x86/pc
by svn＠openfirmware.info
Author: wmb
Date: 2009-08-28 22:03:29 +0200 (Fri, 28 Aug 2009)
New Revision: 1332
Modified:
cpu/x86/pc/resetend.fth
Log:
resetend.fth - fixed GDT copying problem that was breaking the
GRUB-loaded variant.
Modified: cpu/x86/pc/resetend.fth
===================================================================
--- cpu/x86/pc/resetend.fth 2009-08-27 18:53:11 UTC (rev 1331)
+++ cpu/x86/pc/resetend.fth 2009-08-28 20:03:29 UTC (rev 1332)
@@ -10,21 +10,26 @@
\ the pointer since 0 is an invalid descriptor number anyway.
gdt-pa # ax mov
0 [ax] sgdt \ Read GDT
- 2 [ax] si mov \ GDT base
+ 2 [ax] bx mov \ GDT base
0 [ax] cx mov \ GDT limit
ffff # cx and
cx inc
+ gdt-size # cx cmp u> if
+ gdt-size # cx mov
+ then
+
+ bx si mov \ Source address for copy - old GDT
gdt-pa # di mov \ New GDT base
- rep movsb \ Copy ROM GDT to RAM
+ rep movsb \ Copy old GDT to new GDT
\ Move the code and data descriptors to 60,68
gdt-pa h# 60 + # di mov \ Destination - New descriptor 0x60
- cs si mov 2 [ax] si add \ Source - Current code descriptor
+ cs si mov bx si add \ Source - Current code descriptor
movs movs \ 2 longwords (1 descriptor) -> 60
- ds si mov 2 [ax] si add \ Source - Current data descriptor
+ ds si mov bx si add \ Source - Current data descriptor
movs movs \ 2 longwords (1 descriptor) -> 68
op: gdt-size 1- # 0 [ax] mov \ New GDT size
9 years, 6 months
r1331 - ofw/core
by svn＠openfirmware.info
Author: wmb
Date: 2009-08-27 20:53:11 +0200 (Thu, 27 Aug 2009)
New Revision: 1331
Modified:
ofw/core/muxdev.fth
Log:
Muxdev - propagate the ring-bell method.
Modified: ofw/core/muxdev.fth
===================================================================
--- ofw/core/muxdev.fth 2009-08-26 23:54:20 UTC (rev 1330)
+++ ofw/core/muxdev.fth 2009-08-27 18:53:11 UTC (rev 1331)
@@ -12,6 +12,7 @@
/n field >ihandle
/n field >read
/n field >write
+ /n field >bell
constant /list-node
: read ( adr len -- actual )
@@ -40,6 +41,17 @@
repeat ( adr len listnode )
drop nip
;
+: ring-bell ( -- )
+ first-device @
+ begin dup while ( listnode )
+ >r ( )
+ r@ >bell @ ?dup if ( xt )
+ r@ >ihandle @ call-package ( )
+ then ( )
+ r> >link @ ( listnode' )
+ repeat ( listnode )
+ drop
+;
: show-devices ( -- )
first-device @
@@ -61,13 +73,16 @@
ihandle>phandle ( phandle r: listnode )
- " read" 2 pick find-method 0= if 0 then ( phandle xt r: listnode )
+ " read" third find-method 0= if 0 then ( phandle xt r: listnode )
r@ >read !
- " write" 2 pick find-method 0= if 0 then ( phandle xt r: listnode )
+ " write" third find-method 0= if 0 then ( phandle xt r: listnode )
r@ >write ! ( phandle r: listnode )
- " install-abort" 2 pick find-method if ( phandle xt r: listnode )
+ " ring-bell" third find-method 0= if 0 then ( phandle xt r: listnode )
+ r@ >bell ! ( phandle r: listnode )
+
+ " install-abort" third find-method if ( phandle xt r: listnode )
r@ >ihandle @ call-package ( phandle r: listnode )
then ( phandle r: listnode )
9 years, 6 months