Return to selftest.fs CVS log

Up to [Qemu by Fabrice Bellard] / qemu / roms / openbios / forth / admin

Annotation of qemu/roms/openbios/forth/admin/selftest.fs, revision 1.1.1.1

1.1       root        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:   ;

This archive runs on limited infrastructure. Preserving old code on modern bandwidth. Automated agents are requested to crawl responsibly.