\ ========== Copyright Header Begin ==========================================
\ Hypervisor Software File: scsitape.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: @(#)scsitape.fth 1.4 00/06/07
copyright: Copyright 1995-2000 Sun Microsystems, Inc. All Rights Reserved
\ SCSI tape package implementing a "byte" device-type interface.
\ Supports both fixed-length-record and variable-length-record tape devices.
fload ${BP}/dev/scsi/targets/scsicom.fth \ Utility routines
false instance value at-eof? \ Turned on when read-blocks hits file mark
false instance value fixed-len? \ True if the device has fixed-length blocks
false instance value written? \ True if the tape has been written
h# 8000 instance value /writeblock \ Max writeblock size for variable-length
0 instance value /tapeblock \ Max length for variable-length records,
\ actual length for fixed length records.
[ifdef] tape-write-support?
create write-eof-cmd h# 10 c, 1 c, 0 c, 0 c, 1 c, 0 c,
: write-eof ( -- error? ) write-eof-cmd no-data-command ;
\ Writes a file mark it the tape has been written since the last seek
\ or rewind or write-eof.
write-eof if ." Can't write file mark." cr then
create rewind-cmd 1 c, 1 c, 0 c, 0 c, 0 c, 0 c,
: rewind ( -- error? ) \ Rewinds the tape
rewind-cmd no-data-command
create skip-files-cmd h# 11 c, 1 c, 0 c, 0 c, 0 c, 0 c,
: skip-files ( n -- error? ) \ Skips n file marks
skip-files-cmd 2 + 3c! ( )
skip-files-cmd no-data-command ( error? )
\ Asks the device its record length
\ Also determines fixed or variable length
create block-limit-cmd 5 c, 0 c, 0 c, 0 c, 0 c, 0 c,
: 2c@ ( addr -- n ) 1 + -c@ c@ bwjoin ;
: get-record-length ( -- )
6 block-limit-cmd 6 short-data-command if
d# 512 true ( blocksize fixed-len )
dup 1 + 3c@ swap 4 + 2c@ ( max-len min-len )
over = ( blocksize fixed-len? )
then ( blocksize fixed-len? )
to fixed-len? ( blocksize )
dup parent-max-transfer u> if ( blocksize )
drop parent-max-transfer ( blocksize' )
deblock-defbufsize ?dup if min then
true instance value first-install? \ Used for rewind-on-first-open
\ Words to decode various interesting fields in the extended status buffer
: ili? ( statbuf -- flag ) 2 + c@ h# 20 and 0<> ;
\ End of Media, End of File, or Blank Check
: eof? ( statbuf -- flag )
dup 2 + c@ h# c0 and 0<> swap 3 + c@ h# f and 8 = or
\ Difference between requested count and actual count
: residue ( statbuf -- residue ) 3 + 4c@ ;
0 instance value #requested \ Local variable for r/w-some and actual-#blocks
\ Decodes the status information returned by the SCSI command to
\ determine the number of blocks actually tranferred.
: actual-#blocks ( [[xstatbuf] hw-err? ] status -- #xfered flag )
if \ Error ( true | xstatbuf false )
if \ Hardware error; none tranferred ( )
else \ Decode status buffer ( xstatbuf )
>r #requested ( #requested ) ( r: xstatbuf )
r@ ili? r@ eof? or if ( #requested ) ( r: xstatbuf )
r@ residue ( #xfered ) ( r: xstatbuf )
0 max ?dup 0= if dup then ( #requested ) ( r: xstatbuf )
- ( #xfered ) ( r: xstatbuf )
then ( #xfered ) ( r: xstatbuf )
else \ no error, #request = #xfered ( )
#requested false ( #xfered flag )
\ Reads or writes at most "#blks" blocks, returning the actual number
\ of blocks transferred, and an error indicator that is true if either a
\ fatal error occurs or the end of a tape file is reached.
: r/w-some ( addr #blks input? cmd -- actual# error? )
0 cb! swap ( addr dir #blks )
fixed-len? if ( addr dir #blks )
\ If the tape has fixed length records, we multiply the
\ requested number of blocks by the record size.
dup to #requested ( addr dir #blks )
dup /tapeblock * swap 1 ( addr dir #bytes cmd-cnt 1=fixed-len )
else \ variable length ( addr dir #bytes )
\ If the tape has variable length records, we transfer one record.
/tapeblock ( addr dir #bytes )
/writeblock ( addr dir #bytes )
dup to #requested ( addr dir #bytes )
dup 0 ( addr dir #bytes cmd-cnt 0=variable-len )
then ( addr dir #bytes cmd-cnt byte1 )
1 cb! cmdbuf 2 + 3c! ( addr dir #bytes )
swap cmdbuf 6 -1 ( dma-addr,len dir cmd-addr,len #retries)
retry-command actual-#blocks ( actual# )
\ Discards (for read) or flushes (for write) any bytes that are buffered by
deblocker close-package init-deblocker drop
: device-present? ( -- flag )
my-unit " device-present?" $call-parent
create eject-cmd h# 1b c, 1 c, 0 c, 0 c, 2 c, 0 c,
my-unit " set-address" $call-parent
eject-cmd no-data-command drop
\ The deblocker package calls max-transfer to determine an appropriate
\ Use the largest multiple of /tapeblock that is <= parent-max-transfer
parent-max-transfer /tapeblock / /tapeblock *
\ The deblocker package calls block-size to determine an appropriate
\ granularity for accesses.
fixed-len? if /tapeblock else 1 then
\ The deblocker uses read-blocks and write-blocks to access tape records.
\ The assumption of sequential access is guaranteed because this is only
\ called from the deblocker. Since the SCSI tape package implements its
\ own "seek" method, the deblocker seek method is never called, and the
\ deblocker's internal position only changes sequentially.
: read-blocks ( addr block# #blocks -- #read )
nip ( addr #blocks ) \ Sequential access
\ Don't read past a file mark
at-eof? if 2drop 0 exit then ( addr #blocks )
true 8 r/w-some ( #read )
: read ( addr len -- actual-len ) " read" deblocker $call-method ;
[ifdef] tape-write-support?
: write-blocks ( addr block# #blocks -- #read )
nip ( addr #blocks ) \ Sequential access
true to written? ( addr #blocks )
false h# a r/w-some ( #written )
: write ( addr len -- actual-len )
" write" deblocker $call-method ( actual-len )
flush-deblocker \ Make the tape structure reflect the write pattern
0 of true endof \ device missing so bail
2 of true endof \ Check Condition.. bail
8 of false endof \ busy OK.
false swap \ Everything else looks cool.
if false exit then ( -- )
my-unit " set-address" $call-parent
\ It might be a good idea to do an inquiry here to determine the
\ device configuration, checking the result to see if the device
\ It would be better to keep track of the current file number and
\ just seek forward if the requested file number/position is greater
\ than the current file number/position. Taking care of end-of-file
\ conditions would be tricky though.
: seek ( byte# file# -- error? )
flush-deblocker ( byte# file# )
rewind if 2drop true exit then ( byte# file# )
skip-files if drop true exit then ( byte# )
begin dup 0> while ( #remaining )
buf over /buf min read ( #remaining #read )
dup 0= if 2drop true exit then ( #remaining #read )
: load ( loadaddr -- size )
my-args dup if ( loadaddr addr len )
." Invalid tape file number" cr ( loadaddr )
0 swap seek if ( loadaddr )
." Can't select the requested tape file" cr
\ Try to read the entire tape file. We ask for a huge size
\ (almost 2 G Bytes), and let the deblocker take care of
\ breaking it up into manageable chunks. The operation
\ will cease when a file mark is reached.
h# 70000000 read ( size )
projects / OpenSPARC-T2-SAM / blob