![[BACK]](/cvsweb/icons/back.gif){kind=icon}
Return to fat-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 fat-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: ! 13: ! 14: s" fat-files" device-name ! 15: ! 16: INSTANCE VARIABLE bytes/sector ! 17: INSTANCE VARIABLE sectors/cluster ! 18: INSTANCE VARIABLE #reserved-sectors ! 19: INSTANCE VARIABLE #fats ! 20: INSTANCE VARIABLE #root-entries ! 21: INSTANCE VARIABLE total-#sectors ! 22: INSTANCE VARIABLE media-descriptor ! 23: INSTANCE VARIABLE sectors/fat ! 24: INSTANCE VARIABLE sectors/track ! 25: INSTANCE VARIABLE #heads ! 26: INSTANCE VARIABLE #hidden-sectors ! 27: ! 28: INSTANCE VARIABLE fat-type ! 29: INSTANCE VARIABLE bytes/cluster ! 30: INSTANCE VARIABLE fat-offset ! 31: INSTANCE VARIABLE root-offset ! 32: INSTANCE VARIABLE cluster-offset ! 33: INSTANCE VARIABLE #clusters ! 34: ! 35: : seek s" seek" $call-parent ; ! 36: : read s" read" $call-parent ; ! 37: ! 38: INSTANCE VARIABLE data ! 39: INSTANCE VARIABLE #data ! 40: ! 41: : free-data ! 42: data @ ?dup IF #data @ free-mem 0 data ! THEN ; ! 43: : read-data ( offset size -- ) ! 44: free-data dup #data ! alloc-mem data ! ! 45: xlsplit seek -2 and ABORT" fat-files read-data: seek failed" ! 46: data @ #data @ read #data @ <> ABORT" fat-files read-data: read failed" ; ! 47: ! 48: CREATE fat-buf 8 allot ! 49: : read-fat ( cluster# -- data ) ! 50: fat-buf 8 erase ! 51: 1 #split fat-type @ * 2/ 2/ fat-offset @ + ! 52: xlsplit seek -2 and ABORT" fat-files read-fat: seek failed" ! 53: fat-buf 8 read 8 <> ABORT" fat-files read-fat: read failed" ! 54: fat-buf 8c@ bxjoin fat-type @ dup >r 2* #split drop r> #split ! 55: rot IF swap THEN drop ; ! 56: ! 57: INSTANCE VARIABLE next-cluster ! 58: ! 59: : read-cluster ( cluster# -- ) ! 60: dup bytes/cluster @ * cluster-offset @ + bytes/cluster @ read-data ! 61: read-fat dup #clusters @ >= IF drop 0 THEN next-cluster ! ; ! 62: : read-dir ( cluster# -- ) ! 63: ?dup 0= IF root-offset @ #root-entries @ 20 * read-data 0 next-cluster ! ! 64: ELSE read-cluster THEN ; ! 65: ! 66: : .time ( x -- ) ! 67: base @ >r decimal ! 68: b #split 2 0.r [char] : emit 5 #split 2 0.r [char] : emit 2* 2 0.r ! 69: r> base ! ; ! 70: : .date ( x -- ) ! 71: base @ >r decimal ! 72: 9 #split 7bc + 4 0.r [char] - emit 5 #split 2 0.r [char] - emit 2 0.r ! 73: r> base ! ; ! 74: : .attr ( attr -- ) ! 75: 6 0 DO dup 1 and IF s" RHSLDA" drop i + c@ ELSE bl THEN emit u2/ LOOP drop ; ! 76: : .dir-entry ( adr -- ) ! 77: dup 0b + c@ 8 and IF drop EXIT THEN \ volume label, not a file ! 78: dup c@ e5 = IF drop EXIT THEN \ deleted file ! 79: cr ! 80: dup 1a + 2c@ bwjoin [char] # emit 4 0.r space \ starting cluster ! 81: dup 18 + 2c@ bwjoin .date space ! 82: dup 16 + 2c@ bwjoin .time space ! 83: dup 1c + 4c@ bljoin base @ decimal swap a .r base ! space \ size in bytes ! 84: dup 0b + c@ .attr space ! 85: dup 8 BEGIN 2dup 1- + c@ 20 = over and WHILE 1- REPEAT type ! 86: dup 8 + 3 BEGIN 2dup 1- + c@ 20 = over and WHILE 1- REPEAT dup IF ! 87: [char] . emit type ELSE 2drop THEN ! 88: drop ; ! 89: : .dir-entries ( adr n -- ) ! 90: 0 ?DO dup i 20 * + dup c@ 0= IF drop LEAVE THEN .dir-entry LOOP drop ; ! 91: : .dir ( cluster# -- ) ! 92: read-dir BEGIN data @ #data @ 20 / .dir-entries next-cluster @ WHILE ! 93: next-cluster @ read-cluster REPEAT ; ! 94: ! 95: : str-upper ( str len adr -- ) \ Copy string to adr, uppercase ! 96: -rot bounds ?DO i c@ upc over c! char+ LOOP drop ; ! 97: CREATE dos-name b allot ! 98: : make-dos-name ( str len -- ) ! 99: dos-name b bl fill ! 100: 2dup [char] . findchar IF ! 101: 3dup 1+ /string 3 min dos-name 8 + str-upper nip THEN ! 102: 8 min dos-name str-upper ; ! 103: ! 104: : (find-file) ( -- cluster file-len is-dir? true | false ) ! 105: data @ BEGIN dup data @ #data @ + < WHILE ! 106: dup dos-name b comp WHILE 20 + REPEAT ! 107: dup 1a + 2c@ bwjoin swap dup 1c + 4c@ bljoin swap 0b + c@ 10 and 0<> true ! 108: ELSE drop false THEN ; ! 109: : find-file ( dir-cluster name len -- cluster file-len is-dir? true | false ) ! 110: make-dos-name read-dir BEGIN (find-file) 0= WHILE next-cluster @ WHILE ! 111: next-cluster @ read-cluster REPEAT false ELSE true THEN ; ! 112: : find-path ( dir-cluster name len -- cluster file-len true | false ) ! 113: dup 0= IF 3drop false ." empty name " EXIT THEN ! 114: over c@ [char] \ = IF 1 /string ." slash " RECURSE EXIT THEN ! 115: [char] \ split 2>r find-file 0= IF 2r> 2drop false ." not found " EXIT THEN ! 116: r@ 0<> <> IF 2drop 2r> 2drop false ." no dir<->file match " EXIT THEN ! 117: r@ 0<> IF drop 2r> ." more... " RECURSE EXIT THEN ! 118: 2r> 2drop true ." got it " ; ! 119: ! 120: : do-super ( -- ) ! 121: 0 200 read-data ! 122: data @ 0b + 2c@ bwjoin bytes/sector ! ! 123: data @ 0d + c@ sectors/cluster ! ! 124: bytes/sector @ sectors/cluster @ * bytes/cluster ! ! 125: data @ 0e + 2c@ bwjoin #reserved-sectors ! ! 126: data @ 10 + c@ #fats ! ! 127: data @ 11 + 2c@ bwjoin #root-entries ! ! 128: data @ 13 + 2c@ bwjoin total-#sectors ! ! 129: data @ 15 + c@ media-descriptor ! ! 130: data @ 16 + 2c@ bwjoin sectors/fat ! ! 131: data @ 18 + 2c@ bwjoin sectors/track ! ! 132: data @ 1a + 2c@ bwjoin #heads ! ! 133: data @ 1c + 2c@ bwjoin #hidden-sectors ! ! 134: ! 135: \ For FAT16 and FAT32: ! 136: total-#sectors @ 0= IF data @ 20 + 4c@ bljoin total-#sectors ! THEN ! 137: ! 138: \ For FAT32: ! 139: sectors/fat @ 0= IF data @ 24 + 4c@ bljoin sectors/fat ! THEN ! 140: ! 141: \ XXX add other FAT32 stuff (offsets 28, 2c, 30) ! 142: ! 143: \ Compute the number of data clusters, decide what FAT type we are. ! 144: total-#sectors @ #reserved-sectors @ - sectors/fat @ #fats @ * - ! 145: #root-entries @ 20 * bytes/sector @ // - sectors/cluster @ / ! 146: dup #clusters ! ! 147: dup ff5 < IF drop c ELSE fff5 < IF 10 ELSE 20 THEN THEN fat-type ! ! 148: cr ." FAT" base @ decimal fat-type @ . base ! ! 149: ! 150: \ Starting offset of first fat. ! 151: #reserved-sectors @ bytes/sector @ * fat-offset ! ! 152: ! 153: \ Starting offset of root dir. ! 154: #fats @ sectors/fat @ * bytes/sector @ * fat-offset @ + root-offset ! ! 155: ! 156: \ Starting offset of "cluster 0". ! 157: #root-entries @ 20 * bytes/sector @ tuck // * root-offset @ + ! 158: bytes/cluster @ 2* - cluster-offset ! ; ! 159: ! 160: ! 161: INSTANCE VARIABLE file-cluster ! 162: INSTANCE VARIABLE file-len ! 163: INSTANCE VARIABLE current-pos ! 164: INSTANCE VARIABLE pos-in-data ! 165: ! 166: : seek ( lo hi -- status ) ! 167: lxjoin dup current-pos ! file-cluster @ read-cluster ! 168: \ Read and skip blocks until we are where we want to be. ! 169: BEGIN dup #data @ >= WHILE #data @ - next-cluster @ dup 0= IF ! 170: 2drop true EXIT THEN read-cluster REPEAT pos-in-data ! false ; ! 171: : read ( adr len -- actual ) ! 172: file-len @ current-pos @ - min \ can't go past end of file ! 173: #data @ pos-in-data @ - min >r \ length for this transfer ! 174: data @ pos-in-data @ + swap r@ move \ move the data ! 175: r@ pos-in-data +! r@ current-pos +! pos-in-data @ #data @ = IF ! 176: next-cluster @ ?dup IF read-cluster 0 pos-in-data ! THEN THEN r> ; ! 177: : read ( adr len -- actual ) ! 178: dup >r BEGIN dup WHILE 2dup read dup 0= ABORT" fat-files: read failed" ! 179: /string ( tuck - >r + r> ) REPEAT 2drop r> ; ! 180: : load ( adr -- len ) ! 181: file-len @ read dup file-len @ <> ABORT" fat-files: failed loading file" ; ! 182: ! 183: : close free-data ; ! 184: : open ! 185: do-super ! 186: 0 my-args find-path 0= IF close false EXIT THEN ! 187: file-len ! file-cluster ! 0 0 seek 0= ;
This archive runs on limited infrastructure. Preserving old code on modern bandwidth. Automated agents are requested to crawl responsibly.