![[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 |
1.1 root 1: \ *****************************************************************************
2: \ * Copyright (c) 2004, 2008 IBM Corporation
3: \ * All rights reserved.
4: \ * This program and the accompanying materials
5: \ * are made available under the terms of the BSD License
6: \ * which accompanies this distribution, and is available at
7: \ * http://www.opensource.org/licenses/bsd-license.php
8: \ *
9: \ * Contributors:
10: \ * IBM Corporation - initial implementation
11: \ ****************************************************************************/
12:
13:
14: s" iso-9660" device-name
15:
16:
17: 0 VALUE iso-debug-flag
18:
19: \ Method for code clean up - For release version of code iso-debug-flag is
20: \ cleared and for debugging it is set
21:
22: : iso-debug-print ( str len -- ) iso-debug-flag IF type cr ELSE 2drop THEN ;
23:
24:
25: \ --------------------------------------------------------
26: \ GLOBAL VARIABLES
27: \ --------------------------------------------------------
28:
29:
30: 0 VALUE path-tbl-size
31: 0 VALUE path-tbl-addr
32: 0 VALUE root-dir-size
33: 0 VALUE vol-size
34: 0 VALUE logical-blk-size
35: 0 VALUE path-table
36: 0 VALUE count
37:
38:
39: \ INSTANCE VARIABLES
40:
41:
42: INSTANCE VARIABLE dir-addr
43: INSTANCE VARIABLE data-buff
44: INSTANCE VARIABLE #data
45: INSTANCE VARIABLE ptable
46: INSTANCE VARIABLE file-loc
47: INSTANCE VARIABLE file-size
48: INSTANCE VARIABLE cur-file-offset
49: INSTANCE VARIABLE self
50: INSTANCE VARIABLE index
51:
52:
53: \ --------------------------------------------------------
54: \ COLON DEFINITIONS
55: \ --------------------------------------------------------
56:
57:
58: \ This method is used to seek to the required position
59: \ Which calls seek of disk-label
60:
61: : seek ( pos.lo pos.hi -- status ) s" seek" $call-parent ;
62:
63:
64: \ This method is used to read the contents of disk
65: \ it calls read of disk-label
66:
67:
68: : read ( addr len -- actual ) s" read" $call-parent ;
69:
70:
71: \ This method releases the memory used as scratch pad buffer.
72:
73: : free-data ( -- )
74: data-buff @ ( data-buff )
75: ?DUP IF #data @ free-mem 0 data-buff ! THEN
76: ;
77:
78:
79: \ This method will release the previous allocated scratch pad buffer and
80: \ allocates a fresh buffer and copies the required number of bytes from the
81: \ media in to it.
82:
83: : read-data ( offset size -- )
84: free-data DUP ( offset size size )
85: #data ! alloc-mem data-buff ! ( offset )
86: xlsplit ( pos.lo pos.hi )
87: seek -2 and ABORT" seek failed."
88: data-buff @ #data @ read ( actual )
89: #data @ <> ABORT" read failed."
90: ;
91:
92:
93: \ This method extracts the information required from primary volume
94: \ descriptor and stores the required information in the global variables
95:
96: : extract-vol-info ( -- )
97: 10 800 * 800 read-data
98: data-buff @ 88 + l@-be to path-tbl-size \ read path table size
99: data-buff @ 94 + l@-be to path-tbl-addr \ read big-endian path table
100: data-buff @ a2 + l@-be dir-addr ! \ gather of root directory info
101: data-buff @ 0aa + l@-be to root-dir-size \ get volume info
102: data-buff @ 54 + l@-be to vol-size \ size in blocks
103: data-buff @ 82 + l@-be to logical-blk-size
104: path-tbl-size alloc-mem dup TO path-table path-tbl-size erase
105: path-tbl-addr 800 * xlsplit seek drop
106: path-table path-tbl-size read drop \ pathtable in-system-memory copy
107: ;
108:
109:
110: \ This method coverts the iso file name to user readble form
111:
112: : file-name ( str len -- str' len' )
113: 2dup [char] ; findchar IF
114: ( str len offset )
115: nip \ Omit the trailing ";1" revision of ISO9660 file name
116: 2dup + 1- ( str newlen endptr )
117: c@ [CHAR] . = IF
118: 1- ( str len' ) \ Remove trailing dot
119: THEN
120: THEN
121: ;
122:
123:
124: \ triplicates top stack element
125:
126: : dup3 ( num -- num num num ) dup dup dup ;
127:
128:
129: \ This method is used for traversing records of path table. If the
130: \ file identifier length is odd 1 byte padding is done else not.
131:
132: : get-next-record ( rec-addr -- next-rec-offset )
133: dup3 ( rec-addr rec-addr rec-addr rec-addr )
134: self @ 1 + self ! ( rec-addr rec-addr rec-addr rec-addr )
135: c@ 1 AND IF ( rec-addr rec-addr rec-addr )
136: c@ + 9 ( rec-addr rec-addr' rec-len )
137: ELSE
138: c@ + 8 ( rec-addr rec-addr' rec-len )
139: THEN
140: + swap - ( next-rec-offset )
141: ;
142:
143:
144: \ This method does search of given directory name in the path table
145: \ and returns true if finds a match else false.
146:
147: : path-table-search ( str len -- TRUE | FALSE )
148: path-table path-tbl-size + path-table ptable @ + DO ( str len )
149: 2dup I 6 + w@-be index @ = ( str len str len )
150: -rot I 8 + I c@ string=ci and IF ( str len )
151: s" Directory Matched!! " iso-debug-print ( str len )
152: self @ index ! ( str len )
153: I 2 + l@-be dir-addr ! I dup ( str len rec-addr )
154: get-next-record + path-table - ptable ! ( str len )
155: 2drop TRUE UNLOOP EXIT ( TRUE )
156: THEN
157: I get-next-record ( str len next-rec-offset )
158: +LOOP
159: 2drop
160: FALSE ( FALSE )
161: s" Invalid path / directory " iso-debug-print
162: ;
163:
164:
165: \ METHOD for searching for a file with in a direcotory
166:
167: : search-file-dir ( str len -- TRUE | FALSE )
168: dir-addr @ 800 * dir-addr ! ( str len )
169: dir-addr @ 100 read-data ( str len )
170: data-buff @ 0e + l@-be dup >r ( str len rec-len )
171: 100 > IF ( str len )
172: s" size dir record" iso-debug-print ( str len )
173: dir-addr @ r@ read-data ( str len )
174: THEN
175: r> data-buff @ + data-buff @ DO ( str len )
176: I 19 + c@ 2 and 0= IF ( str len )
177: 2dup ( str len str len )
178: I 21 + I 20 + c@ ( str len str len str' len' )
179: file-name string=ci IF ( str len )
180: s" File found!" iso-debug-print ( str len )
181: I 6 + l@-be 800 * ( str len file-loc )
182: file-loc ! ( str len )
183: I 0e + l@-be file-size ! ( str len )
184: 2drop
185: TRUE ( TRUE )
186: UNLOOP
187: EXIT
188: THEN
189: THEN
190: I c@ dup 0= IF ( str len len )
191: s" file not found" iso-debug-print
192: drop 2drop FALSE ( FALSE )
193: UNLOOP
194: EXIT
195: THEN
196: +LOOP
197: 2drop
198: FALSE ( FALSE )
199: s" file not found" iso-debug-print
200: ;
201:
202:
203: \ This method splits the given absolute path in to directories from root and
204: \ calls search-path-table. when string reaches to state when it can not be
205: \ split i.e., end of the path, calls search-file-dir is made to search for
206: \ file .
207:
208: : search-path ( str len -- FALSE|TRUE )
209: 0 ptable !
210: 1 self !
211: 1 index !
212: dup ( str len len )
213: 0= IF
214: 3drop FALSE ( FALSE )
215: s" Empty path name " iso-debug-print EXIT ( FALSE )
216: THEN
217: OVER c@ ( str len char )
218: [char] \ = IF ( str len )
219: swap 1 + swap 1 - BEGIN ( str len )
220: [char] \ split ( str len str' len ' )
221: dup 0 = IF ( str len str' len ' )
222: 2drop search-file-dir EXIT ( TRUE | FALSE )
223: ELSE
224: 2swap path-table-search invert IF ( str' len ' )
225: 2drop FALSE EXIT ( FALSE )
226: THEN
227: THEN
228: AGAIN
229: ELSE BEGIN
230: [char] \ split dup 0 = IF ( str len str' len' )
231: 2drop search-file-dir EXIT ( TRUE | FALSE )
232: ELSE
233: 2swap path-table-search invert IF ( str' len ' )
234: 2drop FALSE EXIT ( FALSE )
235: THEN
236: THEN
237: AGAIN
238: THEN
239: ;
240:
241:
242: \ this method will seek and read the file in to the given memory location
243:
244: 0 VALUE loc
245: : load ( addr -- len )
246: dup to loc ( addr )
247: file-loc @ xlsplit seek drop
248: file-size @ read ( file-size )
249: iso-debug-flag IF s" Bytes returned from read:" type dup . cr THEN
250: dup file-size @ <> ABORT" read failed!"
251: ;
252:
253:
254:
255: \ memory used by the file system will be freed
256:
257: : close ( -- )
258: free-data count 1 - dup to count 0 = IF
259: path-table path-tbl-size free-mem
260: 0 TO path-table
261: THEN
262: ;
263:
264:
265: \ open method of the file system
266:
267: : open ( -- TRUE | FALSE )
268: 0 data-buff !
269: 0 #data !
270: 0 ptable !
271: 0 file-loc !
272: 0 file-size !
273: 0 cur-file-offset !
274: 1 self !
275: 1 index !
276: count 0 = IF
277: s" extract-vol-info called " iso-debug-print
278: extract-vol-info
279: THEN
280: count 1 + to count
281: my-args search-path IF
282: file-loc @ xlsplit seek drop
283: TRUE ( TRUE )
284: ELSE
285: close
286: FALSE ( FALSE )
287: THEN
288: 0 cur-file-offset !
289: s" opened ISO9660 package" iso-debug-print
290: ;
291:
292:
293: \ public seek method
294:
295: : seek ( pos.lo pos.hi -- status )
296: lxjoin dup cur-file-offset ! ( offset )
297: file-loc @ + xlsplit ( pos.lo pos.hi )
298: s" seek" $call-parent ( status )
299: ;
300:
301:
302: \ public read method
303:
304: : read ( addr len -- actual )
305: file-size @ cur-file-offset @ - ( addr len remainder-of-file )
306: min ( addr len|remainder-of-file )
307: s" read" $call-parent ( actual )
308: dup cur-file-offset @ + cur-file-offset ! ( actual )
309: cur-file-offset @ ( offset actual )
310: xlsplit seek drop ( actual )
311: ;
312:
This archive runs on limited infrastructure. Preserving old code on modern bandwidth. Automated agents are requested to crawl responsibly.