qemu/roms/openbios/forth/admin/selftest.fs

   1 \ tag: self-test
   2 \
   3 \ this code implements IEEE 1275-1994 ch. 7.4.8
   4 \
   5 \ Copyright (C) 2003 Stefan Reinauer
   6 \
   7 \ See the file "COPYING" for further information about
   8 \ the copyright and warranty status of this work.
   9 \
  10
  11 \
  12 \ 7.4.8    Self-test
  13 \
  14
  15 : $test ( devname-addr devname-len -- )
  16   2dup ." Testing device " type ." : "
  17   find-dev if
  18     s" self-test" rot find-method if
  19       execute
  20     else
  21       ." no self-test method."
  22     then
  23   else
  24     ." no such device."
  25   then
  26   cr
  27 ;
  28
  29 : test    ( "device-specifier<cr>"-- )
  30   linefeed parse cr $test
  31   ;
  32
  33 : test-sub-devs
  34   >dn.child @
  35   begin dup while
  36     dup get-package-path $test
  37     dup recurse
  38     >dn.peer @
  39   repeat
  40   drop
  41 ;
  42
  43 : test-all    ( "{device-specifier}<cr>" -- )
  44   active-package
  45   cr " /" find-device
  46   linefeed parse find-device
  47   ?active-package test-sub-devs
  48   active-package!
  49   ;