xref: /onnv-gate/usr/src/psm/stand/bootblks/hsfs/common/hsfs.fth (revision 10003:f07f995d4507)
15648Ssetje\
25648Ssetje\ CDDL HEADER START
35648Ssetje\
45648Ssetje\ The contents of this file are subject to the terms of the
55648Ssetje\ Common Development and Distribution License (the "License").
65648Ssetje\ You may not use this file except in compliance with the License.
75648Ssetje\
85648Ssetje\ You can obtain a copy of the license at usr/src/OPENSOLARIS.LICENSE
95648Ssetje\ or http://www.opensolaris.org/os/licensing.
105648Ssetje\ See the License for the specific language governing permissions
115648Ssetje\ and limitations under the License.
125648Ssetje\
135648Ssetje\ When distributing Covered Code, include this CDDL HEADER in each
145648Ssetje\ file and include the License file at usr/src/OPENSOLARIS.LICENSE.
155648Ssetje\ If applicable, add the following below this CDDL HEADER, with the
165648Ssetje\ fields enclosed by brackets "[]" replaced with your own identifying
175648Ssetje\ information: Portions Copyright [yyyy] [name of copyright owner]
185648Ssetje\
195648Ssetje\ CDDL HEADER END
205648Ssetje\
215648Ssetje\
229941SJohn.Johnson@Sun.COM\
239941SJohn.Johnson@Sun.COM\ Copyright 2009 Sun Microsystems, Inc.  All rights reserved.
249941SJohn.Johnson@Sun.COM\ Use is subject to license terms.
259941SJohn.Johnson@Sun.COM\
265648Ssetje
275648Ssetjepurpose: HSFS file system support package for NewBoot
289941SJohn.Johnson@Sun.COMcopyright: Copyright 2009 Sun Microsystems, Inc. All Rights Reserved
295648Ssetje
305648Ssetje\ High Sierra, Rock Ridge (CD-ROM) file system reader and boot block
315648Ssetje
325648Ssetjeheaders
335648Ssetje" /packages" get-package  push-package
345648Ssetje
355648Ssetjenew-device
365648Ssetje   fs-pkg$  device-name  diag-cr?
375648Ssetje
385648Ssetje   \
395648Ssetje   \	HSFS variables
405648Ssetje   \
415648Ssetje   0 instance value dev-ih
425648Ssetje   0 instance value vol-desc
435648Ssetje   0 instance value dir-buf
445648Ssetje   0 instance value sua-buf
455648Ssetje   0 instance value ce-buf
465648Ssetje
475648Ssetje   \
485648Ssetje   \	HSFS volume descriptor routines
495648Ssetje   \
505648Ssetje
515648Ssetje   \ unaligned load of 2-byte item
525648Ssetje   : xw@  ( adr -- n )
535648Ssetje      dup c@ swap char+   ( c0 adr+1 )
545648Ssetje      c@                  ( c0 c1 )
555648Ssetje      bwjoin
565648Ssetje   ;
575648Ssetje
585648Ssetje   \ unaligned store of 2-byte item
595648Ssetje   : xw!  ( n adr -- )
605648Ssetje      swap wbsplit swap 2 pick c! swap char+ c!
615648Ssetje   ;
625648Ssetje
635648Ssetje   \ unaligned load of 4-byte item
645648Ssetje   : xl@  ( adr -- n )
655648Ssetje      dup xw@ swap wa1+   ( w0 adr+2 )
665648Ssetje      xw@                 ( w0 w1 )
675648Ssetje      wljoin
685648Ssetje   ;
695648Ssetje   \ unaligned store of 4-byte item
705648Ssetje   : xl!  ( n adr -- )
715648Ssetje      swap lwsplit swap 2 pick xw! swap wa1+ xw!
725648Ssetje   ;
735648Ssetje
745648Ssetje   d# 2048 constant /sector
755648Ssetje   d# 16 constant vol-desc-sector#  ( -- n )
765648Ssetje
775648Ssetje   : +vd  ( index -- adr )
785648Ssetje      vol-desc 0= if
795648Ssetje         ." invalid access of +vd" cr abort
805648Ssetje      then
815648Ssetje      vol-desc +
825648Ssetje   ;
835648Ssetje
845648Ssetje   : root-dir  ( -- n )  d# 156 +vd  ;
855648Ssetje   : /block    ( -- n )  d# 128 +vd xw@  ;
865648Ssetje   : byte>blkoff  ( byte-off -- block-off )  /block mod  ;
875648Ssetje
885648Ssetje   : get-vol-desc  ( -- )
895648Ssetje      vol-desc  /sector  vol-desc-sector# /sector *  dev-ih  read-disk
905648Ssetje   ;
915648Ssetje
925648Ssetje   : read-fs-blocks  ( adr len fs-blk# -- )  /block *  dev-ih  read-disk  ;
935648Ssetje
945648Ssetje   \
955648Ssetje   \	HSFS directory routines
965648Ssetje   \
975648Ssetje
985648Ssetje   \ Current directory variables.
995648Ssetje   instance variable cdir-blk		\ Current directory device block ptr.
1005648Ssetje   instance variable cdir-blk0          \ Current directory block0.
1015648Ssetje   instance variable cdir-offset	\ Current directory logical offset.
1025648Ssetje   instance variable cdir-size		\ Current directory logical size.
1035648Ssetje   instance variable cdir-ptr		\ Current directory entry pointer.
1045648Ssetje   false instance value cdir-rescan     \ Rescan current directory for symlink.
1055648Ssetje
1065648Ssetje   \ Access of current directory entry.
1075648Ssetje   : +dr  ( n -- adr )  cdir-ptr @ +  ;
1085648Ssetje
1095648Ssetje   : dir-entrylen    ( -- n )    d# 0  +dr c@  ;
1105648Ssetje   : dir-block0      ( -- n )    d# 2  +dr xl@  ;
1115648Ssetje   : dir-filesize    ( -- n )    d# 10 +dr xl@  ;
1125648Ssetje   : dir-flags       ( -- n )    d# 25 +dr c@  ;
1135648Ssetje   : dir-filenamelen ( -- n )    d# 32 +dr c@  ;
1145648Ssetje   : dir-filename    ( -- adr )  d# 33 +dr  ;
1155648Ssetje
1165648Ssetje   : dir-isdir?      ( -- flag )  dir-flags  h# 02  and  0<>  ;
1175648Ssetje   : dir-file$       ( -- adr len )  dir-filename  dir-filenamelen  ;
1185648Ssetje   : dir-sualen      ( -- len )  dir-entrylen  d# 33 -  dir-filenamelen -  ;
1195648Ssetje
1207283Sjgj   \ ISO name, including dot & dot-dot check
1217283Sjgj   : dir-iso$        ( -- adr len )
1227283Sjgj      dir-filenamelen 1  =  if
1237283Sjgj         dir-filename c@             ( name[0] )
1247283Sjgj         dup 0=  if
1257283Sjgj            drop " ."  exit          ( dot )
1267283Sjgj         then
1277283Sjgj         1 =  if                     (  )
1287283Sjgj            " .."  exit              ( dot-dot )
1297283Sjgj         then
1307283Sjgj      then
1317283Sjgj      dir-file$                      ( name$ )
1327283Sjgj   ;
1337283Sjgj
1345648Ssetje   false instance value symlink?
1355648Ssetje
1365648Ssetje   : get-dirblk  ( -- )
1375648Ssetje      dir-buf /block  cdir-blk @  read-fs-blocks
1385648Ssetje      1 cdir-blk +!
1395648Ssetje   ;
1405648Ssetje
1415648Ssetje   : froot  ( -- )  root-dir cdir-ptr !  ;
1425648Ssetje
1435648Ssetje   \
1445648Ssetje   \ SUAs - System Use Area in directory entry (Rock Ridge
1455648Ssetje   \  Extensions to High Sierra/ISO 9660 Format).
1465648Ssetje   \  Immediately follows directory entry name rounded up to
1475648Ssetje   \  a half-word boundary.
1485648Ssetje   \
1495648Ssetje   0 instance value sua-ptr
1505648Ssetje   0 instance value sua-len
1515648Ssetje
1525648Ssetje   : +suf           ( n -- adr )    sua-ptr +  ;
1535648Ssetje   : suf-sig        ( -- adr len )  sua-ptr 2  ;
1545648Ssetje   : suf-len        ( -- len )      2 +suf c@  ;
1555648Ssetje   : suf-dat        ( -- data )     5 +suf  ;
1565648Ssetje   : suf-ce-lbn     ( -- lbn )      4 +suf xl@ ;
1575648Ssetje   : suf-ce-offset  ( -- offset )   d# 12 +suf xl@ ;
1585648Ssetje   : suf-ce-len     ( -- len )      d# 20 +suf xl@ ;
1595648Ssetje
1605648Ssetje   : init-sua     ( -- )
1617283Sjgj      dir-file$ +  /w roundup  to sua-ptr
1627283Sjgj      dir-sualen               to sua-len
1635648Ssetje   ;
1645648Ssetje
1655648Ssetje   : next-suf  ( -- )
1665648Ssetje      sua-len suf-len -  to sua-len
1675648Ssetje      suf-len +suf       to sua-ptr
1685648Ssetje   ;
1695648Ssetje
1705648Ssetje   : end-sua  ( -- end? )
1715648Ssetje      sua-len 4 <
1725648Ssetje   ;
1735648Ssetje
1745648Ssetje   : suf-nm$  ( -- adr len )  suf-dat  suf-len 5 -  ;
1755648Ssetje
1765648Ssetje   \ Continuation suffix handling.  When a 'CE' suffix is seen,
1775648Ssetje   \ record the CE parameters (logical block#, offset and length
1785648Ssetje   \ of continuation).  We process the CE continuation only after
1795648Ssetje   \ we've finished processing the current SUA area.
1805648Ssetje   instance variable ce-lbn
1815648Ssetje   instance variable ce-offset
1825648Ssetje   instance variable ce-len
1835648Ssetje   : suf-ce-set  ( -- )
1845648Ssetje      suf-ce-lbn ce-lbn !
1855648Ssetje      suf-ce-offset ce-offset !
1865648Ssetje      suf-ce-len ce-len !
1875648Ssetje   ;
1885648Ssetje
1895648Ssetje   : suf-ce-process  ( -- error? )
1905648Ssetje      ce-lbn @ 0= if
1915648Ssetje         true
1925648Ssetje      else
1935648Ssetje         sua-buf ce-len @ ce-lbn @  read-fs-blocks
1945648Ssetje         sua-buf   to sua-ptr
1955648Ssetje         ce-len @  to sua-len
1965648Ssetje         0 ce-len ! 0 ce-lbn ! 0 ce-offset !
1975648Ssetje         false
1985648Ssetje      then
1995648Ssetje   ;
2005648Ssetje
2015648Ssetje   /buf-len  instance buffer: suf-sl-buf
2025648Ssetje   false     instance value   symlink-need-sep
2035648Ssetje
2045648Ssetje   \ Format of Rock Ridge symlinks needs to be munged to unix-style
2055648Ssetje   \ name.  Format is:  <flag><nbytes>file-name<flag><nbytes>filename...
2065648Ssetje   \ where \ <flag> is flag byte (0=filename, 2=current dir, 4=parent
2075648Ssetje   \ dir, 8=root dir) and <nbytes> is one-byte byte count (zero for
2085648Ssetje   \ !filename).
2095648Ssetje   : suf-copy-to-symlinkbuf  ( name$  -- )
2105648Ssetje       false to symlink-need-sep
2115648Ssetje       suf-sl-buf -rot bounds do           ( dst )
2125648Ssetje          symlink-need-sep if
2135648Ssetje             ascii / over c! char+
2145648Ssetje          then
2155648Ssetje          true to symlink-need-sep
2165648Ssetje          i c@ dup 2 = if                   ( dst 2 )
2175648Ssetje             \ CURRENT (".")
2185648Ssetje             drop ascii . over c! char+ 2   ( dst' inc )
2195648Ssetje          else  dup 4 =  if                 ( dst 4 )
2205648Ssetje             \ PARENT ("..")
2215648Ssetje             drop " .." 2 pick swap move    ( dst )
2225648Ssetje             wa1+ 2                         ( dst' inc )
2235648Ssetje          else  dup 8 =  if                 ( dst 8 )
2245648Ssetje             \ ROOT ("/")
2255648Ssetje             drop ascii / over c! char+ 2   ( dst' inc )
2265648Ssetje             false to symlink-need-sep
2275648Ssetje          else  dup 0<> if
2285648Ssetje             ." unknown SL flag: " .x cr abort
2295648Ssetje          else                              ( dst c )
2305648Ssetje             drop                           ( dst )
2315648Ssetje             i char+ dup c@ >r              ( dst src+1  R:nbytes )
2325648Ssetje             char+ over r@ move             ( dst R:nbytes )
2335648Ssetje             r@ +                           ( dst' R:nbytes )
2345648Ssetje             r> wa1+                        ( dst' inc )
2355648Ssetje          then then then then
2365648Ssetje       +loop                                ( dst )
2375648Ssetje       0 swap c!
2385648Ssetje    ;
2395648Ssetje
2405648Ssetje   \ Saved 'NM' prefix buffer.
2415648Ssetje   /buf-len  instance buffer: suf-nm-buf
2425648Ssetje   0 instance value suf-nm-size
2435648Ssetje
2445648Ssetje   \ Return the Rock Ridge file name associated with the current
2455648Ssetje   \ dirent ('NM' suffix).  Otherwise returns standard iso filename.
2465648Ssetje   \ Marks whether returned filename is a symbolic link ('SL' suffix)
2475648Ssetje   \ and also processes continuations ('CE' suffix).
2485648Ssetje   : rr-file$ ( -- adr len )
2495648Ssetje      false to symlink?
2505648Ssetje      0 to suf-nm-size
2515648Ssetje
2525648Ssetje      \ select start of sua, record sua offset
2535648Ssetje      init-sua
2545648Ssetje      begin
2555648Ssetje         end-sua  if
2565648Ssetje            suf-ce-process if
2575648Ssetje               suf-nm-size if
2587283Sjgj                  suf-nm-buf suf-nm-size       ( NM$ )
2595648Ssetje               else
2607283Sjgj                  dir-iso$                     ( iso$ )
2617283Sjgj               then                            ( file$ )
2625648Ssetje               exit
2635648Ssetje            then
2645648Ssetje         then
2655648Ssetje         suf-sig                               ( sig-adr sig-len )
2665648Ssetje         2dup " NM"  $=  if
2675648Ssetje            suf-nm$ to suf-nm-size             ( sig-adr sig-len suf-nm-adr )
2685648Ssetje            suf-nm-buf suf-nm-size move
2695648Ssetje         then                                  ( sig-adr sig-len )
2705648Ssetje         2dup " SL"  $=  if
2715648Ssetje            true to symlink?
2725648Ssetje            suf-nm$ suf-copy-to-symlinkbuf
2735648Ssetje         then
2745648Ssetje         2dup " CE"  $=  if
2755648Ssetje            suf-ce-set
2765648Ssetje         then                                  ( sig-adr sig-len )
2775648Ssetje         2drop  next-suf                       (  )
2785648Ssetje      again
2795648Ssetje   ;
2805648Ssetje
2815648Ssetje   \
2825648Ssetje   \	HSFS high-level routines
2835648Ssetje   \
2845648Ssetje
2855648Ssetje   \ Used for rescanning current directory for symbolic links.
2865648Ssetje
2875648Ssetje   \ Initializes current directory settings from current directory
2885648Ssetje   \ entry pointer or for rescan.  If it's not a rescan, we have
2895648Ssetje   \ access to the actual directory entry, so we can check whether
2905648Ssetje   \ it's a directory or not here.
2915648Ssetje   : init-dent  ( -- error? )
2925648Ssetje      cdir-rescan if
2935648Ssetje         false to cdir-rescan
2945648Ssetje         cdir-blk0 @ cdir-blk !
2955648Ssetje      else
2965648Ssetje         dir-isdir? 0= if
2975648Ssetje            true exit
2985648Ssetje         then
2995648Ssetje         dir-block0 dup cdir-blk ! cdir-blk0 !
3005648Ssetje         dir-filesize cdir-size !
3015648Ssetje      then                                    ( blk0 size )
3025648Ssetje      0 cdir-offset !
3035648Ssetje      false
3045648Ssetje   ;
3055648Ssetje
3065648Ssetje   : get-dent ( -- error? )
3075648Ssetje      begin
3085648Ssetje         \ Check for end of directory, return true if we're past the EOF.
3095648Ssetje         cdir-offset @  cdir-size @  >=  if
3105648Ssetje            true  exit
3115648Ssetje         then
3125648Ssetje
3135648Ssetje         \ If we're at a block boundary, get the next block.  Otherwise
3145648Ssetje         \ increment the directory pointer.
3155648Ssetje         cdir-offset @ byte>blkoff  0=  if
3165648Ssetje            get-dirblk
3175648Ssetje            dir-buf cdir-ptr !
3185648Ssetje         else
3195648Ssetje            dir-entrylen cdir-ptr +!
3205648Ssetje         then
3215648Ssetje
3225648Ssetje         \ If dir-entrylen is not zero, increment the current directory
3235648Ssetje         \ file offset.  Otherwise, a dir-entrylen of zero indicates
3245648Ssetje         \ the end of a dir block, so round up cdir-offset to fetch the
3255648Ssetje         \ next one
3265648Ssetje         dir-entrylen ?dup if
3275648Ssetje            cdir-offset +!  true
3285648Ssetje         else
3295648Ssetje            cdir-offset @  /block  roundup  cdir-offset !
3305648Ssetje            false
3315648Ssetje         then
3325648Ssetje      until  false
3335648Ssetje   ;
3345648Ssetje
3355648Ssetje   \ Look through current directory for file name 'file$'.
3365648Ssetje   \ Will leave current directory entry (cdir-ptr) pointing
3375648Ssetje   \ to matched entry on success.
3385648Ssetje   : dirlook  ( file$ -- error? )
3395648Ssetje      init-dent if
3405648Ssetje         true exit
3415648Ssetje      then
3425648Ssetje      begin  get-dent 0=  while      ( file$ )
3435648Ssetje         2dup rr-file$ $=  if        ( file$ )
3447283Sjgj            2drop false  exit        ( succeeded )
3455648Ssetje         then                        ( file$ )
3465648Ssetje      repeat 2drop true              ( failed )
3475648Ssetje   ;
3485648Ssetje
3495648Ssetje   /buf-len  instance buffer: symlink-buf
3505648Ssetje   : symlink-buf$  ( -- path$ )  symlink-buf cscount  ;
3515648Ssetje
3525648Ssetje   : follow-symlink  ( tail$ -- tail$' )
3535648Ssetje
3545648Ssetje      \ copy symlink value (plus null) to buf
3555648Ssetje      suf-sl-buf cscount 1+  symlink-buf swap  move
3565648Ssetje      false to symlink?
3575648Ssetje
3585648Ssetje      \ append to current path
3595648Ssetje      ?dup  if                                              ( tail$ )
3605648Ssetje	 " /" symlink-buf$  $append                         ( tail$ )
3615648Ssetje	 symlink-buf$  $append                              (  )
3625648Ssetje      else  drop  then                                      (  )
3635648Ssetje      symlink-buf$                                          ( path$ )
3645648Ssetje      over c@  ascii /  =  if                               ( path$ )
3655648Ssetje	 froot  str++                                       ( path$' )
3665648Ssetje      else
3675648Ssetje         true to cdir-rescan
3685648Ssetje      then                                                  ( path$ )
3695648Ssetje   ;
3705648Ssetje
3715648Ssetje   : lookup  ( path$ -- error? )
3725648Ssetje      over c@  ascii /  =  if
3735648Ssetje	 froot  str++                            ( path$' )
3745648Ssetje      then                                       ( path$ )
3755648Ssetje      begin                                      ( path$ )
3765648Ssetje         ascii / left-parse-string               ( path$ file$ )
3775648Ssetje      dup  while                                 ( path$ file$ )
3785648Ssetje         dirlook  if
3795648Ssetje            2drop true  exit                     ( failed )
3805648Ssetje         then                                    ( path$ )
3815648Ssetje         symlink?  if
3825648Ssetje            follow-symlink                       ( path$' )
3835648Ssetje         then                                    ( path$ )
3845648Ssetje      repeat                                     ( path$ file$ )
3855648Ssetje      2drop 2drop  false                         ( succeeded )
3865648Ssetje   ;
3875648Ssetje
3885648Ssetje
3895648Ssetje   \
3905648Ssetje   \	HSFS installation routines
3915648Ssetje   \
3925648Ssetje
3935648Ssetje   \ Allocate memory for necessary data structures.  Need to
3945648Ssetje   \ read volume desriptor sector in order to get /block value.
3955648Ssetje   : initialize  ( -- error? )
3965648Ssetje      /sector  mem-alloc to vol-desc
3975648Ssetje      get-vol-desc
3985648Ssetje      /block   mem-alloc to dir-buf
3995648Ssetje      /block   mem-alloc to sua-buf
4005648Ssetje      /block   mem-alloc to ce-buf
4015648Ssetje   ;
4025648Ssetje
4035648Ssetje   : release-buffers  ( -- )
4045648Ssetje      ce-buf      /block  mem-free
4055648Ssetje      sua-buf	  /block  mem-free
4065648Ssetje      dir-buf     /block  mem-free
4075648Ssetje      vol-desc    /sector mem-free
4085648Ssetje      0 to vol-desc
4095648Ssetje   ;
4105648Ssetje
4115648Ssetje
4125648Ssetje   \ HSFS file interface
4135648Ssetje   struct
4145648Ssetje      /x     field >filesize
4155648Ssetje      /x     field >offset
4165648Ssetje      /x     field >block0
4175648Ssetje   constant /file-record
4185648Ssetje
4195648Ssetje   d# 10                  constant #opens
4205648Ssetje   #opens /file-record *  constant /file-records
4215648Ssetje
4225648Ssetje   /file-records  instance buffer: file-records
4235648Ssetje
4245648Ssetje   -1 instance value current-fd
4255648Ssetje
4265648Ssetje   : fd>record  ( fd -- record )  /file-record *  file-records +  ;
4275648Ssetje
4285648Ssetje   : set-fd  ( fd -- error? )
4295648Ssetje      dup 0 #opens 1 - between 0= if
4305648Ssetje         drop true exit
4315648Ssetje      then
4325648Ssetje      dup fd>record  >block0 x@ 0= if
4335648Ssetje         drop true exit
4345648Ssetje      then
4355648Ssetje      to current-fd false
4365648Ssetje   ;
4375648Ssetje
4385648Ssetje   : file-offset@  ( -- off )
4395648Ssetje      current-fd fd>record >offset x@
4405648Ssetje   ;
4415648Ssetje
4425648Ssetje   : file-offset!  ( off -- )
4435648Ssetje      current-fd fd>record >offset x!
4445648Ssetje   ;
4455648Ssetje
4465648Ssetje   : file-size@  ( -- size )
4475648Ssetje      current-fd fd>record >filesize x@
4485648Ssetje   ;
4495648Ssetje
4505648Ssetje   : file-size!  ( size -- )
4515648Ssetje      current-fd fd>record >filesize x!
4525648Ssetje   ;
4535648Ssetje
4545648Ssetje   : file-block0@  ( -- block0 )
4555648Ssetje      current-fd fd>record >block0 x@
4565648Ssetje   ;
4575648Ssetje
4585648Ssetje   : file-block0!  ( block0 -- )
4595648Ssetje      current-fd fd>record >block0 x!
4605648Ssetje   ;
4615648Ssetje
4625648Ssetje   : get-slot  ( -- fd false | true )
4635648Ssetje      #opens 0  do
4645648Ssetje         i fd>record >block0 x@  0=  if
4655648Ssetje            i false  unloop exit
4665648Ssetje         then
4675648Ssetje      loop  true
4685648Ssetje   ;
4695648Ssetje
4705648Ssetje   : free-slot  ( fd -- )
4715648Ssetje      set-fd 0= if
4725648Ssetje         0 file-offset!
4735648Ssetje         0 file-size!
4745648Ssetje         0 file-block0!
4755648Ssetje      then
4765648Ssetje   ;
4775648Ssetje
4785648Ssetje   \ initializes the open structure with information from
4795648Ssetje   \ the inode (on UFS) or directory entry (from HSFS).
4805648Ssetje   : init-fd  ( fd -- )
4815648Ssetje      to current-fd
4825648Ssetje      dir-block0 file-block0!
4835648Ssetje      dir-filesize file-size!
4845648Ssetje      0 file-offset!
4855648Ssetje   ;
4865648Ssetje
4875648Ssetje   external
4885648Ssetje
4895648Ssetje   : open ( -- okay? )
4905648Ssetje      my-args dev-open  dup 0=  if       ( 0 )
4915648Ssetje         exit                            ( failed )
4925648Ssetje      then  to dev-ih
4935648Ssetje
4945648Ssetje      initialize  froot
4955648Ssetje      file-records /file-records  erase
4965648Ssetje      true                               ( succeeded )
4975648Ssetje   ;
4985648Ssetje
4995648Ssetje   : close  ( -- )
5005648Ssetje      dev-ih dev-close
5015648Ssetje      release-buffers
5025648Ssetje   ;
5035648Ssetje
5045648Ssetje   : open-file  ( path$ -- fd true | false )
5055648Ssetje      get-slot  if
5065648Ssetje	 2drop false  exit            ( failed )
5075648Ssetje      then  -rot                      ( fd path$ )
5085648Ssetje
5095648Ssetje      lookup  if                      ( fd )
5105648Ssetje	 drop false  exit             ( failed )
5115648Ssetje      then
5125648Ssetje
5135648Ssetje      dup init-fd true                ( fd success )
5145648Ssetje   ;
5155648Ssetje
5165648Ssetje   : close-file  ( fd -- )
5175648Ssetje      free-slot   (  )
5185648Ssetje   ;
5195648Ssetje
5205648Ssetje   : read-file   ( adr len fd -- #read )
5215648Ssetje
5225648Ssetje      \ Check if fd is valid, if it is set current-fd.
5235648Ssetje      set-fd if
5245648Ssetje         2drop 0 exit
5255648Ssetje      then                                   ( adr len )
5265648Ssetje
5275648Ssetje      \ Adjust len if less than len bytes remain.
5285648Ssetje      file-size@ file-offset@ - min          ( adr len' )
5295648Ssetje
5305648Ssetje      \ Check for invalid length read.
5315648Ssetje      dup 0<=  if  2drop 0 exit  then
5325648Ssetje
5335648Ssetje      \ Compute physical device byte offset.
5345648Ssetje      tuck                                   ( len adr len )
5355648Ssetje      file-block0@ /block * file-offset@ +   ( len adr len off )
5365648Ssetje      dev-ih read-disk                       ( #read )
537*10003SJohn.Johnson@Sun.COM      dup file-offset@ +  file-offset!
5385648Ssetje   ;
5395648Ssetje
5405648Ssetje   : seek-file  ( off fd -- error? )
5415648Ssetje      set-fd  if                ( off )
5425648Ssetje         drop false  exit       ( failed )
5435648Ssetje      then                      ( off )
5445648Ssetje
5455648Ssetje      dup file-size@ >  if      ( off )
5465648Ssetje         drop false  exit       ( failed )
5475648Ssetje      then                      ( off )
5485648Ssetje      dup  file-offset!  true   ( off succeeded )
5495648Ssetje   ;
5505648Ssetje
5515648Ssetje   : size-file  ( fd -- size )
5525648Ssetje      set-fd if
5535648Ssetje         0
5545648Ssetje      else
5555648Ssetje         file-size@
5565648Ssetje      then
5575648Ssetje   ;
5585648Ssetje
5595648Ssetje   \ we don't support compression (yet)
5605648Ssetje   : cinfo-file  ( fd -- bsize fsize comp? )
5615648Ssetje      set-fd  if  0 0 0  else  /block file-size@ 0  then
5625648Ssetje   ;
5635648Ssetje
5645648Ssetje   \ read ramdisk fcode at rd-offset
5655648Ssetje   : get-rd   ( adr len -- )
5665648Ssetje      rd-offset dev-ih  read-disk
5675648Ssetje   ;
5685648Ssetje
5695648Ssetje   \ no additional props needed for hsfs
5705648Ssetje   : bootprop  ( -- )  false  ;
5715648Ssetje
5725648Ssetje   \ debug words
5735648Ssetje   : chdir  ( path$ -- )
5745648Ssetje      2dup lookup if
5755648Ssetje         type ."  Not found" cr
5765648Ssetje      else
5775648Ssetje         dir-isdir? 0= if
5785648Ssetje            type ."  Not a directory" cr
5795648Ssetje         else
5805648Ssetje            type
5815648Ssetje	    ."  blk0 "
5825648Ssetje            cdir-blk0 @ .x
5835648Ssetje            ."  size "
5845648Ssetje            cdir-size @ .x
5855648Ssetje            cr
5865648Ssetje         then
5875648Ssetje      then
5885648Ssetje   ;
5895648Ssetje
5905648Ssetje   : dir  ( -- )
5915648Ssetje      init-dent
5925648Ssetje      begin  get-dent 0=  while
5935648Ssetje         rr-file$ type
5945648Ssetje         ."  flags " dir-flags .x
5955648Ssetje         ." blk0 " dir-block0 .x
5965648Ssetje         ." size " dir-filesize .x
5975648Ssetje         cr
5985648Ssetje      repeat
5995648Ssetje      true to cdir-rescan
6005648Ssetje   ;
6015648Ssetje
6025648Ssetje
6035648Ssetjefinish-device
6045648Ssetjepop-package
6055648Ssetje
606