![[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 |
qemu 0.15.1
\ *****************************************************************************
\ * 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 ! 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 -- )
free-data DUP ( offset size size )
#data ! alloc-mem data-buff ! ( offset )
xlsplit ( pos.lo pos.hi )
seek -2 and ABORT" seek failed."
data-buff @ #data @ read ( actual )
#data @ <> 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@ 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= IF ( str len )
2dup ( str len str len )
I 21 + I 20 + c@ ( str len str len str' len' )
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
I c@ dup 0= IF ( str len len )
s" file not found" iso-debug-print
drop 2drop FALSE ( FALSE )
UNLOOP
EXIT
THEN
+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 )
;
This archive runs on limited infrastructure. Preserving old code on modern bandwidth. Automated agents are requested to crawl responsibly.