kmx git

\ ========== Copyright Header Begin ==========================================
\ 
\ Hypervisor Software File: deblock.fth
\ 
\ Copyright (c) 2006 Sun Microsystems, Inc. All Rights Reserved.
\ 
\  - Do no alter or remove copyright notices
\ 
\  - Redistribution and use of this software in source and binary forms, with 
\    or without modification, are permitted provided that the following 
\    conditions are met: 
\ 
\  - Redistribution of source code must retain the above copyright notice, 
\    this list of conditions and the following disclaimer.
\ 
\  - Redistribution in binary form must reproduce the above copyright notice,
\    this list of conditions and the following disclaimer in the
\    documentation and/or other materials provided with the distribution. 
\ 
\    Neither the name of Sun Microsystems, Inc. or the names of contributors 
\ may be used to endorse or promote products derived from this software 
\ without specific prior written permission. 
\ 
\     This software is provided "AS IS," without a warranty of any kind. 
\ ALL EXPRESS OR IMPLIED CONDITIONS, REPRESENTATIONS AND WARRANTIES, 
\ INCLUDING ANY IMPLIED WARRANTY OF MERCHANTABILITY, FITNESS FOR A 
\ PARTICULAR PURPOSE OR NON-INFRINGEMENT, ARE HEREBY EXCLUDED. SUN 
\ MICROSYSTEMS, INC. ("SUN") AND ITS LICENSORS SHALL NOT BE LIABLE FOR 
\ ANY DAMAGES SUFFERED BY LICENSEE AS A RESULT OF USING, MODIFYING OR 
\ DISTRIBUTING THIS SOFTWARE OR ITS DERIVATIVES. IN NO EVENT WILL SUN 
\ OR ITS LICENSORS BE LIABLE FOR ANY LOST REVENUE, PROFIT OR DATA, OR 
\ FOR DIRECT, INDIRECT, SPECIAL, CONSEQUENTIAL, INCIDENTAL OR PUNITIVE 
\ DAMAGES, HOWEVER CAUSED AND REGARDLESS OF THE THEORY OF LIABILITY, 
\ ARISING OUT OF THE USE OF OR INABILITY TO USE THIS SOFTWARE, EVEN IF 
\ SUN HAS BEEN ADVISED OF THE POSSIBILITY OF SUCH DAMAGES.
\ 
\ You acknowledge that this software is not designed, licensed or
\ intended for use in the design, construction, operation or maintenance of
\ any nuclear facility. 
\ 
\ ========== Copyright Header End ============================================
id: @(#)deblock.fth 2.20 97/02/04
purpose:
copyright: Copyright 1990-1994 Sun Microsystems, Inc.  All Rights Reserved

\ Block-to-byte conversion package using the Forth file system code to
\ do the deblocking.  Creates a file type which accesses the underlying
\ block device and opens a file descriptor for a file of that type.
\ The file descriptor is stored in the "my-data" field of the instance
\ record.  The "fid" field of file descriptor contains the address of
\ the private data for this device instance.

headerless
decimal

" /packages" find-device
new-device

0 invert 1 >> constant maxint	\ Assumes 2's complement, I suppose

0 instance value block#         \ Internal state; holds offset from last seek
0 instance value buffer         \ Buffer we use for file I/O
0 instance value bufsize 	\ Size of buffer
0 instance value blocksize	\ Sector size of underlying device
/fd instance buffer: deblock-fd

\ Closes an open file, freeing its descriptor for reuse.

: block-fclose  ( fid -- )
   drop   buffer  if
      buffer  bufsize " dma-free" ['] $call-parent catch  if
         \ If dma-free method doesn't exist, we fall back on the
         \ system free-virtual function.  This is a hack, and can
         \ probably be eliminated in future systems.
         2drop 2drop  buffer bufsize free-virtual
      then
   then
;

\ Writes "count" bytes from the buffer at address "adr" to a file.
\ Returns the number of bytes actually written.

: block-fwrite  ( adr #bytes fid -- #written )
   drop  block#                  ( adr #bytes block# )
   swap blocksize  /             ( adr #blocks block# )
   " write-blocks" $call-parent  ( actual-#blocks )
   blocksize *                   ( #bytes-written )
;


\ Reads at most "count" bytes into the buffer at address "adr" from a file.
\ Returns the number of bytes actually read.

: block-fread  ( adr #bytes fid -- #read )
   drop  block#                  ( adr #bytes block# )
   swap blocksize  /             ( adr block# #blocks )
   " read-blocks" $call-parent   ( actual-#blocks )
   blocksize  *                  ( #bytes-read )
;


\ Positions to byte number "d.byte#" in a file

: block-fseek  ( d.byte# fid -- )  drop  blocksize um/mod  to block#  drop  ;


\ Returns the current size "d.size" of a file

: block-fsize  ( fid -- d.size )  drop -1 maxint  ;


\ Aligns a number to a block boundary.

: block-falign  ( d.byte# fid -- d.aligned-byte# )
   drop  blocksize um/mod nip  blocksize um*
;

: block-size    ( -- n )
   " block-size"  ['] $call-parent catch  if  2drop d# 512  then
;

\ Prepares a file for later access.  Name is the pathname of the file
\ and mode is the mode (0 read, 1 write, 2 modify).  If the operation
\ succeeds, returns the addresses of routines to perform I/O on the
\ open file and true.  If the operation fails, returns false.
: buffer-size  ( -- n )
   " max-transfer"  ['] $call-parent catch  if  2drop  maxint  then

   \ Don't allocate more than 64K, unless the block size is larger than that.
   block-size h# 10000  max  min    ( n )
;

headers
\ Externally-visible routines follow.

" deblocker" device-name

\ This property indicates that bug 1074409 has been fixed.
\ If this property is not present, client programs must install a patch.
0 0 " disk-write-fix" property

: open  ( -- okay? )

   0 to block#                          ( )
   0 to buffer                          ( )

   block-size   to blocksize            ( )
   buffer-size  to bufsize              ( )

   bufsize  " dma-alloc"                ( size adr len )
   ['] $call-parent  catch  if          ( x y z )
      3drop  bufsize allocate-dma       ( dma-addr|0 )
      dup 0=  if  exit  then            ( dma-addr )
   then                                 ( dma-addr )
   to buffer                            ( )

   file @ >r  deblock-fd file !         ( )

   buffer  bufsize  initbuf             ( )

   my-self  modify                      ( fid mode )
   ['] block-fsize   ['] block-falign   ( fid mode ops.. )
   ['] block-fclose  ['] block-fseek    ( fid mode ops.. )
   ['] block-fwrite  ['] block-fread    ( fid mode ops.. )
   setupfd                              ( )

   true                                 ( true )
   r> file !
;

: seek   ( offset.low offset.high -- error? )
   deblock-fd  ['] dfseek catch  if  2drop true  else  false  then
;
: read   ( adr len -- actual-len )
   deblock-fd  ['] fgets catch  if  3drop 0  then
;
: write  ( adr len -- actual-len )
   tuck  deblock-fd  ['] fputs catch  if  2drop 2drop -1  then
;
: close  ( -- )
   deblock-fd ['] fclose catch  ?dup  if  .error drop  then
;

finish-device
device-end
openbios/openboot/obp/dev/deblock.fth

Commit

obp/dev/deblock.fth
