X-Git-Url: https://gerrit.opnfv.org/gerrit/gitweb?a=blobdiff_plain;f=qemu%2Froms%2Fopenbios%2Fforth%2Fadmin%2Fselftest.fs;fp=qemu%2Froms%2Fopenbios%2Fforth%2Fadmin%2Fselftest.fs;h=20c0c963bd9a83adf3e76082f205db8bfc0c921a;hb=e44e3482bdb4d0ebde2d8b41830ac2cdb07948fb;hp=0000000000000000000000000000000000000000;hpb=9ca8dbcc65cfc63d6f5ef3312a33184e1d726e00;p=kvmfornfv.git

diff --git a/qemu/roms/openbios/forth/admin/selftest.fs b/qemu/roms/openbios/forth/admin/selftest.fs
new file mode 100644
index 000000000..20c0c963b
--- /dev/null
+++ b/qemu/roms/openbios/forth/admin/selftest.fs
@@ -0,0 +1,49 @@
+\ tag: self-test
+\ 
+\ this code implements IEEE 1275-1994 ch. 7.4.8
+\ 
+\ Copyright (C) 2003 Stefan Reinauer
+\ 
+\ See the file "COPYING" for further information about
+\ the copyright and warranty status of this work.
+\ 
+
+\ 
+\ 7.4.8    Self-test
+\ 
+
+: $test ( devname-addr devname-len -- )
+  2dup ." Testing device " type ." : "
+  find-dev if
+    s" self-test" rot find-method if
+      execute
+    else 
+      ." no self-test method."
+    then
+  else
+    ." no such device."
+  then
+  cr
+;
+
+: test    ( "device-specifier<cr>"-- )
+  linefeed parse cr $test
+  ;
+  
+: test-sub-devs
+  >dn.child @
+  begin dup while
+    dup get-package-path $test
+    dup recurse
+    >dn.peer @
+  repeat
+  drop
+;
+  
+: test-all    ( "{device-specifier}<cr>" -- )
+  active-package
+  cr " /" find-device
+  linefeed parse find-device
+  ?active-package test-sub-devs
+  active-package!
+  ;