|
|
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
This archive runs on limited infrastructure. Preserving old code on modern bandwidth. Automated agents are requested to crawl responsibly.