1986fd29aSsetje\ 2986fd29aSsetje\ CDDL HEADER START 3986fd29aSsetje\ 4986fd29aSsetje\ The contents of this file are subject to the terms of the 5986fd29aSsetje\ Common Development and Distribution License (the "License"). 6986fd29aSsetje\ You may not use this file except in compliance with the License. 7986fd29aSsetje\ 8986fd29aSsetje\ You can obtain a copy of the license at usr/src/OPENSOLARIS.LICENSE 9986fd29aSsetje\ or http://www.opensolaris.org/os/licensing. 10986fd29aSsetje\ See the License for the specific language governing permissions 11986fd29aSsetje\ and limitations under the License. 12986fd29aSsetje\ 13986fd29aSsetje\ When distributing Covered Code, include this CDDL HEADER in each 14986fd29aSsetje\ file and include the License file at usr/src/OPENSOLARIS.LICENSE. 15986fd29aSsetje\ If applicable, add the following below this CDDL HEADER, with the 16986fd29aSsetje\ fields enclosed by brackets "[]" replaced with your own identifying 17986fd29aSsetje\ information: Portions Copyright [yyyy] [name of copyright owner] 18986fd29aSsetje\ 19986fd29aSsetje\ CDDL HEADER END 20986fd29aSsetje\ 21986fd29aSsetje\ 22*c713350eSJohn Johnson\ Copyright 2009 Sun Microsystems, Inc. All rights reserved. 23*c713350eSJohn Johnson\ Use is subject to license terms. 24*c713350eSJohn Johnson\ 25986fd29aSsetje 26986fd29aSsetje 27986fd29aSsetjepurpose: UFS file system support package 28*c713350eSJohn Johnsoncopyright: Copyright 2009 Sun Microsystems, Inc. All Rights Reserved 29986fd29aSsetje 30986fd29aSsetjeheaders 31986fd29aSsetje" /packages" get-package push-package 32986fd29aSsetje 33986fd29aSsetjenew-device 34986fd29aSsetje fs-pkg$ device-name diag-cr? 35986fd29aSsetje 36986fd29aSsetje \ 37986fd29aSsetje \ UFS low-level block routines 38986fd29aSsetje \ 39986fd29aSsetje 40986fd29aSsetje h# 2000 constant /max-bsize 41986fd29aSsetje d# 512 constant /disk-block 42986fd29aSsetje 43986fd29aSsetje 0 instance value dev-ih 44986fd29aSsetje 0 instance value temp-block 45986fd29aSsetje 46986fd29aSsetje : blk>byte ( block# -- byte# ) /disk-block * ; 47986fd29aSsetje 48986fd29aSsetje : read-disk-blocks ( adr len dev-block# -- ) 49986fd29aSsetje blk>byte dev-ih read-disk 50986fd29aSsetje ; 51986fd29aSsetje 52986fd29aSsetje 53986fd29aSsetje \ 54986fd29aSsetje \ UFS superblock routines 55986fd29aSsetje \ 56986fd29aSsetje 57986fd29aSsetje d# 512 constant /super-block 58986fd29aSsetje d# 16 constant super-block# 59986fd29aSsetje 0 instance value super-block 60986fd29aSsetje 61986fd29aSsetje : +sb ( index -- value ) super-block swap la+ l@ ; 62986fd29aSsetje : iblkno ( -- n ) d# 04 +sb ; 63986fd29aSsetje : cgoffset ( -- n ) d# 06 +sb ; 64986fd29aSsetje : cgmask ( -- n ) d# 07 +sb ; 65986fd29aSsetje : bsize ( -- n ) d# 12 +sb ; 66986fd29aSsetje : fragshift ( -- n ) d# 24 +sb ; 67986fd29aSsetje : fsbtodbc ( -- n ) d# 25 +sb ; 68986fd29aSsetje : inopb ( -- n ) d# 30 +sb ; 69986fd29aSsetje : ipg ( -- n ) d# 46 +sb ; 70986fd29aSsetje : fpg ( -- n ) d# 47 +sb ; 71986fd29aSsetje 72986fd29aSsetje : /frag ( -- fragsize ) bsize fragshift rshift ; 73986fd29aSsetje 74986fd29aSsetje : get-super-block ( -- ) 75986fd29aSsetje super-block /super-block super-block# read-disk-blocks 76986fd29aSsetje ; 77986fd29aSsetje 78986fd29aSsetje : cgstart ( cg -- block# ) 79986fd29aSsetje dup cgmask invert and cgoffset * swap fpg * + 80986fd29aSsetje ; 81986fd29aSsetje : cgimin ( cg -- block# ) cgstart iblkno + ; 82986fd29aSsetje : blkstofrags ( #blocks -- #frags ) fragshift lshift ; 83986fd29aSsetje : lblkno ( byte-off -- lblk# ) bsize / ; 84986fd29aSsetje : blkoff ( byte-off -- blk-off ) bsize mod ; 85986fd29aSsetje : fsbtodb ( fs-blk# -- dev-blk# ) fsbtodbc lshift ; 86986fd29aSsetje 87986fd29aSsetje : read-fs-blocks ( adr len fs-blk# -- ) fsbtodb read-disk-blocks ; 88986fd29aSsetje 89986fd29aSsetje 90986fd29aSsetje \ 91986fd29aSsetje \ UFS inode routines 92986fd29aSsetje \ 93986fd29aSsetje 94986fd29aSsetje h# 80 constant /inode 95986fd29aSsetje 0 instance value inode 96986fd29aSsetje 0 instance value iptr 97986fd29aSsetje 98986fd29aSsetje : itoo ( i# -- offset ) inopb mod ; 99986fd29aSsetje : itog ( i# -- group ) ipg / ; 100986fd29aSsetje : itod ( i# -- block# ) 101986fd29aSsetje dup itog cgimin swap ipg mod inopb / blkstofrags + 102986fd29aSsetje ; 103986fd29aSsetje 104986fd29aSsetje : +i ( n -- adr ) iptr + ; 105986fd29aSsetje 106986fd29aSsetje : ftype ( -- n ) 0 +i w@ h# f000 and ; 107986fd29aSsetje : dir? ( -- flag ) ftype h# 4000 = ; 108986fd29aSsetje : symlink? ( -- flag ) ftype h# a000 = ; 109986fd29aSsetje : regular? ( -- flag ) ftype h# 8000 = ; 110986fd29aSsetje 111986fd29aSsetje : file-size ( -- n ) 8 +i x@ ; 112986fd29aSsetje : direct0 ( -- adr ) d# 40 +i ; 113986fd29aSsetje : indirect0 ( -- adr ) d# 88 +i ; 114986fd29aSsetje : indirect1 ( -- adr ) d# 92 +i ; 115986fd29aSsetje : indirect2 ( -- adr ) d# 96 +i ; 116986fd29aSsetje : comp? ( -- flag ) d# 100 +i l@ 4 and 0<> ; 117986fd29aSsetje 118986fd29aSsetje 0 instance value current-file 119986fd29aSsetje : iget ( i# -- ) 120986fd29aSsetje dup temp-block bsize rot itod ( i# adr len blk# ) 121986fd29aSsetje read-fs-blocks 122986fd29aSsetje dup itoo /inode * temp-block + inode /inode move 123986fd29aSsetje inode to iptr 124986fd29aSsetje to current-file ( ) 125986fd29aSsetje ; 126986fd29aSsetje 127986fd29aSsetje : l@++ ( ptr -- value ) dup @ l@ /l rot +! ; 128986fd29aSsetje 129986fd29aSsetje d# 12 constant #direct 130986fd29aSsetje : #blk-addr/blk bsize /l / ; 131986fd29aSsetje : #sgl-addr #blk-addr/blk ; 132986fd29aSsetje : #dbl-addr #sgl-addr #blk-addr/blk * ; 133986fd29aSsetje\ : #tri-addr #dbl-addr #blk-addr/blk * ; 134986fd29aSsetje 135986fd29aSsetje : >1-idx ( blk# -- idx ) #blk-addr/blk mod ; 136986fd29aSsetje : >2-idx ( blk# -- idx ) #sgl-addr / >1-idx ; 137986fd29aSsetje\ : >3-idx ( blk# -- idx ) #dbl-addr / >1-idx ; 138986fd29aSsetje 139986fd29aSsetje \ 140986fd29aSsetje \ indirect block cache 141986fd29aSsetje \ we assume reads will mostly be sequential, and only 142986fd29aSsetje \ cache the current indirect block tree 143986fd29aSsetje \ 144986fd29aSsetje : get-indir ( fs-blk# var adr -- adr ) 145986fd29aSsetje -rot dup >r @ over = if ( adr fs-blk# r: var ) 146986fd29aSsetje r> 2drop exit ( adr ) 147986fd29aSsetje then ( adr fs-blk# r: var ) 148986fd29aSsetje 2dup bsize swap read-fs-blocks ( adr fs-blk# r: var ) 149986fd29aSsetje r> ! ( adr ) 150986fd29aSsetje ; 151986fd29aSsetje 152986fd29aSsetje 0 instance value indir0-adr 153986fd29aSsetje instance variable cur-indir0 154986fd29aSsetje : get-indir0 ( fs-blk# -- adr ) 155986fd29aSsetje cur-indir0 indir0-adr get-indir 156986fd29aSsetje ; 157986fd29aSsetje 158986fd29aSsetje 0 instance value indir1-adr 159986fd29aSsetje instance variable cur-indir1 160986fd29aSsetje : get-indir1 ( fs-blk# -- adr ) 161986fd29aSsetje cur-indir1 indir1-adr get-indir 162986fd29aSsetje ; 163986fd29aSsetje 164986fd29aSsetje \ 165986fd29aSsetje \ blkptr and blklim point to an array of blk#s, 166986fd29aSsetje \ whether in the inode direct block array or in 167986fd29aSsetje \ an indirect block 168986fd29aSsetje \ 169986fd29aSsetje instance variable blkptr 170986fd29aSsetje instance variable blklim 171986fd29aSsetje 172986fd29aSsetje : (bmap) ( lblk# -- ) 173986fd29aSsetje dup #direct < if ( lblk# ) 174986fd29aSsetje direct0 swap la+ blkptr ! ( ) 175986fd29aSsetje direct0 #direct la+ blklim ! 176986fd29aSsetje exit 177986fd29aSsetje then ( lblk# ) 178986fd29aSsetje 179986fd29aSsetje #direct - ( lblk#' ) 180986fd29aSsetje dup #sgl-addr < if 181986fd29aSsetje indirect0 l@ get-indir0 ( lblk# adr ) 182986fd29aSsetje tuck swap >1-idx la+ blkptr ! ( adr ) 183986fd29aSsetje #blk-addr/blk la+ blklim ! 184986fd29aSsetje exit 185986fd29aSsetje then ( lblk# ) 186986fd29aSsetje 187986fd29aSsetje #sgl-addr - ( lblk#' ) 188986fd29aSsetje dup #dbl-addr < if 189986fd29aSsetje indirect1 l@ get-indir0 ( lblk# adr ) 190986fd29aSsetje over >2-idx la+ l@ get-indir1 ( lblk# adr' ) 191986fd29aSsetje tuck swap >1-idx la+ blkptr ! ( adr ) 192986fd29aSsetje #blk-addr/blk la+ blklim ! ( ) 193986fd29aSsetje exit 194986fd29aSsetje then ( lblk# ) 195986fd29aSsetje 196986fd29aSsetje\ #dbl-addr - ( lblk#' ) 197986fd29aSsetje\ dup #tri-addr < if 198986fd29aSsetje\ indirect2 l@ get-indir0 ( lblk# adr ) 199986fd29aSsetje\ over >3-idx la+ l@ get-indir1 ( lblk# adr' ) 200986fd29aSsetje\ over >2-idx la+ l@ get-indir2 ( lblk# adr' ) 201986fd29aSsetje\ tuck swap >1-idx la+ blkptr ! ( adr ) 202986fd29aSsetje\ #blk-addr/blk la+ blklim ! ( ) 203986fd29aSsetje\ exit 204986fd29aSsetje\ then ( lblk# ) 205986fd29aSsetje ." file too large" cr drop true ( failed ) 206986fd29aSsetje ; 207986fd29aSsetje 208986fd29aSsetje 0 instance value cur-blk 209986fd29aSsetje : bmap ( lblk# -- fs-blk# ) 210986fd29aSsetje dup cur-blk <> blkptr @ blklim @ = or if ( lblk# ) 211986fd29aSsetje dup (bmap) ( lblk# ) 212986fd29aSsetje then ( lblk# ) 213986fd29aSsetje 1+ to cur-blk ( ) 214986fd29aSsetje blkptr l@++ ( fs-blk# ) 215986fd29aSsetje ; 216986fd29aSsetje 217986fd29aSsetje : read-one-block ( adr block# -- ) 218986fd29aSsetje bmap ?dup if 219986fd29aSsetje bsize swap read-fs-blocks 220986fd29aSsetje else 221986fd29aSsetje bsize erase 222986fd29aSsetje then 223986fd29aSsetje ; 224986fd29aSsetje 225986fd29aSsetje : read-partial-block ( adr len off block# -- ) 226986fd29aSsetje bmap ?dup if 227986fd29aSsetje fsbtodb blk>byte + ( adr len byte# ) 228986fd29aSsetje dev-ih read-disk 229986fd29aSsetje else 230986fd29aSsetje drop erase 231986fd29aSsetje then 232986fd29aSsetje ; 233986fd29aSsetje 234986fd29aSsetje \ 235986fd29aSsetje \ UFS directory routines 236986fd29aSsetje \ 237986fd29aSsetje 238986fd29aSsetje instance variable dir-blk 239986fd29aSsetje instance variable totoff 240986fd29aSsetje instance variable dirptr 241986fd29aSsetje 0 instance value dir-buf 242986fd29aSsetje 243986fd29aSsetje : get-dirblk ( -- ) 244986fd29aSsetje dir-buf bsize dir-blk @ bmap ( adr len fs-blk# ) 245986fd29aSsetje read-fs-blocks ( ) 246986fd29aSsetje 1 dir-blk +! 247986fd29aSsetje ; 248986fd29aSsetje 249986fd29aSsetje 2 constant rootino 250986fd29aSsetje 251986fd29aSsetje : +d ( n -- adr ) dirptr @ + ; 252986fd29aSsetje 253986fd29aSsetje : dir-ino ( -- adr ) 0 +d l@ ; 254986fd29aSsetje : reclen ( -- adr ) 4 +d w@ ; 255986fd29aSsetje : namelen ( -- adr ) 6 +d w@ ; 256986fd29aSsetje : dir-name ( -- adr ) 8 +d ; 257986fd29aSsetje : dir-name$ ( -- file$ ) dir-name namelen ; 258986fd29aSsetje 259986fd29aSsetje 260986fd29aSsetje \ 261986fd29aSsetje \ UFS high-level routines 262986fd29aSsetje \ 263986fd29aSsetje \ After this point, the code should be independent of the disk format! 264986fd29aSsetje 265986fd29aSsetje 0 instance value search-dir 266986fd29aSsetje : init-dent 267986fd29aSsetje 0 totoff ! 0 dir-blk ! 268986fd29aSsetje current-file to search-dir 269986fd29aSsetje ; 270986fd29aSsetje 271986fd29aSsetje : get-dent ( -- end-of-dir? ) 272986fd29aSsetje begin 273986fd29aSsetje totoff @ file-size >= if 274986fd29aSsetje true exit 275986fd29aSsetje then 276986fd29aSsetje totoff @ blkoff 0= if 277986fd29aSsetje get-dirblk 278986fd29aSsetje dir-buf dirptr ! 279986fd29aSsetje else 280986fd29aSsetje reclen dirptr +! 281986fd29aSsetje then 282986fd29aSsetje reclen totoff +! 283986fd29aSsetje dir-ino 0<> 284986fd29aSsetje until false 285986fd29aSsetje ; 286986fd29aSsetje 287986fd29aSsetje : dirlook ( file$ -- not-found? ) 288986fd29aSsetje init-dent 289986fd29aSsetje begin get-dent 0= while ( file$ ) 290986fd29aSsetje 2dup dir-name$ $= if ( file$ ) 291986fd29aSsetje dir-ino iget ( file$ ) 292986fd29aSsetje 2drop false exit ( found ) 293986fd29aSsetje then ( file$ ) 294986fd29aSsetje repeat 2drop true ( not-found ) 295986fd29aSsetje ; 296986fd29aSsetje 297986fd29aSsetje h# 200 constant /fpath-buf 298986fd29aSsetje /fpath-buf instance buffer: fpath-buf 299986fd29aSsetje : clr-fpath-buf ( -- ) fpath-buf /fpath-buf erase ; 300986fd29aSsetje : fpath-buf$ ( -- path$ ) fpath-buf cscount ; 301986fd29aSsetje 302986fd29aSsetje : follow-symlink ( tail$ -- tail$' ) 303986fd29aSsetje clr-fpath-buf ( tail$ ) 304986fd29aSsetje fpath-buf file-size 0 0 read-partial-block ( tail$ ) 305986fd29aSsetje ?dup if ( tail$ ) 306986fd29aSsetje " /" fpath-buf$ $append ( tail$ ) 307986fd29aSsetje fpath-buf$ $append ( ) 308986fd29aSsetje else drop then ( ) 309986fd29aSsetje fpath-buf$ ( path$ ) 310986fd29aSsetje over c@ ascii / = if ( path$ ) 311986fd29aSsetje str++ rootino ( path$' i# ) 312986fd29aSsetje else ( path$ ) 313986fd29aSsetje search-dir ( path$ i# ) 314986fd29aSsetje then ( path$ i# ) 315986fd29aSsetje iget ( path$ ) 316986fd29aSsetje ; 317986fd29aSsetje 318986fd29aSsetje : lookup ( path$ -- not-found? ) 319986fd29aSsetje over c@ ascii / = if 320986fd29aSsetje str++ rootino ( path$' i# ) 321986fd29aSsetje else 322986fd29aSsetje current-file ( path$ i# ) 323986fd29aSsetje then ( path$ i# ) 324986fd29aSsetje iget ( path$ ) 325986fd29aSsetje begin ( path$ ) 326986fd29aSsetje ascii / left-parse-string ( path$ file$ ) 327986fd29aSsetje dup while 328986fd29aSsetje dir? 0= if 2drop true exit then 329986fd29aSsetje dirlook if 2drop true exit then ( path$ ) 330986fd29aSsetje symlink? if 331986fd29aSsetje follow-symlink ( path$' ) 332986fd29aSsetje then ( path$ ) 333986fd29aSsetje repeat ( path$ file$ ) 334986fd29aSsetje 2drop 2drop false ( succeeded ) 335986fd29aSsetje ; 336986fd29aSsetje 337986fd29aSsetje : i#>name ( i# -- name$ ) 338986fd29aSsetje init-dent ( i# ) 339986fd29aSsetje begin get-dent 0= while ( i# ) 340986fd29aSsetje dup dir-ino = if ( i# ) 341986fd29aSsetje drop dir-name$ exit ( name$ ) 342986fd29aSsetje then ( i# ) 343986fd29aSsetje repeat drop " ???" ( name$ ) 344986fd29aSsetje ; 345986fd29aSsetje 346986fd29aSsetje 347986fd29aSsetje \ 348986fd29aSsetje \ UFS installation routines 349986fd29aSsetje \ 350986fd29aSsetje 351986fd29aSsetje /max-bsize 4 * 352986fd29aSsetje /super-block + 353986fd29aSsetje /inode + 354986fd29aSsetje constant alloc-size 355986fd29aSsetje 356986fd29aSsetje \ **** Allocate memory for necessary data structures 357986fd29aSsetje : allocate-buffers ( -- ) 358986fd29aSsetje alloc-size mem-alloc dup 0= if 359986fd29aSsetje ." no memory" abort 360986fd29aSsetje then ( adr ) 361986fd29aSsetje dup to temp-block /max-bsize + ( adr ) 362986fd29aSsetje dup to dir-buf /max-bsize + ( adr ) 363986fd29aSsetje dup to indir0-adr /max-bsize + ( adr ) 364986fd29aSsetje dup to indir1-adr /max-bsize + ( adr ) 365986fd29aSsetje dup to super-block /super-block + ( adr ) 366986fd29aSsetje to inode ( ) 367986fd29aSsetje ; 368986fd29aSsetje 369986fd29aSsetje : release-buffers ( -- ) 370986fd29aSsetje temp-block alloc-size mem-free 371986fd29aSsetje ; 372986fd29aSsetje 373986fd29aSsetje \ UFS file interface 374986fd29aSsetje 375986fd29aSsetje struct 376986fd29aSsetje /x field >busy 377986fd29aSsetje /x field >offset 378986fd29aSsetje /inode field >inode 379986fd29aSsetje constant /file-record 380986fd29aSsetje 381986fd29aSsetje d# 10 constant #opens 382986fd29aSsetje #opens /file-record * constant /file-records 383986fd29aSsetje 384986fd29aSsetje /file-records instance buffer: file-records 385986fd29aSsetje 386986fd29aSsetje -1 instance value current-fd 387986fd29aSsetje : fd>record ( fd -- record ) /file-record * file-records + ; 388986fd29aSsetje 389986fd29aSsetje 390986fd29aSsetje : file-offset@ ( -- off ) 391986fd29aSsetje current-fd fd>record >offset x@ 392986fd29aSsetje ; 393986fd29aSsetje 394986fd29aSsetje : file-offset! ( off -- ) 395986fd29aSsetje current-fd fd>record >offset x! 396986fd29aSsetje ; 397986fd29aSsetje 398986fd29aSsetje : get-slot ( -- fd false | true ) 399986fd29aSsetje #opens 0 do 400986fd29aSsetje i fd>record >busy x@ 0= if 401986fd29aSsetje i false unloop exit 402986fd29aSsetje then 403986fd29aSsetje loop true 404986fd29aSsetje ; 405986fd29aSsetje 406986fd29aSsetje : free-slot ( fd -- ) 407986fd29aSsetje 0 swap fd>record >busy x! 408986fd29aSsetje ; 409986fd29aSsetje 410986fd29aSsetje : init-fd ( fd -- ) 411986fd29aSsetje fd>record ( rec ) 412986fd29aSsetje dup >busy 1 swap x! 413986fd29aSsetje dup >inode inode swap /inode move 414986fd29aSsetje >offset 0 swap x! 415986fd29aSsetje ; 416986fd29aSsetje 417986fd29aSsetje : set-fd ( fd -- error? ) 418986fd29aSsetje dup fd>record dup >busy x@ 0= if ( fd rec ) 419986fd29aSsetje 2drop true exit ( failed ) 420986fd29aSsetje then 421986fd29aSsetje >inode to iptr ( fd ) 422986fd29aSsetje to current-fd false ( succeeded ) 423986fd29aSsetje ; 424986fd29aSsetje 425986fd29aSsetje 426986fd29aSsetje \ get current lblk# and offset within it 427986fd29aSsetje : file-blk+off ( -- off block# ) 428986fd29aSsetje file-offset@ dup blkoff swap lblkno 429986fd29aSsetje ; 430986fd29aSsetje 431986fd29aSsetje \ advance file io stack by n 432986fd29aSsetje : fio+ ( # adr len n -- #+n adr+n len-n ) 433986fd29aSsetje dup file-offset@ + file-offset! 434986fd29aSsetje dup >r - -rot ( len' # adr r: n ) 435986fd29aSsetje r@ + -rot ( adr' len' # r: n ) 436986fd29aSsetje r> + -rot ( #' adr' len' ) 437986fd29aSsetje ; 438986fd29aSsetje 439986fd29aSsetje : (cwd) ( i# -- ) tokenizer[ reveal ]tokenizer 440986fd29aSsetje dup rootino <> if 441986fd29aSsetje \ open parent, find current name 442986fd29aSsetje " .." lookup drop 443986fd29aSsetje i#>name ( name$ ) 444986fd29aSsetje \ recurse to print path components above 445986fd29aSsetje current-file (cwd) ( name$ ) 446986fd29aSsetje \ and print this component 447986fd29aSsetje type ( ) 448986fd29aSsetje else drop then ( ) 449986fd29aSsetje \ slash is both root name and separator 450986fd29aSsetje ." /" 451986fd29aSsetje ; 452986fd29aSsetje 453986fd29aSsetje external 454986fd29aSsetje 455986fd29aSsetje : open ( -- okay? ) 456986fd29aSsetje my-args dev-open dup 0= if ( 0 ) 457986fd29aSsetje exit ( failed ) 458986fd29aSsetje then to dev-ih 459986fd29aSsetje 460986fd29aSsetje allocate-buffers 461986fd29aSsetje get-super-block 462986fd29aSsetje file-records /file-records erase 463986fd29aSsetje true ( succeeded ) 464986fd29aSsetje ; 465986fd29aSsetje 466986fd29aSsetje : close ( -- ) 467986fd29aSsetje dev-ih dev-close 468986fd29aSsetje 0 to dev-ih 469986fd29aSsetje release-buffers 470986fd29aSsetje ; 471986fd29aSsetje 472986fd29aSsetje : open-file ( path$ -- fd true | false ) 473986fd29aSsetje get-slot if 474986fd29aSsetje 2drop false exit ( failed ) 475986fd29aSsetje then -rot ( fd path$ ) 476986fd29aSsetje 477986fd29aSsetje lookup if ( fd ) 478986fd29aSsetje drop false exit ( failed ) 479986fd29aSsetje then 480986fd29aSsetje 481986fd29aSsetje dup init-fd true ( fd succeeded ) 482986fd29aSsetje ; 483986fd29aSsetje 484986fd29aSsetje : close-file ( fd -- ) 485986fd29aSsetje free-slot ( ) 486986fd29aSsetje ; 487986fd29aSsetje 488986fd29aSsetje : size-file ( fd -- size ) 489986fd29aSsetje set-fd if 0 else file-size then 490986fd29aSsetje ; 491986fd29aSsetje 492986fd29aSsetje : seek-file ( off fd -- off true | false ) 493986fd29aSsetje set-fd if ( off ) 494986fd29aSsetje drop false exit ( failed ) 495986fd29aSsetje then ( off ) 496986fd29aSsetje 497986fd29aSsetje dup file-size > if ( off ) 498986fd29aSsetje drop false exit ( failed ) 499986fd29aSsetje then ( off ) 500986fd29aSsetje dup file-offset! true ( off succeeded ) 501986fd29aSsetje ; 502986fd29aSsetje 503986fd29aSsetje : read-file ( adr len fd -- #read ) 504986fd29aSsetje set-fd if ( adr len ) 505986fd29aSsetje 2drop 0 exit ( 0 ) 506986fd29aSsetje then ( adr len ) 507986fd29aSsetje 508986fd29aSsetje regular? 0= if 2drop 0 exit then 509986fd29aSsetje 510986fd29aSsetje \ adjust len if reading past eof 511986fd29aSsetje dup file-offset@ + file-size > if 512986fd29aSsetje dup file-offset@ + file-size - - 513986fd29aSsetje then 514986fd29aSsetje dup 0= if nip exit then 515986fd29aSsetje 516986fd29aSsetje 0 -rot ( #read adr len ) 517986fd29aSsetje 518986fd29aSsetje \ initial partial block 519986fd29aSsetje file-offset@ blkoff ?dup if ( #read adr len off ) 520986fd29aSsetje bsize swap - over min ( #read adr len len' ) 521986fd29aSsetje 3dup nip file-blk+off ( #read adr len len' adr len' off lblk# ) 522986fd29aSsetje read-partial-block ( #read adr len len ) 523986fd29aSsetje fio+ ( #read' adr' len' ) 524986fd29aSsetje then ( #read adr len ) 525986fd29aSsetje 526986fd29aSsetje dup lblkno 0 ?do ( #read adr len ) 527986fd29aSsetje over file-blk+off nip ( #read adr len adr lblk# ) 528986fd29aSsetje read-one-block ( #read adr len ) 529986fd29aSsetje bsize fio+ ( #read' adr' len' ) 530986fd29aSsetje loop ( #read adr len ) 531986fd29aSsetje 532986fd29aSsetje \ final partial block 533986fd29aSsetje dup if ( #read adr len ) 534986fd29aSsetje 2dup file-blk+off ( #read adr len adr len off lblk# ) 535986fd29aSsetje read-partial-block ( #read adr len ) 536986fd29aSsetje dup fio+ ( #read' adr' 0 ) 537986fd29aSsetje then 2drop ( #read ) 538986fd29aSsetje ; 539986fd29aSsetje 540986fd29aSsetje : cinfo-file ( fd -- bsize fsize comp? ) 541986fd29aSsetje set-fd if 0 0 0 else bsize file-size comp? then 542986fd29aSsetje ; 543986fd29aSsetje 544986fd29aSsetje \ read ramdisk fcode at rd-offset 545986fd29aSsetje : get-rd ( adr len -- ) 546986fd29aSsetje rd-offset dev-ih read-disk 547986fd29aSsetje ; 548986fd29aSsetje 549986fd29aSsetje \ no additional props needed for ufs 550986fd29aSsetje : bootprop ( -- ) false ; 551986fd29aSsetje 552986fd29aSsetje \ debug words 553986fd29aSsetje headers 554986fd29aSsetje 555986fd29aSsetje : chdir ( dir$ -- ) 556986fd29aSsetje current-file -rot ( i# dir$ ) 557986fd29aSsetje lookup if ( i# ) 558986fd29aSsetje to current-file ( ) 559986fd29aSsetje ." no such dir" cr exit 560986fd29aSsetje then ( i# ) 561986fd29aSsetje dir? 0= if ( i# ) 562986fd29aSsetje to current-file ( ) 563986fd29aSsetje ." not a dir" cr exit 564986fd29aSsetje then drop ( ) 565986fd29aSsetje ; 566986fd29aSsetje 567986fd29aSsetje : dir ( -- ) 568986fd29aSsetje current-file iget 569986fd29aSsetje init-dent 570986fd29aSsetje begin get-dent 0= while 571986fd29aSsetje dir-name$ type cr 572986fd29aSsetje repeat 573986fd29aSsetje ; 574986fd29aSsetje 575986fd29aSsetje : cwd ( -- ) 576986fd29aSsetje current-file ( i# ) 577986fd29aSsetje dup (cwd) cr ( i# ) 578986fd29aSsetje iget ( ) 579986fd29aSsetje ; 580986fd29aSsetje 581986fd29aSsetjefinish-device 582986fd29aSsetjepop-package 583