Annotation of qemu/roms/openbios/packages/disk-label.fs, revision 1.1.1.1

1.1       root        1: \ tag: Utility functions
                      2: \ 
                      3: \ deblocker / filesystem support
                      4: \ 
                      5: \ Copyright (C) 2003, 2004 Samuel Rydh
                      6: \ 
                      7: \ See the file "COPYING" for further information about
                      8: \ the copyright and warranty status of this work.
                      9: \ 
                     10: 
                     11: dev /packages
                     12: 
                     13: \ -------------------------------------------------------------
                     14: \ /packages/disk-label (partition handling)
                     15: \ -------------------------------------------------------------
                     16: 
                     17: [IFDEF] CONFIG_DISK_LABEL
                     18:   
                     19: new-device
                     20:   " disk-label" device-name
                     21:   external
                     22: 
                     23:   variable part-handlers      \ list with (probe-xt, phandle) elements
                     24:   variable fs-handlers        \ list with (fs-probe-xt, phandle) elements
                     25:   
                     26:   : find-part-handler ( block0 -- phandle | 0 )
                     27:     >r part-handlers
                     28:     begin list-get while
                     29:       ( nextlist dictptr )
                     30:       r@ over @ execute if
                     31:         ( nextlist dictptr )
                     32:         na1+ @ r> rot 2drop exit
                     33:       then
                     34:       drop
                     35:     repeat
                     36:     r> drop 0
                     37:   ;
                     38: 
                     39:   : find-filesystem ( offs.d ih -- ph | 0 )
                     40:     >r fs-handlers     ( offs.d listhead )
                     41:     begin list-get while
                     42:       2over    ( offs.d nextlist dictptr offs.d )
                     43:       r@       ( offs.d nextlist dictptr offs.d ih )
                     44:        3 pick  ( offs.d nextlist dictptr offs.d ih dictptr )
                     45:        @       ( offs.d nextlist dictptr offs.d ih probe-xt )
                     46:        execute ( offs.d nextlist dictptr flag? )
                     47:        if
                     48:                ( offs.d nextlist dictptr )
                     49:                na1+    ( offs.d nextlist dictptr+1 ) 
                     50:                @       ( offs.d nextlist phandle )
                     51:                r>      ( offs.d nextlist phandle ih )
                     52:                rot     ( offs.d phandle ih nextlist )
                     53:                2drop   ( offs.d phandle )
                     54:                -rot    ( phandle offs.d )
                     55:                2drop   ( phandle )
                     56:                exit
                     57:        then
                     58:       drop     ( offs.d nextlist )
                     59:     repeat
                     60:     2drop      ( offs.d )
                     61:     r> drop 0
                     62:   ;
                     63: 
                     64: 
                     65:   : register-part-handler ( handler-ph -- )
                     66:     dup " probe" rot find-method
                     67:     0= abort" Missing probe method!"
                     68:     ( phandle probe-xt )
                     69:     part-handlers list-add , ,
                     70:   ;
                     71: 
                     72:   : register-fs-handler ( handler-ph -- )
                     73:     dup " probe" rot find-method
                     74:     0= abort" Missing probe method!"
                     75:     ( phandle probe-xt )
                     76:     fs-handlers list-add , ,
                     77:   ;
                     78: finish-device
                     79: 
                     80: \ ---------------------------------------------------------------------------
                     81: \ methods to register partion and filesystem packages used by disk-label
                     82: \ ---------------------------------------------------------------------------
                     83: 
                     84: device-end
                     85: : register-partition-package ( -- )
                     86:   " register-part-handler" " disk-label" $find-package-method ?dup if
                     87:     active-package swap execute
                     88:   else
                     89:     ." [disk-label] internal error" cr
                     90:   then
                     91: ;
                     92: 
                     93: : register-fs-package ( -- )
                     94:   " register-fs-handler" " disk-label" $find-package-method ?dup if  
                     95:     active-package swap execute
                     96:   else
                     97:     ." [misc-files] internal error" cr
                     98:   then
                     99: ;
                    100: 
                    101: [THEN]
                    102: device-end

unix.superglobalmegacorp.com

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