\ ========== 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
\ - 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
\ ========== Copyright Header End ============================================
id: @(#)deblock.fth 2.20 97/02/04
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.
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 -- )
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
\ 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" ['] $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.
" 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 )
\ Externally-visible routines follow.
\ 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
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 )
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.. )
: 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
deblock-fd ['] fclose catch ?dup if .error drop then
projects / OpenSPARC-T2-SAM / blob