summaryrefslogtreecommitdiffstats
path: root/qemu/roms/SLOF/slof/fs/packages/iso-9660.fs
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 )
;