325 lines
10 KiB
Forth
325 lines
10 KiB
Forth
\ *****************************************************************************
|
|
\ * 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 )
|
|
;
|
|
|