Changeset 2688

Timestamp:

Nov 15, 2011 2:14:11 AM (18 months ago)

Author:

wmb

Message:

OLPC trac 11427 - selftests can now be interrupted by typing ESC during the inter-test delay.

Files:

• cpu/x86/pc/olpc/gamekeys.fth (modified) (1 diff)
• ofw/core/ofwcore.fth (modified) (3 diffs)

cpu/x86/pc/olpc/gamekeys.fth

@@ -35 +35 @@
 : game-key?  ( mask -- flag )  game-key-mask and 0<>  ;
 
-: (hold-message)  ( ms -- )
+: gamekey-pause-message  ( decisecs -- decisecs' )
+   button-rotate game-key@ and  if                   ( decisecs )
+      (cr ." Release the game button to continue"    ( decisecs )
+      begin  button-rotate game-key@ and  while  d# 100 ms  repeat
+      (cr kill-line                                  ( decisecs )
+      drop 0                                         ( decisecs' )
+   then                                              ( decisecs )
+;
+' gamekey-pause-message to pause-message
+
+: olpc-hold-message
 [ifdef] test-station
-   test-station  1 5 between  if  drop exit  then
+   test-station  1 5 between  if  drop false exit  then
 [then]
-   d# 100 /            ( decisecs )
-   begin  dup  while   ( decisecs )
-      dup d# 10 /mod  swap  if  drop  else  (cr .d  then   ( decisecs )
-      d# 100 ms        ( decisecs )
-      1-               ( decisecs )
-      button-rotate game-key@ and  if  ( decisecs )
-         (cr ." Release the game button to continue"
-         begin  button-rotate game-key@ and  while  d# 100 ms  repeat
-         (cr kill-line
-         drop exit
-      then
-   repeat
-   drop  (cr kill-line
+   (hold-message)
+   (cr kill-line
 ;
-' (hold-message) to hold-message
+' olpc-hold-message to hold-message
 
 : bypass-bios-boot?  ( -- flag )  button-square game-key?  ;

ofw/core/ofwcore.fth

@@ -3257 +3257 @@
 ;
 
+: flush-keyboard  ( -- )  begin  key?  while  key drop  repeat  ;
+defer pause-message ( decisecs -- decisecs' )  ' noop to pause-message
 defer hold-message
-' ms to hold-message
-
-: most-tests  ( -- )
-   method-name 2@  current-device  (search-wordlist)  if  ( xt )
+: (hold-message)  ( ms -- exit? )
+   flush-keyboard
+   d# 100 /                                              ( decisecs )
+   begin  dup  while                                     ( decisecs )
+      dup d# 10 /mod  swap  if  drop  else  (cr .d  then ( decisecs )
+      d# 100 ms   1-                                     ( decisecs' )
+      pause-message                                      ( decisecs )
+      key?  if                                           ( decisecs )
+         key h# 1b =  if                                 ( decisecs )
+            cr ." Selftest stopped from keyboard" cr     ( decisecs )
+            drop true  exit                              ( -- true )
+         then                                            ( decisecs )
+      then                                               ( decisecs )
+   repeat                                                ( decisecs )
+   drop  false                                           ( false )
+;
+' (hold-message) to hold-message
+
+: most-tests  ( -- exit? )
+   " selftest"  current-device  (search-wordlist)  if  ( xt )
 
       drop                                              (  )
@@ -3275 +3293 @@
 
       ??cr ." Testing "  pwd
-      method-name 2@  current-device              ( method-adr,len phandle )
+      " selftest"  current-device                 ( method-adr,len phandle )
       execute-phandle-method  if                  ( result )
          ?dup  if
@@ -3281 +3299 @@
             ??cr ." Selftest failed. Return code = " .d cr
             black-letters
-            d# 10000 hold-message
+            d# 10000                              ( delay-ms )
          else
             green-letters
             ." Okay" cr
             black-letters
-            d# 2000 hold-message
-         then
+            d# 2000                               ( delay-ms )
+         then                                     ( delay-ms )
       else
          red-letters
          ." Selftest failed due to abort"  cr
          black-letters
-         d# 10000 hold-message
-      then
-   then                                            (  )
+         d# 10000                                 ( delay-ms )
+      then                                        ( delay-ms )
+      hold-message                                ( exit? )
+   else
+      false                                       ( exit? )
+   then                                           ( exit? )
+;
+
+\ "action-acf" is executed for each device node in the subtree
+\ rooted at dev-addr,len , with current-device set to the
+\ node in question.  "action-acf" can perform arbitrary tests
+\ on the node to determine if that node is appropriate for
+\ the action that it wished to undertake.
+
+: test-subtree  ( dev-addr,len -- )
+   current-device >r                ( dev-addr,len r: phandle )
+   find-device                      ( r: phandle xt )
+   ['] most-tests  ['] (search-preorder)  catch  2drop  ( r: phandle xt )
+   r> push-device                   ( )
 ;
 
 : test-all  ( -- )
    optional-arg-or-/$
-   " selftest" method-name 2!
-   ['] most-tests  scan-subtree
+   test-subtree
 ;