[openfirmware] r1034 - ofw/fs/ufs
svn at openfirmware.info
svn at openfirmware.info
Tue Dec 16 20:43:20 CET 2008
Author: wmb
Date: 2008-12-16 20:43:19 +0100 (Tue, 16 Dec 2008)
New Revision: 1034
Added:
ofw/fs/ufs/ufs.fth
Log:
Added ufs.fth
Added: ofw/fs/ufs/ufs.fth
===================================================================
--- ofw/fs/ufs/ufs.fth (rev 0)
+++ ofw/fs/ufs/ufs.fth 2008-12-16 19:43:19 UTC (rev 1034)
@@ -0,0 +1,431 @@
+purpose: UFS file system support package
+\ See license at end of file
+
+0 0 " support" property
+
+decimal
+
+\
+\ UFS low-level block routines
+\
+
+512 constant ublock
+2048 constant /super-block
+8 constant ndaddr
+16 constant super-block# ( -- n )
+h# 11954 constant fs-magic
+
+0 instance value temp-block
+0 instance value dir-block
+0 instance value indirect-block
+0 instance value inode
+0 instance value dir-inode
+0 instance value super-block
+0 instance value linkpath
+
+defer short@ ( adr -- w ) ' be-w@ to short@
+defer int@ ( adr -- l ) ' be-l@ to int@
+: le-quad@ ( adr -- l ) int@ ;
+: be-quad@ ( adr -- l ) la1+ int@ ;
+defer quad@ ( adr -- l ) ' be-quad@ to quad@
+
+\ Unfortunately, 4.4BSD-derived systems use a char field for the
+\ name length in the directory entry structure, while most other
+\ systems use a short.
+: 1+c@ ( adr -- n ) 1+ c@ ;
+defer namlen@ ( adr -- n ) ' short@ to namlen@
+
+: +sb ( index -- value ) super-block swap la+ int@ ;
+: iblkno ( -- n ) 4 +sb ;
+: cgoffset ( -- n ) 6 +sb ;
+: cgmask ( -- n ) 7 +sb ;
+: bsize ( -- n ) 12 +sb ;
+: fragshift ( -- n ) 24 +sb ;
+: fsbtodbc ( -- n ) 25 +sb ;
+: inopb ( -- n ) 30 +sb ;
+: ipg ( -- n ) 46 +sb ;
+: fpg ( -- n ) 47 +sb ;
+: inodefmt ( -- n ) 331 +sb ; \ Reserved (=0) in SunOS, =2 in BSD
+: magic ( -- n ) 343 +sb ;
+
+: /frag ( -- fragsize ) bsize fragshift >> ;
+
+: read-ublocks ( adr len dev-block# -- error? )
+ ublock * 0 " seek" $call-parent ?dup if exit then
+ ( adr len ) tuck " read" $call-parent <>
+;
+
+: get-super-block ( -- error? )
+ super-block /super-block super-block# read-ublocks ?dup if exit then
+
+ ['] le-l@ to int@ ['] le-w@ to short@ ['] le-quad@ to quad@
+ magic fs-magic = if false exit then
+
+ ['] be-l@ to int@ ['] be-w@ to short@ ['] be-quad@ to quad@
+ magic fs-magic <>
+;
+
+: cgstart ( cg -- block# )
+ dup cgmask not and cgoffset * swap fpg * +
+;
+: cgimin ( cg -- block# ) cgstart iblkno + ;
+
+: blkstofrags ( #blocks -- #frags ) fragshift << ;
+
+: fsbtodb ( fs-blk# -- dev-blk# ) fsbtodbc << ;
+
+: read-fs-blocks ( adr len fs-blk# -- error? ) fsbtodb read-ublocks ;
+
+\
+\ UFS inode routines
+\
+
+h# 80 constant /inode
+
+instance variable blkptr
+instance variable blklim
+instance variable indirptr
+0 instance value lblk#
+
+: itoo ( i# -- offset ) inopb mod ;
+: itog ( i# -- group ) ipg / ;
+: itod ( i# -- block# )
+ dup itog cgimin swap ipg mod inopb / blkstofrags +
+;
+
+: +i ( n -- ) inode + ;
+: file-attr ( -- attributes ) 0 +i short@ ;
+: dir? ( -- flag ) file-attr h# 4000 and 0<> ; \ ****
+: file-sec ( -- seconds ) 24 +i int@ ;
+: file-size ( -- n ) 8 +i quad@ ; \ ****
+: direct0 ( -- adr ) 40 +i ;
+: indirect0 ( -- adr ) 88 +i ;
+: #blks-held ( -- n ) 104 +i int@ ;
+
+: symlink? ( -- symlink? ) 0 +i short@ o# 0120000 tuck and = ;
+
+\ **** Select the indicated file for subsequent accesses
+: rewind ( -- )
+ direct0 blkptr ! indirect0 blklim ! indirect0 indirptr !
+ 0 to lblk#
+;
+
+: l at ++ ( ptr -- value ) dup @ int@ /l rot +! ;
+
+\ **** Locate the next block within the current file
+: next-block# ( -- n )
+ blkptr @ blklim @ = if
+ indirect-block bsize indirptr l at ++
+ read-fs-blocks drop ( XXX - what about the error? )
+ indirect-block blkptr ! indirect-block bsize + blklim !
+ then
+ lblk# 1+ to lblk#
+ blkptr l at ++ ( blk# )
+;
+
+: get-dirblk ( -- error? ) dir-block bsize next-block# read-fs-blocks ;
+
+\
+\ UFS directory routines
+\
+
+variable diroff
+variable totoff
+variable current-dir
+
+\ **** Return the address of the current directory entry
+: dirent ( -- adr ) dir-block diroff @ + ;
+
+\ **** Select the next directory entry
+: next-dirent ( -- end? )
+ dirent la1+ short@ dup diroff +! totoff +!
+ totoff @ file-size >= if true exit then
+ diroff @ bsize = if
+ get-dirblk ?dup if exit then
+ diroff off
+ then
+ false
+;
+
+\ **** From directory, get handle of the file or subdir that it references
+\ For Unix, file handle is the inode #
+: file-handle ( -- i# ) dirent int@ ;
+
+\ **** From directory, get name of file
+: file-name ( -- adr len )
+ dirent la1+ wa1+ dup wa1+ ( len-adr name-adr )
+ swap namlen@ h# ff and ( adr len )
+;
+
+\
+\ UFS high-level routines
+\
+\ After this point, the code should be independent of the disk format!
+
+: lookup ( adr len -- not-found? )
+ begin
+ 2dup file-name $= if 2drop false exit then
+ next-dirent
+ until
+ 2drop true
+;
+
+: >OFW-path ( adr len -- )
+ \ replace / with \
+ bounds do i c@ ascii / = if ascii \ i c! then loop
+;
+: (select-file) ( i# -- error? )
+ dup temp-block bsize rot itod ( i# adr len fs-block# )
+ read-fs-blocks if drop true exit then ( i# )
+ itoo /inode * temp-block + inode /inode move
+ false
+;
+defer chdir ' noop is chdir
+defer (init-dir) ' noop is (init-dir)
+: select-file ( i# -- error? )
+ (select-file) ?dup if exit then
+ symlink? if
+ #blks-held 0= if \ short symbolic link path
+ direct0 linkpath over cstrlen 1+ move
+ else \ long symbolic link path
+ linkpath bsize direct0 @
+ read-fs-blocks ?dup if exit then
+ then
+ linkpath dup cstrlen 2dup >OFW-path ascii \ split-after
+ ?dup if
+ chdir if 2drop true exit then
+ else
+ drop current-dir @ (init-dir) ?dup if exit then
+ then
+ dup 0= if 2drop false exit then
+ lookup ?dup if exit then
+ file-handle recurse
+ else
+ rewind false
+ then
+;
+
+\ **** Select the directory file
+: init-dir ( i# -- error? )
+ dup current-dir !
+ select-file ?dup if exit then
+ get-dirblk ?dup if exit then
+ 0 diroff ! 0 totoff !
+ false
+;
+' init-dir to (init-dir)
+
+\ **** Select the root directory
+: froot ( -- error? ) 2 init-dir ;
+
+: $chdir ( adr len -- error? ) \ Fail if path is file, not dir
+ ?dup 0= if drop true exit then
+ froot if 2drop true exit then
+ begin ( path-$ )
+ over c@ ascii \ = if 1 /string then
+ ascii \ split-before ( \tail-$ head-$ )
+ dup while
+ lookup if 2drop true exit then
+ dir? 0= if 2drop true exit then
+ file-handle init-dir if 2drop true exit then
+ repeat ( tail-$ head-$ )
+ 2drop 2drop false
+;
+' $chdir to chdir
+
+\
+\ UFS installation routines
+\
+
+
+\ **** Allocate memory for necessary data structures
+: allocate-ufs-buffers ( -- error? )
+ /super-block alloc-mem is super-block
+ get-super-block dup if
+ super-block /super-block free-mem exit
+ then
+ inodefmt 2 = if ['] 1+c@ else ['] short@ then to namlen@
+ bsize alloc-mem is temp-block
+ bsize alloc-mem is dir-block
+ bsize alloc-mem is indirect-block
+ bsize alloc-mem is linkpath
+ /inode alloc-mem is inode
+ /inode alloc-mem is dir-inode
+;
+
+: release ( -- )
+ inode /inode free-mem
+ dir-inode /inode free-mem
+ indirect-block bsize free-mem
+ temp-block bsize free-mem
+ dir-block bsize free-mem
+ linkpath bsize free-mem
+ super-block /super-block free-mem
+;
+
+false instance value file-open?
+/fd instance buffer: ufs-fd
+
+\ UFS DIR routines
+\ date&time is number of seconds since 1970
+create days/month
+\ Jan Feb Mar Apr May Jun Jul Aug Sep Oct Nov Dec
+ 31 c, 28 c, 31 c, 30 c, 31 c, 30 c, 31 c, 31 c, 30 c, 31 c, 30 c, 31 c,
+
+: >d/m ( day-in-year -- day month )
+ 12 0 do
+ days/month i ca+ c@ 2dup < if
+ drop 1+ i 1+ leave
+ then
+ -
+ loop
+;
+: sec>time&date ( seconds -- s m h d m y )
+ 60 u/mod 60 u/mod 24 u/mod ( s m h days )
+ [ 365 4 * 1+ ] literal /mod >r ( s m h day-in-cycle ) ( r: cycles )
+ dup [ 365 365 + 31 + 29 + ] literal
+ 2dup = if \ exactly leap year Feb 29
+ 3drop 2 29 2 ( s m h year-in-cycle d m )
+ else
+ > if 1- then \ after leap year
+ 365 u/mod ( s m h day-in-year year-in-cycle )
+ swap >d/m ( s m h year-in-cycle d m )
+ then
+ rot r> 4 * + 1970 + ( s m h d m y )
+;
+: >dir-inode ( -- ) inode dir-inode /inode move ;
+: dir-inode> ( -- ) dir-inode inode /inode move ;
+: file-info ( id -- false | id' s m h d m y len attributes name$ true )
+ file-handle >dir-inode (select-file) if ( id )
+ drop false ( false )
+ else ( id )
+ 1+ file-sec sec>time&date file-size file-attr file-name ( id' .. )
+ true ( id' .. name$ true )
+ then
+ dir-inode>
+;
+: next-file-info ( id -- false | id' s m h d m y len attributes name$ true )
+ dup if
+ next-dirent if drop false else file-info then
+ else
+ file-info
+ then
+;
+
+\ UFS file interface
+
+: ufsdflen ( 'fhandle -- d.size ) drop file-size 0 ;
+
+: ufsdfalign ( d.byte# 'fh -- d.aligned )
+ drop swap bsize 1- invert and swap
+;
+
+: ufsfclose ( 'fh -- )
+ drop bfbase @ bsize free-mem \ Registered with initbuf
+;
+
+: ufsdfseek ( d.byte# 'fh -- )
+ drop
+ bsize um/mod nip ( target-blk# )
+ dup lblk# < if rewind then
+ begin dup lblk# <> while next-block# drop repeat
+ drop
+;
+
+: ufsfread ( addr count 'fh -- #read )
+ drop
+ file-size lblk# bsize * - ( addr count rem )
+ over min -rot ( actual addr count )
+ next-block# read-fs-blocks
+ abort" ufsfread failed"
+;
+
+: $ufsopen ( adr len mode -- fid fmode size align close seek write read )
+ >r lookup ( error? ) if
+ false
+ else
+ file-handle select-file if
+ false
+ else
+ bsize alloc-mem bsize initbuf
+ file-handle r@
+ ['] ufsdflen ['] ufsdfalign ['] ufsfclose ['] ufsdfseek ['] nullwrite
+ r@ write = if ['] nullread else ['] ufsfread then
+ true
+ then
+ then
+ r> drop
+;
+
+external
+
+: open ( -- okay? )
+ allocate-ufs-buffers if false exit then
+
+ my-args " <NoFile>" $= if true exit then
+
+ my-args ascii \ split-after ( file$ path$ )
+ $chdir if 2drop release false exit then ( file$ )
+
+ \ Filename ends in "\"; select the directory and exit with success
+ dup 0= if 2drop true exit then ( file$ )
+
+ file @ >r ufs-fd file ! ( file$ )
+
+ 2dup r/w $ufsopen 0= if
+ 2dup r/o $ufsopen 0= if
+ release 2drop false r> file ! exit
+ then
+ then ( file$ file-ops ... )
+
+ setupfd
+ 2drop
+ true to file-open?
+ true
+ r> file !
+;
+
+: close ( -- )
+ file-open? if
+ ufs-fd ['] fclose catch ?dup if .error drop then
+ then
+ release
+;
+: read ( adr len -- actual )
+ ufs-fd ['] fgets catch if 3drop 0 then
+;
+: write ( adr len -- actual )
+ tuck ufs-fd ['] fputs catch if 2drop 2drop -1 then
+;
+: seek ( offset.low offset.high -- error? )
+ ufs-fd ['] dfseek catch if 2drop true else false then
+;
+: size ( -- d ) file-size 0 ;
+: load ( adr -- size ) file-size read ;
+: files ( -- ) begin file-name type cr next-dirent until ;
+
+hex
+
+\ LICENSE_BEGIN
+\ Copyright (c) 1994 FirmWorks
+\
+\ Permission is hereby granted, free of charge, to any person obtaining
+\ a copy of this software and associated documentation files (the
+\ "Software"), to deal in the Software without restriction, including
+\ without limitation the rights to use, copy, modify, merge, publish,
+\ distribute, sublicense, and/or sell copies of the Software, and to
+\ permit persons to whom the Software is furnished to do so, subject to
+\ the following conditions:
+\
+\ The above copyright notice and this permission notice shall be
+\ included in all copies or substantial portions of the Software.
+\
+\ THE SOFTWARE IS PROVIDED "AS IS", WITHOUT WARRANTY OF ANY KIND,
+\ EXPRESS OR IMPLIED, INCLUDING BUT NOT LIMITED TO THE WARRANTIES OF
+\ MERCHANTABILITY, FITNESS FOR A PARTICULAR PURPOSE AND
+\ NONINFRINGEMENT. IN NO EVENT SHALL THE AUTHORS OR COPYRIGHT HOLDERS BE
+\ LIABLE FOR ANY CLAIM, DAMAGES OR OTHER LIABILITY, WHETHER IN AN ACTION
+\ OF CONTRACT, TORT OR OTHERWISE, ARISING FROM, OUT OF OR IN CONNECTION
+\ WITH THE SOFTWARE OR THE USE OR OTHER DEALINGS IN THE SOFTWARE.
+\
+\ LICENSE_END
More information about the openfirmware
mailing list