![[BACK]](/cvsweb/icons/back.gif){kind=icon}
Return to ext2-files.fs CVS log ![[TXT]](/cvsweb/icons/text.gif){kind=icon}
![[DIR]](/cvsweb/icons/dir.gif){kind=icon}
Up to [Qemu by Fabrice Bellard] / qemu / roms / SLOF / slof / fs / packages|
Return to ext2-files.fs CVS log | Up to [Qemu by Fabrice Bellard] / qemu / roms / SLOF / slof / fs / packages |
1.1 root 1: \ *****************************************************************************
2: \ * Copyright (c) 2004, 2008 IBM Corporation
3: \ * All rights reserved.
4: \ * This program and the accompanying materials
5: \ * are made available under the terms of the BSD License
6: \ * which accompanies this distribution, and is available at
7: \ * http://www.opensource.org/licenses/bsd-license.php
8: \ *
9: \ * Contributors:
10: \ * IBM Corporation - initial implementation
11: \ ****************************************************************************/
12: s" ext2-files" device-name
13:
14: INSTANCE VARIABLE first-block
15: INSTANCE VARIABLE block-size
16: INSTANCE VARIABLE inodes/group
17:
18: INSTANCE VARIABLE group-descriptors
19:
20: : seek s" seek" $call-parent ;
21: : read s" read" $call-parent ;
22:
23: INSTANCE VARIABLE data
24: INSTANCE VARIABLE #data
25:
26: : free-data
27: data @ ?dup IF #data @ free-mem 0 data ! THEN ;
28: : read-data ( offset size -- )
29: free-data dup #data ! alloc-mem data !
30: xlsplit seek -2 and ABORT" ext2-files read-data: seek failed"
31: data @ #data @ read #data @ <> ABORT" ext2-files read-data: read failed" ;
32:
33: : read-block ( block# -- )
34: block-size @ * block-size @ read-data ;
35:
36: INSTANCE VARIABLE inode
37: INSTANCE VARIABLE file-len
38: INSTANCE VARIABLE blocks
39: INSTANCE VARIABLE #blocks
40: INSTANCE VARIABLE ^blocks
41: INSTANCE VARIABLE #blocks-left
42: : blocks-read ( n -- ) dup negate #blocks-left +! 4 * ^blocks +! ;
43: : read-indirect-blocks ( indirect-block# -- )
44: read-block data @ data off
45: dup #blocks-left @ 4 * block-size @ min dup >r ^blocks @ swap move
46: r> 2 rshift blocks-read block-size @ free-mem ;
47: : read-double-indirect-blocks ( double-indirect-block# -- )
48: \ TBD
49: ;
50: : read-triple-indirect-blocks ( triple-indirect-block# -- )
51: \ TBD
52: ;
53: : read-block#s ( -- )
54: blocks @ ?dup IF #blocks @ 4 * free-mem THEN
55: inode @ 4 + l@-le file-len !
56: file-len @ block-size @ // #blocks !
57: #blocks @ 4 * alloc-mem blocks !
58: blocks @ ^blocks ! #blocks @ #blocks-left !
59: #blocks-left @ c min \ # direct blocks
60: inode @ 28 + over 4 * ^blocks @ swap move blocks-read
61: #blocks-left @ IF inode @ 58 + l@-le read-indirect-blocks THEN
62: #blocks-left @ IF inode @ 5c + l@-le read-double-indirect-blocks THEN
63: #blocks-left @ IF inode @ 60 + l@-le read-triple-indirect-blocks THEN ;
64: : read-inode ( inode# -- )
65: 1- inodes/group @ u/mod \ # in group, group #
66: 20 * group-descriptors @ + 8 + l@-le block-size @ * \ # in group, inode table
67: swap 80 * + xlsplit seek drop inode @ 80 read drop ;
68:
69: : .rwx ( bits last-char-if-special special? -- )
70: rot dup 4 and IF ." r" ELSE ." -" THEN
71: dup 2 and IF ." w" ELSE ." -" THEN
72: swap IF 1 and 0= IF upc THEN emit ELSE
73: 1 and IF ." x" ELSE ." -" THEN drop THEN ;
74: CREATE mode-chars 10 allot s" ?pc?d?b?-?l?s???" mode-chars swap move
75: : .mode ( mode -- )
76: dup c rshift f and mode-chars + c@ emit
77: dup 6 rshift 7 and over 800 and 73 swap .rwx
78: dup 3 rshift 7 and over 400 and 73 swap .rwx
79: dup 7 and swap 200 and 74 swap .rwx ;
80: : .inode ( -- )
81: base @ >r decimal
82: inode @ w@-le .mode \ file mode
83: inode @ 1a + w@-le 5 .r \ link count
84: inode @ 02 + w@-le 9 .r \ uid
85: inode @ 18 + w@-le 9 .r \ gid
86: inode @ 04 + l@-le 9 .r \ size
87: r> base ! ;
88:
89: : do-super ( -- )
90: 400 400 read-data
91: data @ 14 + l@-le first-block !
92: 400 data @ 18 + l@-le lshift block-size !
93: data @ 28 + l@-le inodes/group !
94: first-block @ 1+ read-block data @ group-descriptors ! data off ;
95:
96: INSTANCE VARIABLE current-pos
97:
98: : read ( adr len -- actual )
99: file-len @ current-pos @ - min \ can't go past end of file
100: current-pos @ block-size @ u/mod 4 * blocks @ + l@-le read-block
101: block-size @ over - rot min >r ( adr off r: len )
102: data @ + swap r@ move r> dup current-pos +! ;
103: : read ( adr len -- actual )
104: ( check if a file is selected, first )
105: dup >r BEGIN dup WHILE 2dup read dup 0= ABORT" ext2-files: read failed"
106: /string REPEAT 2drop r> ;
107: : seek ( lo hi -- status )
108: lxjoin dup file-len @ > IF drop true EXIT THEN current-pos ! false ;
109: : load ( adr -- len )
110: file-len @ read dup file-len @ <> ABORT" ext2-files: failed loading file" ;
111:
112: : .name ( adr -- ) dup 8 + swap 6 + c@ type ;
113: : read-dir ( inode# -- adr )
114: read-inode read-block#s file-len @ alloc-mem
115: 0 0 seek ABORT" ext2-files read-dir: seek failed"
116: dup file-len @ read file-len @ <> ABORT" ext2-files read-dir: read failed" ;
117: : .dir ( inode# -- )
118: read-dir dup BEGIN 2dup file-len @ - > over l@-le tuck and WHILE
119: cr dup 8 0.r space read-inode .inode space space dup .name
120: dup 4 + w@-le + REPEAT 2drop file-len @ free-mem ;
121: : (find-file) ( adr name len -- inode#|0 )
122: 2>r dup BEGIN 2dup file-len @ - > over l@-le and WHILE
123: dup 8 + over 6 + c@ 2r@ str= IF 2r> 2drop nip l@-le EXIT THEN
124: dup 4 + w@-le + REPEAT 2drop 2r> 2drop 0 ;
125: : find-file ( inode# name len -- inode#|0 )
126: 2>r read-dir dup 2r> (find-file) swap file-len @ free-mem ;
127: : find-path ( inode# name len -- inode#|0 )
128: dup 0= IF 3drop 0 ." empty name " EXIT THEN
129: over c@ [char] \ = IF 1 /string ." slash " RECURSE EXIT THEN
130: [char] \ split 2>r find-file ?dup 0= IF
131: 2r> 2drop false ." not found " EXIT THEN
132: r@ 0<> IF 2r> ." more... " RECURSE EXIT THEN
133: 2r> 2drop ." got it " ;
134: : close ;
135: : open
136: do-super
137: 80 alloc-mem inode !
138: my-args nip 0= IF 0 0 ELSE
139: 2 my-args find-path ?dup 0= IF close false EXIT THEN THEN
140: read-inode read-block#s 0 0 seek 0= ;
This archive runs on limited infrastructure. Preserving old code on modern bandwidth. Automated agents are requested to crawl responsibly.