qemu/roms/openbios/packages/disk-label.fs

   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