Changeset 2688


Ignore:
Timestamp:
Nov 15, 2011, 2:14:11 AM (3 years ago)
Author:
wmb
Message:

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

Files:
2 edited

Legend:

Unmodified
Added
Removed
  • cpu/x86/pc/olpc/gamekeys.fth

    r2387 r2688  
    3535: game-key?  ( mask -- flag )  game-key-mask and 0<>  ; 
    3636 
    37 : (hold-message)  ( ms -- ) 
     37: gamekey-pause-message  ( decisecs -- decisecs' ) 
     38   button-rotate game-key@ and  if                   ( decisecs ) 
     39      (cr ." Release the game button to continue"    ( decisecs ) 
     40      begin  button-rotate game-key@ and  while  d# 100 ms  repeat 
     41      (cr kill-line                                  ( decisecs ) 
     42      drop 0                                         ( decisecs' ) 
     43   then                                              ( decisecs ) 
     44; 
     45' gamekey-pause-message to pause-message 
     46 
     47: olpc-hold-message 
    3848[ifdef] test-station 
    39    test-station  1 5 between  if  drop exit  then 
     49   test-station  1 5 between  if  drop false exit  then 
    4050[then] 
    41    d# 100 /            ( decisecs ) 
    42    begin  dup  while   ( decisecs ) 
    43       dup d# 10 /mod  swap  if  drop  else  (cr .d  then   ( decisecs ) 
    44       d# 100 ms        ( decisecs ) 
    45       1-               ( decisecs ) 
    46       button-rotate game-key@ and  if  ( decisecs ) 
    47          (cr ." Release the game button to continue" 
    48          begin  button-rotate game-key@ and  while  d# 100 ms  repeat 
    49          (cr kill-line 
    50          drop exit 
    51       then 
    52    repeat 
    53    drop  (cr kill-line 
     51   (hold-message) 
     52   (cr kill-line 
    5453; 
    55 ' (hold-message) to hold-message 
     54' olpc-hold-message to hold-message 
    5655 
    5756: bypass-bios-boot?  ( -- flag )  button-square game-key?  ; 
  • ofw/core/ofwcore.fth

    r2610 r2688  
    32573257; 
    32583258 
     3259: flush-keyboard  ( -- )  begin  key?  while  key drop  repeat  ; 
     3260defer pause-message ( decisecs -- decisecs' )  ' noop to pause-message 
    32593261defer hold-message 
    3260 ' ms to hold-message 
    3261  
    3262 : most-tests  ( -- ) 
    3263    method-name 2@  current-device  (search-wordlist)  if  ( xt ) 
     3262: (hold-message)  ( ms -- exit? ) 
     3263   flush-keyboard 
     3264   d# 100 /                                              ( decisecs ) 
     3265   begin  dup  while                                     ( decisecs ) 
     3266      dup d# 10 /mod  swap  if  drop  else  (cr .d  then ( decisecs ) 
     3267      d# 100 ms   1-                                     ( decisecs' ) 
     3268      pause-message                                      ( decisecs ) 
     3269      key?  if                                           ( decisecs ) 
     3270         key h# 1b =  if                                 ( decisecs ) 
     3271            cr ." Selftest stopped from keyboard" cr     ( decisecs ) 
     3272            drop true  exit                              ( -- true ) 
     3273         then                                            ( decisecs ) 
     3274      then                                               ( decisecs ) 
     3275   repeat                                                ( decisecs ) 
     3276   drop  false                                           ( false ) 
     3277; 
     3278' (hold-message) to hold-message 
     3279 
     3280: most-tests  ( -- exit? ) 
     3281   " selftest"  current-device  (search-wordlist)  if  ( xt ) 
    32643282 
    32653283      drop                                              (  ) 
     
    32753293 
    32763294      ??cr ." Testing "  pwd 
    3277       method-name 2@  current-device              ( method-adr,len phandle ) 
     3295      " selftest"  current-device                 ( method-adr,len phandle ) 
    32783296      execute-phandle-method  if                  ( result ) 
    32793297         ?dup  if 
     
    32813299            ??cr ." Selftest failed. Return code = " .d cr 
    32823300            black-letters 
    3283             d# 10000 hold-message 
     3301            d# 10000                              ( delay-ms ) 
    32843302         else 
    32853303            green-letters 
    32863304            ." Okay" cr 
    32873305            black-letters 
    3288             d# 2000 hold-message 
    3289          then 
     3306            d# 2000                               ( delay-ms ) 
     3307         then                                     ( delay-ms ) 
    32903308      else 
    32913309         red-letters 
    32923310         ." Selftest failed due to abort"  cr 
    32933311         black-letters 
    3294          d# 10000 hold-message 
    3295       then 
    3296    then                                            (  ) 
     3312         d# 10000                                 ( delay-ms ) 
     3313      then                                        ( delay-ms ) 
     3314      hold-message                                ( exit? ) 
     3315   else 
     3316      false                                       ( exit? ) 
     3317   then                                           ( exit? ) 
     3318; 
     3319 
     3320\ "action-acf" is executed for each device node in the subtree 
     3321\ rooted at dev-addr,len , with current-device set to the 
     3322\ node in question.  "action-acf" can perform arbitrary tests 
     3323\ on the node to determine if that node is appropriate for 
     3324\ the action that it wished to undertake. 
     3325 
     3326: test-subtree  ( dev-addr,len -- ) 
     3327   current-device >r                ( dev-addr,len r: phandle ) 
     3328   find-device                      ( r: phandle xt ) 
     3329   ['] most-tests  ['] (search-preorder)  catch  2drop  ( r: phandle xt ) 
     3330   r> push-device                   ( ) 
    32973331; 
    32983332 
    32993333: test-all  ( -- ) 
    33003334   optional-arg-or-/$ 
    3301    " selftest" method-name 2! 
    3302    ['] most-tests  scan-subtree 
     3335   test-subtree 
    33033336; 
    33043337 
Note: See TracChangeset for help on using the changeset viewer.