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