qemu/roms/SLOF/slof/fs/packages/iso-9660.fs

   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 ! 0 #data ! 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    dup #data @ > IF
  85       free-data dup dup                  ( offset size size size )
  86       #data ! alloc-mem data-buff !      ( offset size )
  87    THEN
  88    swap xlsplit                          ( size pos.lo pos.hi )
  89    seek   -2 and ABORT" seek failed."
  90    data-buff @ over read                 ( size actual )
  91    <> ABORT" read failed."
  92 ;
  93
  94
  95 \ This method extracts the information required from primary volume
  96 \ descriptor and stores the required information in the global variables
  97
  98 : extract-vol-info  (  --  )
  99    10  800 * 800 read-data
 100    data-buff @  88  + l@-be  to path-tbl-size   \ read path table size
 101    data-buff @  94  + l@-be  to path-tbl-addr   \ read big-endian  path table
 102    data-buff @  a2  + l@-be   dir-addr !        \ gather of root directory info
 103    data-buff @  0aa + l@-be  to root-dir-size   \ get volume info
 104    data-buff @  54  + l@-be  to vol-size        \ size in blocks
 105    data-buff @  82  + l@-be  to logical-blk-size
 106    path-tbl-size alloc-mem dup  TO path-table path-tbl-size erase
 107    path-tbl-addr 800 *  xlsplit seek  drop
 108    path-table  path-tbl-size  read  drop     \ pathtable in-system-memory copy
 109 ;
 110
 111
 112 \ This method coverts the iso file name to user readble form
 113
 114 : file-name  ( str len --  str' len' )
 115    2dup  [char] ; findchar  IF
 116       ( str len offset )
 117       nip                 \ Omit the trailing ";1" revision of ISO9660 file name
 118       2dup + 1-           ( str newlen endptr )
 119       c@ [CHAR] . = IF
 120          1-               ( str len' )    \ Remove trailing dot
 121       THEN
 122    THEN
 123 ;
 124
 125
 126 \ triplicates top stack element
 127
 128 : dup3  ( num  -- num num num ) dup dup dup  ;
 129
 130
 131 \ This method is used for traversing records of path table. If the
 132 \ file identifier length is odd 1 byte padding is done else not.
 133
 134 : get-next-record  ( rec-addr -- next-rec-offset )
 135    dup3               ( rec-addr rec-addr rec-addr rec-addr )
 136    self @ 1 +  self ! ( rec-addr rec-addr rec-addr rec-addr )
 137    c@  1 AND  IF      ( rec-addr rec-addr rec-addr )
 138       c@ +  9         ( rec-addr rec-addr' rec-len )
 139    ELSE
 140       c@ +  8         ( rec-addr rec-addr' rec-len )
 141    THEN
 142    + swap  -          ( next-rec-offset )
 143 ;
 144
 145
 146 \  This method does search of given directory name in the path table
 147 \ and returns true  if finds a match else  false.
 148
 149 : path-table-search ( str len -- TRUE | FALSE )
 150    path-table path-tbl-size +  path-table ptable @ +  DO ( str len )
 151       2dup  I 6 + w@-be index @ =                        ( str len str len )
 152       -rot  I 8 +  I c@
 153       iso-debug-flag IF
 154           ." ISO: comparing path name '"
 155           4dup type ." ' with '" type ." '" cr
 156       THEN
 157       string=ci and  IF                                  ( str len )
 158          s" Directory Matched!!  "   iso-debug-print     ( str len )
 159          self @   index !                                ( str len )
 160          I 2 + l@-be   dir-addr ! I  dup                 ( str len rec-addr )
 161          get-next-record + path-table -   ptable !       ( str len )
 162          2drop  TRUE UNLOOP EXIT                         ( TRUE )
 163       THEN
 164       I get-next-record                           ( str len next-rec-offset )
 165    +LOOP
 166    2drop
 167    FALSE                                          ( FALSE )
 168    s" Invalid path / directory "  iso-debug-print
 169 ;
 170
 171
 172 \ METHOD for searching for a file with in a direcotory
 173
 174 : search-file-dir ( str len  -- TRUE | FALSE )
 175    dir-addr @  800 *  dir-addr !             ( str len )
 176    dir-addr @ 100 read-data                  ( str len )
 177    data-buff @  0e + l@-be  dup >r           ( str len rec-len )
 178    100 >  IF                                 ( str len )
 179       s" size dir record"  iso-debug-print   ( str len )
 180       dir-addr @ r@  read-data               ( str len )
 181    THEN
 182    r> data-buff @  + data-buff @  DO         ( str len )
 183       I 19 + c@  2 and 0=  I c@ 0<> and IF   ( str len )
 184          2dup                                ( str len  str len )
 185          I 21 + I 20 + c@                    ( str len  str len  str' len' )
 186          iso-debug-flag IF
 187              ." ISO: comparing file name '"
 188              4dup type ." ' with '" type ." '" cr
 189          THEN
 190          file-name  string=ci  IF            ( str len )
 191             s" File found!"  iso-debug-print ( str len )
 192             I 6 + l@-be 800 *                ( str len file-loc )
 193             file-loc !                       ( str len )
 194             I 0e + l@-be  file-size !        ( str len )
 195             2drop
 196             TRUE                             ( TRUE )
 197             UNLOOP
 198             EXIT
 199          THEN
 200       THEN
 201       ( str len )
 202       I c@ ?dup 0= IF
 203          800 I 7ff AND -
 204          iso-debug-flag IF
 205             ." skipping " dup . ." bytes at end of sector" cr
 206          THEN
 207       THEN
 208       ( str len offset )
 209    +LOOP
 210    2drop
 211    FALSE                                     ( FALSE )
 212    s" file not found"   iso-debug-print
 213 ;
 214
 215
 216 \ This method splits the given absolute path in to directories from root and
 217 \ calls search-path-table. when string reaches to state when it can not be
 218 \ split i.e., end of the path, calls search-file-dir is made to search for
 219 \ file .
 220
 221 : search-path ( str len -- FALSE|TRUE )
 222    0  ptable !
 223    1  self !
 224    1  index !
 225    dup                                             ( str len len )
 226    0=  IF
 227       3drop FALSE                                  ( FALSE )
 228       s"  Empty path name "  iso-debug-print  EXIT ( FALSE )
 229    THEN
 230    OVER c@                                         ( str len char )
 231    [char] \ =  IF                                  ( str len )
 232       swap 1 + swap 1 -  BEGIN                     ( str len )
 233          [char] \  split                           ( str len  str' len ' )
 234          dup 0 =   IF                              ( str len  str' len ' )
 235             2drop search-file-dir EXIT             ( TRUE | FALSE )
 236          ELSE
 237             2swap path-table-search  invert  IF    ( str' len ' )
 238                2drop FALSE  EXIT                   ( FALSE )
 239             THEN
 240          THEN
 241       AGAIN
 242    ELSE   BEGIN
 243       [char] \  split   dup 0 =   IF               ( str len str' len' )
 244          2drop search-file-dir EXIT                ( TRUE | FALSE )
 245       ELSE
 246          2swap path-table-search  invert  IF       ( str' len ' )
 247             2drop FALSE  EXIT                      ( FALSE )
 248             THEN
 249          THEN
 250       AGAIN
 251    THEN
 252 ;
 253
 254
 255 \ this method will seek and read the file in to the given memory location
 256
 257 0 VALUE loc
 258 : load ( addr -- len )
 259    dup to loc                     ( addr )
 260    file-loc @  xlsplit seek drop
 261    file-size @  read              ( file-size )
 262    iso-debug-flag IF s" Bytes returned from read:" type dup . cr THEN
 263    dup file-size @  <> ABORT" read failed!"
 264 ;
 265
 266
 267
 268 \ memory used by the file system will be freed
 269
 270 : close ( -- )
 271    free-data   count 1 - dup to count  0 =  IF
 272       path-table path-tbl-size free-mem
 273       0 TO path-table
 274    THEN
 275 ;
 276
 277
 278 \ open method of the file system
 279
 280 : open ( -- TRUE | FALSE )
 281    0 data-buff !
 282    0 #data !
 283    0 ptable !
 284    0 file-loc !
 285    0 file-size !
 286    0 cur-file-offset !
 287    1 self !
 288    1 index !
 289    count 0 =  IF
 290       s" extract-vol-info called "   iso-debug-print
 291       extract-vol-info
 292    THEN
 293    count  1 + to count
 294    my-args search-path  IF
 295       file-loc @  xlsplit seek drop
 296       TRUE    ( TRUE )
 297    ELSE
 298       close
 299       FALSE   ( FALSE )
 300    THEN
 301    0 cur-file-offset !
 302    s" opened ISO9660 package" iso-debug-print
 303 ;
 304
 305
 306 \ public seek method
 307
 308 : seek ( pos.lo pos.hi -- status )
 309    lxjoin dup  cur-file-offset !  ( offset )
 310    file-loc @  + xlsplit          ( pos.lo pos.hi )
 311    s" seek" $call-parent          ( status )
 312 ;
 313
 314
 315 \ public read method
 316
 317  : read ( addr len -- actual )
 318     file-size @ cur-file-offset @ -             ( addr len remainder-of-file )
 319     min                                         ( addr len|remainder-of-file )
 320     s" read" $call-parent                       ( actual )
 321     dup cur-file-offset @ +  cur-file-offset !  ( actual )
 322     cur-file-offset @                           ( offset actual )
 323     xlsplit seek drop                           ( actual )
 324 ;
 325