blob: 6eda8be7063722614c49e185ea1c2235806da509 (
plain)
1
2
3
4
5
6
7
8
9
10
11
12
13
14
15
16
17
18
19
20
21
22
23
24
25
26
27
28
29
30
31
32
33
34
35
36
37
38
39
40
41
42
43
44
45
46
47
48
49
50
51
52
53
54
55
56
57
58
59
60
61
62
63
64
65
66
67
68
69
70
71
72
73
74
75
76
77
78
79
80
81
82
83
84
85
86
87
88
89
90
91
92
93
94
95
96
97
98
99
100
101
102
103
104
105
106
107
108
109
110
111
112
113
114
115
116
117
118
119
120
121
122
123
124
125
126
127
128
129
130
131
132
133
134
135
136
137
138
139
140
141
142
143
144
145
146
147
148
149
150
151
152
153
154
155
156
157
158
159
160
161
162
163
164
165
166
167
168
169
170
171
172
173
174
175
176
177
178
179
180
181
182
183
184
185
186
187
188
189
190
191
192
193
194
195
196
197
198
199
200
201
202
203
204
205
206
207
208
209
210
211
212
213
214
215
216
217
218
219
220
221
222
223
224
225
226
227
228
229
230
231
232
233
234
235
236
237
238
239
240
241
242
243
244
245
246
247
248
249
250
251
252
253
254
255
256
257
258
259
260
261
262
263
264
265
266
267
268
269
270
271
272
273
274
275
276
277
278
279
280
281
282
283
284
285
286
287
288
289
290
291
292
293
294
295
296
297
298
299
300
301
302
303
304
305
306
307
308
309
310
311
312
313
314
315
316
317
318
319
320
321
322
323
324
325
|
\ *****************************************************************************
\ * 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 )
;
|
