\ ***************************************************************************** \ * Copyright (c) 2004, 2008 IBM Corporation \ * All rights reserved. \ * This program and the accompanying materials \ * are made available under the terms of the BSD License \ * which accompanies this distribution, and is available at \ * http://www.opensource.org/licenses/bsd-license.php \ * \ * Contributors: \ * IBM Corporation - initial implementation \ ****************************************************************************/ s" iso-9660" device-name 0 VALUE iso-debug-flag \ Method for code clean up - For release version of code iso-debug-flag is \ cleared and for debugging it is set : iso-debug-print ( str len -- ) iso-debug-flag IF type cr ELSE 2drop THEN ; \ -------------------------------------------------------- \ GLOBAL VARIABLES \ -------------------------------------------------------- 0 VALUE path-tbl-size 0 VALUE path-tbl-addr 0 VALUE root-dir-size 0 VALUE vol-size 0 VALUE logical-blk-size 0 VALUE path-table 0 VALUE count \ INSTANCE VARIABLES INSTANCE VARIABLE dir-addr INSTANCE VARIABLE data-buff INSTANCE VARIABLE #data INSTANCE VARIABLE ptable INSTANCE VARIABLE file-loc INSTANCE VARIABLE file-size INSTANCE VARIABLE cur-file-offset INSTANCE VARIABLE self INSTANCE VARIABLE index \ -------------------------------------------------------- \ COLON DEFINITIONS \ -------------------------------------------------------- \ This method is used to seek to the required position \ Which calls seek of disk-label : seek ( pos.lo pos.hi -- status ) s" seek" $call-parent ; \ This method is used to read the contents of disk \ it calls read of disk-label : read ( addr len -- actual ) s" read" $call-parent ; \ This method releases the memory used as scratch pad buffer. : free-data ( -- ) data-buff @ ( data-buff ) ?DUP IF #data @ free-mem 0 data-buff ! 0 #data ! THEN ; \ This method will release the previous allocated scratch pad buffer and \ allocates a fresh buffer and copies the required number of bytes from the \ media in to it. : read-data ( offset size -- ) dup #data @ > IF free-data dup dup ( offset size size size ) #data ! alloc-mem data-buff ! ( offset size ) THEN swap xlsplit ( size pos.lo pos.hi ) seek -2 and ABORT" seek failed." data-buff @ over read ( size actual ) <> ABORT" read failed." ; \ This method extracts the information required from primary volume \ descriptor and stores the required information in the global variables : extract-vol-info ( -- ) 10 800 * 800 read-data data-buff @ 88 + l@-be to path-tbl-size \ read path table size data-buff @ 94 + l@-be to path-tbl-addr \ read big-endian path table data-buff @ a2 + l@-be dir-addr ! \ gather of root directory info data-buff @ 0aa + l@-be to root-dir-size \ get volume info data-buff @ 54 + l@-be to vol-size \ size in blocks data-buff @ 82 + l@-be to logical-blk-size path-tbl-size alloc-mem dup TO path-table path-tbl-size erase path-tbl-addr 800 * xlsplit seek drop path-table path-tbl-size read drop \ pathtable in-system-memory copy ; \ This method coverts the iso file name to user readble form : file-name ( str len -- str' len' ) 2dup [char] ; findchar IF ( str len offset ) nip \ Omit the trailing ";1" revision of ISO9660 file name 2dup + 1- ( str newlen endptr ) c@ [CHAR] . = IF 1- ( str len' ) \ Remove trailing dot THEN THEN ; \ triplicates top stack element : dup3 ( num -- num num num ) dup dup dup ; \ This method is used for traversing records of path table. If the \ file identifier length is odd 1 byte padding is done else not. : get-next-record ( rec-addr -- next-rec-offset ) dup3 ( rec-addr rec-addr rec-addr rec-addr ) self @ 1 + self ! ( rec-addr rec-addr rec-addr rec-addr ) c@ 1 AND IF ( rec-addr rec-addr rec-addr ) c@ + 9 ( rec-addr rec-addr' rec-len ) ELSE c@ + 8 ( rec-addr rec-addr' rec-len ) THEN + swap - ( next-rec-offset ) ; \ This method does search of given directory name in the path table \ and returns true if finds a match else false. : path-table-search ( str len -- TRUE | FALSE ) path-table path-tbl-size + path-table ptable @ + DO ( str len ) 2dup I 6 + w@-be index @ = ( str len str len ) -rot I 8 + I c@ iso-debug-flag IF ." ISO: comparing path name '" 4dup type ." ' with '" type ." '" cr THEN string=ci and IF ( str len ) s" Directory Matched!! " iso-debug-print ( str len ) self @ index ! ( str len ) I 2 + l@-be dir-addr ! I dup ( str len rec-addr ) get-next-record + path-table - ptable ! ( str len ) 2drop TRUE UNLOOP EXIT ( TRUE ) THEN I get-next-record ( str len next-rec-offset ) +LOOP 2drop FALSE ( FALSE ) s" Invalid path / directory " iso-debug-print ; \ METHOD for searching for a file with in a direcotory : search-file-dir ( str len -- TRUE | FALSE ) dir-addr @ 800 * dir-addr ! ( str len ) dir-addr @ 100 read-data ( str len ) data-buff @ 0e + l@-be dup >r ( str len rec-len ) 100 > IF ( str len ) s" size dir record" iso-debug-print ( str len ) dir-addr @ r@ read-data ( str len ) THEN r> data-buff @ + data-buff @ DO ( str len ) I 19 + c@ 2 and 0= I c@ 0<> and IF ( str len ) 2dup ( str len str len ) I 21 + I 20 + c@ ( str len str len str' len' ) iso-debug-flag IF ." ISO: comparing file name '" 4dup type ." ' with '" type ." '" cr THEN file-name string=ci IF ( str len ) s" File found!" iso-debug-print ( str len ) I 6 + l@-be 800 * ( str len file-loc ) file-loc ! ( str len ) I 0e + l@-be file-size ! ( str len ) 2drop TRUE ( TRUE ) UNLOOP EXIT THEN THEN ( str len ) I c@ ?dup 0= IF 800 I 7ff AND - iso-debug-flag IF ." skipping " dup . ." bytes at end of sector" cr THEN THEN ( str len offset ) +LOOP 2drop FALSE ( FALSE ) s" file not found" iso-debug-print ; \ This method splits the given absolute path in to directories from root and \ calls search-path-table. when string reaches to state when it can not be \ split i.e., end of the path, calls search-file-dir is made to search for \ file . : search-path ( str len -- FALSE|TRUE ) 0 ptable ! 1 self ! 1 index ! dup ( str len len ) 0= IF 3drop FALSE ( FALSE ) s" Empty path name " iso-debug-print EXIT ( FALSE ) THEN OVER c@ ( str len char ) [char] \ = IF ( str len ) swap 1 + swap 1 - BEGIN ( str len ) [char] \ split ( str len str' len ' ) dup 0 = IF ( str len str' len ' ) 2drop search-file-dir EXIT ( TRUE | FALSE ) ELSE 2swap path-table-search invert IF ( str' len ' ) 2drop FALSE EXIT ( FALSE ) THEN THEN AGAIN ELSE BEGIN [char] \ split dup 0 = IF ( str len str' len' ) 2drop search-file-dir EXIT ( TRUE | FALSE ) ELSE 2swap path-table-search invert IF ( str' len ' ) 2drop FALSE EXIT ( FALSE ) THEN THEN AGAIN THEN ; \ this method will seek and read the file in to the given memory location 0 VALUE loc : load ( addr -- len ) dup to loc ( addr ) file-loc @ xlsplit seek drop file-size @ read ( file-size ) iso-debug-flag IF s" Bytes returned from read:" type dup . cr THEN dup file-size @ <> ABORT" read failed!" ; \ memory used by the file system will be freed : close ( -- ) free-data count 1 - dup to count 0 = IF path-table path-tbl-size free-mem 0 TO path-table THEN ; \ open method of the file system : open ( -- TRUE | FALSE ) 0 data-buff ! 0 #data ! 0 ptable ! 0 file-loc ! 0 file-size ! 0 cur-file-offset ! 1 self ! 1 index ! count 0 = IF s" extract-vol-info called " iso-debug-print extract-vol-info THEN count 1 + to count my-args search-path IF file-loc @ xlsplit seek drop TRUE ( TRUE ) ELSE close FALSE ( FALSE ) THEN 0 cur-file-offset ! s" opened ISO9660 package" iso-debug-print ; \ public seek method : seek ( pos.lo pos.hi -- status ) lxjoin dup cur-file-offset ! ( offset ) file-loc @ + xlsplit ( pos.lo pos.hi ) s" seek" $call-parent ( status ) ; \ public read method : read ( addr len -- actual ) file-size @ cur-file-offset @ - ( addr len remainder-of-file ) min ( addr len|remainder-of-file ) s" read" $call-parent ( actual ) dup cur-file-offset @ + cur-file-offset ! ( actual ) cur-file-offset @ ( offset actual ) xlsplit seek drop ( actual ) ;