|
|
1.1 root 1: \ ***************************************************************************** 1.1.1.2 ! root 2: \ * Copyright (c) 2004, 2011 IBM Corporation 1.1 root 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 1.1.1.2 ! root 15: INSTANCE VARIABLE inode-size 1.1 root 16: INSTANCE VARIABLE block-size 17: INSTANCE VARIABLE inodes/group 18: 1.1.1.2 ! root 19: INSTANCE VARIABLE group-desc-size 1.1 root 20: INSTANCE VARIABLE group-descriptors 21: 22: : seek s" seek" $call-parent ; 23: : read s" read" $call-parent ; 24: 25: INSTANCE VARIABLE data 26: INSTANCE VARIABLE #data 1.1.1.2 ! root 27: INSTANCE VARIABLE indirect-block ! 28: INSTANCE VARIABLE dindirect-block 1.1 root 29: 30: : free-data 31: data @ ?dup IF #data @ free-mem 0 data ! THEN ; 32: : read-data ( offset size -- ) 33: free-data dup #data ! alloc-mem data ! 34: xlsplit seek -2 and ABORT" ext2-files read-data: seek failed" 35: data @ #data @ read #data @ <> ABORT" ext2-files read-data: read failed" ; 36: 37: : read-block ( block# -- ) 38: block-size @ * block-size @ read-data ; 39: 40: INSTANCE VARIABLE inode 41: INSTANCE VARIABLE file-len 42: INSTANCE VARIABLE blocks 43: INSTANCE VARIABLE #blocks 44: INSTANCE VARIABLE ^blocks 45: INSTANCE VARIABLE #blocks-left 46: : blocks-read ( n -- ) dup negate #blocks-left +! 4 * ^blocks +! ; 47: : read-indirect-blocks ( indirect-block# -- ) 48: read-block data @ data off 49: dup #blocks-left @ 4 * block-size @ min dup >r ^blocks @ swap move 50: r> 2 rshift blocks-read block-size @ free-mem ; 1.1.1.2 ! root 51: 1.1 root 52: : read-double-indirect-blocks ( double-indirect-block# -- ) 1.1.1.2 ! root 53: \ Resolve one level of indirection and call read-indirect-block ! 54: read-block data @ indirect-block ! data off ! 55: BEGIN ! 56: indirect-block @ l@-le dup 0 <> ! 57: WHILE ! 58: read-indirect-blocks ! 59: 4 indirect-block +! \ point to next indirect block ! 60: REPEAT ! 61: drop \ drop 0, the invalid block number 1.1 root 62: ; 1.1.1.2 ! root 63: 1.1 root 64: : read-triple-indirect-blocks ( triple-indirect-block# -- ) 1.1.1.2 ! root 65: \ Resolve one level of indirection and call double-indirect-block ! 66: read-block data @ dindirect-block ! data off ! 67: BEGIN ! 68: dindirect-block @ l@-le dup 0 <> ! 69: WHILE ! 70: read-double-indirect-blocks ! 71: 4 dindirect-block +! \ point to next double indirect block ! 72: REPEAT ! 73: drop \ drop 0, the invalid block number 1.1 root 74: ; 1.1.1.2 ! root 75: 1.1 root 76: : read-block#s ( -- ) 77: blocks @ ?dup IF #blocks @ 4 * free-mem THEN 78: inode @ 4 + l@-le file-len ! 79: file-len @ block-size @ // #blocks ! 80: #blocks @ 4 * alloc-mem blocks ! 81: blocks @ ^blocks ! #blocks @ #blocks-left ! 82: #blocks-left @ c min \ # direct blocks 83: inode @ 28 + over 4 * ^blocks @ swap move blocks-read 84: #blocks-left @ IF inode @ 58 + l@-le read-indirect-blocks THEN 85: #blocks-left @ IF inode @ 5c + l@-le read-double-indirect-blocks THEN 86: #blocks-left @ IF inode @ 60 + l@-le read-triple-indirect-blocks THEN ; 87: : read-inode ( inode# -- ) 88: 1- inodes/group @ u/mod \ # in group, group # 89: 20 * group-descriptors @ + 8 + l@-le block-size @ * \ # in group, inode table 1.1.1.2 ! root 90: swap inode-size @ * + xlsplit seek drop inode @ inode-size @ read drop ! 91: ; 1.1 root 92: 93: : .rwx ( bits last-char-if-special special? -- ) 94: rot dup 4 and IF ." r" ELSE ." -" THEN 95: dup 2 and IF ." w" ELSE ." -" THEN 96: swap IF 1 and 0= IF upc THEN emit ELSE 97: 1 and IF ." x" ELSE ." -" THEN drop THEN ; 98: CREATE mode-chars 10 allot s" ?pc?d?b?-?l?s???" mode-chars swap move 99: : .mode ( mode -- ) 100: dup c rshift f and mode-chars + c@ emit 101: dup 6 rshift 7 and over 800 and 73 swap .rwx 102: dup 3 rshift 7 and over 400 and 73 swap .rwx 103: dup 7 and swap 200 and 74 swap .rwx ; 104: : .inode ( -- ) 105: base @ >r decimal 106: inode @ w@-le .mode \ file mode 107: inode @ 1a + w@-le 5 .r \ link count 108: inode @ 02 + w@-le 9 .r \ uid 109: inode @ 18 + w@-le 9 .r \ gid 110: inode @ 04 + l@-le 9 .r \ size 111: r> base ! ; 112: 113: : do-super ( -- ) 114: 400 400 read-data 115: data @ 14 + l@-le first-block ! 116: 400 data @ 18 + l@-le lshift block-size ! 117: data @ 28 + l@-le inodes/group ! 1.1.1.2 ! root 118: \ Check revision level... in revision 0, the inode size is always 128 ! 119: data @ 4c + l@-le 0= IF ! 120: 80 inode-size ! ! 121: ELSE ! 122: data @ 58 + w@-le inode-size ! ! 123: THEN ! 124: data @ 20 + l@-le group-desc-size ! ! 125: ! 126: \ Read the group descriptor table: ! 127: first-block @ 1+ block-size @ * ! 128: group-desc-size @ ! 129: read-data ! 130: data @ group-descriptors ! ! 131: ! 132: \ We keep the group-descriptor memory area, so clear data pointer: ! 133: data off ! 134: ; 1.1 root 135: 136: INSTANCE VARIABLE current-pos 137: 138: : read ( adr len -- actual ) 139: file-len @ current-pos @ - min \ can't go past end of file 140: current-pos @ block-size @ u/mod 4 * blocks @ + l@-le read-block 141: block-size @ over - rot min >r ( adr off r: len ) 142: data @ + swap r@ move r> dup current-pos +! ; 143: : read ( adr len -- actual ) 144: ( check if a file is selected, first ) 145: dup >r BEGIN dup WHILE 2dup read dup 0= ABORT" ext2-files: read failed" 146: /string REPEAT 2drop r> ; 147: : seek ( lo hi -- status ) 148: lxjoin dup file-len @ > IF drop true EXIT THEN current-pos ! false ; 149: : load ( adr -- len ) 150: file-len @ read dup file-len @ <> ABORT" ext2-files: failed loading file" ; 151: 152: : .name ( adr -- ) dup 8 + swap 6 + c@ type ; 153: : read-dir ( inode# -- adr ) 154: read-inode read-block#s file-len @ alloc-mem 155: 0 0 seek ABORT" ext2-files read-dir: seek failed" 156: dup file-len @ read file-len @ <> ABORT" ext2-files read-dir: read failed" ; 157: : .dir ( inode# -- ) 158: read-dir dup BEGIN 2dup file-len @ - > over l@-le tuck and WHILE 159: cr dup 8 0.r space read-inode .inode space space dup .name 160: dup 4 + w@-le + REPEAT 2drop file-len @ free-mem ; 161: : (find-file) ( adr name len -- inode#|0 ) 162: 2>r dup BEGIN 2dup file-len @ - > over l@-le and WHILE 163: dup 8 + over 6 + c@ 2r@ str= IF 2r> 2drop nip l@-le EXIT THEN 164: dup 4 + w@-le + REPEAT 2drop 2r> 2drop 0 ; 165: : find-file ( inode# name len -- inode#|0 ) 166: 2>r read-dir dup 2r> (find-file) swap file-len @ free-mem ; 167: : find-path ( inode# name len -- inode#|0 ) 168: dup 0= IF 3drop 0 ." empty name " EXIT THEN 169: over c@ [char] \ = IF 1 /string ." slash " RECURSE EXIT THEN 170: [char] \ split 2>r find-file ?dup 0= IF 171: 2r> 2drop false ." not found " EXIT THEN 172: r@ 0<> IF 2r> ." more... " RECURSE EXIT THEN 173: 2r> 2drop ." got it " ; 1.1.1.2 ! root 174: ! 175: : close ! 176: inode @ inode-size @ free-mem ! 177: group-descriptors @ group-desc-size @ free-mem ! 178: free-data ! 179: blocks @ ?dup IF #blocks @ 4 * free-mem THEN ! 180: ; ! 181: 1.1 root 182: : open 1.1.1.2 ! root 183: 0 data ! 0 blocks ! 0 #blocks ! 1.1 root 184: do-super 1.1.1.2 ! root 185: inode-size @ alloc-mem inode ! 1.1 root 186: my-args nip 0= IF 0 0 ELSE 187: 2 my-args find-path ?dup 0= IF close false EXIT THEN THEN 188: 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.