|
|
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.