![[BACK]](/cvsweb/icons/back.gif){kind=icon}
Return to iso-9660.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 iso-9660.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" iso-9660" device-name ! 15: ! 16: ! 17: 0 VALUE iso-debug-flag ! 18: ! 19: \ Method for code clean up - For release version of code iso-debug-flag is ! 20: \ cleared and for debugging it is set ! 21: ! 22: : iso-debug-print ( str len -- ) iso-debug-flag IF type cr ELSE 2drop THEN ; ! 23: ! 24: ! 25: \ -------------------------------------------------------- ! 26: \ GLOBAL VARIABLES ! 27: \ -------------------------------------------------------- ! 28: ! 29: ! 30: 0 VALUE path-tbl-size ! 31: 0 VALUE path-tbl-addr ! 32: 0 VALUE root-dir-size ! 33: 0 VALUE vol-size ! 34: 0 VALUE logical-blk-size ! 35: 0 VALUE path-table ! 36: 0 VALUE count ! 37: ! 38: ! 39: \ INSTANCE VARIABLES ! 40: ! 41: ! 42: INSTANCE VARIABLE dir-addr ! 43: INSTANCE VARIABLE data-buff ! 44: INSTANCE VARIABLE #data ! 45: INSTANCE VARIABLE ptable ! 46: INSTANCE VARIABLE file-loc ! 47: INSTANCE VARIABLE file-size ! 48: INSTANCE VARIABLE cur-file-offset ! 49: INSTANCE VARIABLE self ! 50: INSTANCE VARIABLE index ! 51: ! 52: ! 53: \ -------------------------------------------------------- ! 54: \ COLON DEFINITIONS ! 55: \ -------------------------------------------------------- ! 56: ! 57: ! 58: \ This method is used to seek to the required position ! 59: \ Which calls seek of disk-label ! 60: ! 61: : seek ( pos.lo pos.hi -- status ) s" seek" $call-parent ; ! 62: ! 63: ! 64: \ This method is used to read the contents of disk ! 65: \ it calls read of disk-label ! 66: ! 67: ! 68: : read ( addr len -- actual ) s" read" $call-parent ; ! 69: ! 70: ! 71: \ This method releases the memory used as scratch pad buffer. ! 72: ! 73: : free-data ( -- ) ! 74: data-buff @ ( data-buff ) ! 75: ?DUP IF #data @ free-mem 0 data-buff ! THEN ! 76: ; ! 77: ! 78: ! 79: \ This method will release the previous allocated scratch pad buffer and ! 80: \ allocates a fresh buffer and copies the required number of bytes from the ! 81: \ media in to it. ! 82: ! 83: : read-data ( offset size -- ) ! 84: free-data DUP ( offset size size ) ! 85: #data ! alloc-mem data-buff ! ( offset ) ! 86: xlsplit ( pos.lo pos.hi ) ! 87: seek -2 and ABORT" seek failed." ! 88: data-buff @ #data @ read ( actual ) ! 89: #data @ <> ABORT" read failed." ! 90: ; ! 91: ! 92: ! 93: \ This method extracts the information required from primary volume ! 94: \ descriptor and stores the required information in the global variables ! 95: ! 96: : extract-vol-info ( -- ) ! 97: 10 800 * 800 read-data ! 98: data-buff @ 88 + l@-be to path-tbl-size \ read path table size ! 99: data-buff @ 94 + l@-be to path-tbl-addr \ read big-endian path table ! 100: data-buff @ a2 + l@-be dir-addr ! \ gather of root directory info ! 101: data-buff @ 0aa + l@-be to root-dir-size \ get volume info ! 102: data-buff @ 54 + l@-be to vol-size \ size in blocks ! 103: data-buff @ 82 + l@-be to logical-blk-size ! 104: path-tbl-size alloc-mem dup TO path-table path-tbl-size erase ! 105: path-tbl-addr 800 * xlsplit seek drop ! 106: path-table path-tbl-size read drop \ pathtable in-system-memory copy ! 107: ; ! 108: ! 109: ! 110: \ This method coverts the iso file name to user readble form ! 111: ! 112: : file-name ( str len -- str' len' ) ! 113: 2dup [char] ; findchar IF ! 114: ( str len offset ) ! 115: nip \ Omit the trailing ";1" revision of ISO9660 file name ! 116: 2dup + 1- ( str newlen endptr ) ! 117: c@ [CHAR] . = IF ! 118: 1- ( str len' ) \ Remove trailing dot ! 119: THEN ! 120: THEN ! 121: ; ! 122: ! 123: ! 124: \ triplicates top stack element ! 125: ! 126: : dup3 ( num -- num num num ) dup dup dup ; ! 127: ! 128: ! 129: \ This method is used for traversing records of path table. If the ! 130: \ file identifier length is odd 1 byte padding is done else not. ! 131: ! 132: : get-next-record ( rec-addr -- next-rec-offset ) ! 133: dup3 ( rec-addr rec-addr rec-addr rec-addr ) ! 134: self @ 1 + self ! ( rec-addr rec-addr rec-addr rec-addr ) ! 135: c@ 1 AND IF ( rec-addr rec-addr rec-addr ) ! 136: c@ + 9 ( rec-addr rec-addr' rec-len ) ! 137: ELSE ! 138: c@ + 8 ( rec-addr rec-addr' rec-len ) ! 139: THEN ! 140: + swap - ( next-rec-offset ) ! 141: ; ! 142: ! 143: ! 144: \ This method does search of given directory name in the path table ! 145: \ and returns true if finds a match else false. ! 146: ! 147: : path-table-search ( str len -- TRUE | FALSE ) ! 148: path-table path-tbl-size + path-table ptable @ + DO ( str len ) ! 149: 2dup I 6 + w@-be index @ = ( str len str len ) ! 150: -rot I 8 + I c@ string=ci and IF ( str len ) ! 151: s" Directory Matched!! " iso-debug-print ( str len ) ! 152: self @ index ! ( str len ) ! 153: I 2 + l@-be dir-addr ! I dup ( str len rec-addr ) ! 154: get-next-record + path-table - ptable ! ( str len ) ! 155: 2drop TRUE UNLOOP EXIT ( TRUE ) ! 156: THEN ! 157: I get-next-record ( str len next-rec-offset ) ! 158: +LOOP ! 159: 2drop ! 160: FALSE ( FALSE ) ! 161: s" Invalid path / directory " iso-debug-print ! 162: ; ! 163: ! 164: ! 165: \ METHOD for searching for a file with in a direcotory ! 166: ! 167: : search-file-dir ( str len -- TRUE | FALSE ) ! 168: dir-addr @ 800 * dir-addr ! ( str len ) ! 169: dir-addr @ 100 read-data ( str len ) ! 170: data-buff @ 0e + l@-be dup >r ( str len rec-len ) ! 171: 100 > IF ( str len ) ! 172: s" size dir record" iso-debug-print ( str len ) ! 173: dir-addr @ r@ read-data ( str len ) ! 174: THEN ! 175: r> data-buff @ + data-buff @ DO ( str len ) ! 176: I 19 + c@ 2 and 0= IF ( str len ) ! 177: 2dup ( str len str len ) ! 178: I 21 + I 20 + c@ ( str len str len str' len' ) ! 179: file-name string=ci IF ( str len ) ! 180: s" File found!" iso-debug-print ( str len ) ! 181: I 6 + l@-be 800 * ( str len file-loc ) ! 182: file-loc ! ( str len ) ! 183: I 0e + l@-be file-size ! ( str len ) ! 184: 2drop ! 185: TRUE ( TRUE ) ! 186: UNLOOP ! 187: EXIT ! 188: THEN ! 189: THEN ! 190: I c@ dup 0= IF ( str len len ) ! 191: s" file not found" iso-debug-print ! 192: drop 2drop FALSE ( FALSE ) ! 193: UNLOOP ! 194: EXIT ! 195: THEN ! 196: +LOOP ! 197: 2drop ! 198: FALSE ( FALSE ) ! 199: s" file not found" iso-debug-print ! 200: ; ! 201: ! 202: ! 203: \ This method splits the given absolute path in to directories from root and ! 204: \ calls search-path-table. when string reaches to state when it can not be ! 205: \ split i.e., end of the path, calls search-file-dir is made to search for ! 206: \ file . ! 207: ! 208: : search-path ( str len -- FALSE|TRUE ) ! 209: 0 ptable ! ! 210: 1 self ! ! 211: 1 index ! ! 212: dup ( str len len ) ! 213: 0= IF ! 214: 3drop FALSE ( FALSE ) ! 215: s" Empty path name " iso-debug-print EXIT ( FALSE ) ! 216: THEN ! 217: OVER c@ ( str len char ) ! 218: [char] \ = IF ( str len ) ! 219: swap 1 + swap 1 - BEGIN ( str len ) ! 220: [char] \ split ( str len str' len ' ) ! 221: dup 0 = IF ( str len str' len ' ) ! 222: 2drop search-file-dir EXIT ( TRUE | FALSE ) ! 223: ELSE ! 224: 2swap path-table-search invert IF ( str' len ' ) ! 225: 2drop FALSE EXIT ( FALSE ) ! 226: THEN ! 227: THEN ! 228: AGAIN ! 229: ELSE BEGIN ! 230: [char] \ split dup 0 = IF ( str len str' len' ) ! 231: 2drop search-file-dir EXIT ( TRUE | FALSE ) ! 232: ELSE ! 233: 2swap path-table-search invert IF ( str' len ' ) ! 234: 2drop FALSE EXIT ( FALSE ) ! 235: THEN ! 236: THEN ! 237: AGAIN ! 238: THEN ! 239: ; ! 240: ! 241: ! 242: \ this method will seek and read the file in to the given memory location ! 243: ! 244: 0 VALUE loc ! 245: : load ( addr -- len ) ! 246: dup to loc ( addr ) ! 247: file-loc @ xlsplit seek drop ! 248: file-size @ read ( file-size ) ! 249: iso-debug-flag IF s" Bytes returned from read:" type dup . cr THEN ! 250: dup file-size @ <> ABORT" read failed!" ! 251: ; ! 252: ! 253: ! 254: ! 255: \ memory used by the file system will be freed ! 256: ! 257: : close ( -- ) ! 258: free-data count 1 - dup to count 0 = IF ! 259: path-table path-tbl-size free-mem ! 260: 0 TO path-table ! 261: THEN ! 262: ; ! 263: ! 264: ! 265: \ open method of the file system ! 266: ! 267: : open ( -- TRUE | FALSE ) ! 268: 0 data-buff ! ! 269: 0 #data ! ! 270: 0 ptable ! ! 271: 0 file-loc ! ! 272: 0 file-size ! ! 273: 0 cur-file-offset ! ! 274: 1 self ! ! 275: 1 index ! ! 276: count 0 = IF ! 277: s" extract-vol-info called " iso-debug-print ! 278: extract-vol-info ! 279: THEN ! 280: count 1 + to count ! 281: my-args search-path IF ! 282: file-loc @ xlsplit seek drop ! 283: TRUE ( TRUE ) ! 284: ELSE ! 285: close ! 286: FALSE ( FALSE ) ! 287: THEN ! 288: 0 cur-file-offset ! ! 289: s" opened ISO9660 package" iso-debug-print ! 290: ; ! 291: ! 292: ! 293: \ public seek method ! 294: ! 295: : seek ( pos.lo pos.hi -- status ) ! 296: lxjoin dup cur-file-offset ! ( offset ) ! 297: file-loc @ + xlsplit ( pos.lo pos.hi ) ! 298: s" seek" $call-parent ( status ) ! 299: ; ! 300: ! 301: ! 302: \ public read method ! 303: ! 304: : read ( addr len -- actual ) ! 305: file-size @ cur-file-offset @ - ( addr len remainder-of-file ) ! 306: min ( addr len|remainder-of-file ) ! 307: s" read" $call-parent ( actual ) ! 308: dup cur-file-offset @ + cur-file-offset ! ( actual ) ! 309: cur-file-offset @ ( offset actual ) ! 310: xlsplit seek drop ( actual ) ! 311: ; ! 312:
This archive runs on limited infrastructure. Preserving old code on modern bandwidth. Automated agents are requested to crawl responsibly.