--- /dev/null
+\ *****************************************************************************
+\ * 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 )
+;
+
Code Review / kvmfornfv.git / blobdiff