[OpenSPARC-T2-SAM] / obp / obp / dev / scsi / targets / scsitape.fth

\ ========== 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 
\    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: @(#)scsitape.fth 1.4 00/06/07
purpose: 
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.

" byte"      device-type

fload ${BP}/dev/scsi/targets/scsicom.fth  \ Utility routines

hex

external

false instance value at-eof?      \ Turned on when read-blocks hits file mark

headers

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,

external

\ Writes a file mark

: write-eof  ( -- error? )  write-eof-cmd no-data-command  ;

headers


\ Writes a file mark it the tape has been written since the last seek
\ or rewind or write-eof.

: ?write-eof  ( -- )
   written?  if
      false to written?
      write-eof  if  ." Can't write file mark." cr  then
   then
;
[else]

alias ?write-eof noop

headers
[then]

create rewind-cmd  1 c, 1 c, 0 c, 0 c, 0 c, 0 c,

: rewind   ( -- error? )        \ Rewinds the tape
   ?write-eof
   false to at-eof?
   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
   ?write-eof
   false to at-eof?                ( n )
   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 )
   else                             ( buffer )
      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' )
   then                             ( blocksize )
   deblock-defbufsize ?dup if  min  then
   to /tapeblock                    ( )
;

true instance value first-install?      \ Used for rewind-on-first-open

\ Words to decode various interesting fields in the extended status buffer
\ Used by actual-#blocks

\ Incorrect length

: 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 ( )
         0 false                                ( 0 false )
      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 )
         r> eof?                                ( #xfered flag )
      then
   else       \ no error, #request = #xfered    ( )
      #requested false                          ( #xfered flag )
   then
   to at-eof?
;


\ 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? )
   cmdbuf d# 10 erase
   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.
      drop dup if
         /tapeblock                ( addr dir #bytes )
      else
         /writeblock               ( addr dir #bytes )
      then                         ( 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
\ the deblocker

: flush-deblocker   ( -- )
   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,
external
: eject ( -- )
   my-unit " set-address" $call-parent
   device-present? if
      eject-cmd no-data-command  drop
   then
;

\ The deblocker package calls max-transfer to determine an appropriate
\ internal buffer size.

: max-transfer  ( -- n )
   fixed-len?  if
      \ Use the largest multiple of /tapeblock that is <= parent-max-transfer
      parent-max-transfer  /tapeblock /   /tapeblock *
   else
      /tapeblock
   then
;

\ The deblocker package calls block-size to determine an appropriate
\ granularity for accesses.

: block-size ( -- n )
   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
;
[then]

: open  ( -- okay? )

   device-present? case
      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.
   endcase
   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
   \ really is a tape.

   first-install?  if
      rewind  if
         ." Can't rewind tape" cr
         false exit
      then
      false to first-install?
   then

   get-record-length

   init-deblocker       ( okay? )
;

: close  ( -- )
   deblocker close-package
   ?write-eof
;


0 instance value buf
h# 200 constant /buf

\ 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# )

   ?dup  if                                   ( byte# file# )
      skip-files  if   drop true  exit  then  ( byte# )
   then                                       ( byte# )

   ?dup  if                                   ( byte# )
      /buf alloc-mem  to buf
      begin  dup 0>  while                    ( #remaining )
         buf  over /buf min  read             ( #remaining #read )
         dup 0=  if  2drop  true exit  then   ( #remaining #read )
         -                                    ( #remaining' )
      repeat                                  ( 0 )
      drop                                    ( )
      buf /buf free-mem                       ( )
   then                                       ( )

   false                                      ( no-error )
;

: load  ( loadaddr -- size )
   my-args  dup  if                           ( loadaddr addr len )
      $number  if                             ( loadaddr )
         ." Invalid tape file number" cr      ( loadaddr )
         drop 0 exit                          ( 0 )
      then                                    ( loadaddr n )
   else                                       ( loadaddr addr 0 )
      nip                                     ( loadaddr 0 )
   then                                       ( loadaddr file# )

   0 swap  seek  if                           ( loadaddr )
       ." Can't select the requested tape file" cr
       0 exit
   then                                       ( loadaddr )

   \ 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 )
;

headers
Commit	Line	Data
920dae64 AT	1	\ ========== Copyright Header Begin ==========================================
	2	\
	3	\ Hypervisor Software File: scsitape.fth
	4	\
	5	\ Copyright (c) 2006 Sun Microsystems, Inc. All Rights Reserved.
	6	\
	7	\ - Do no alter or remove copyright notices
	8	\
	9	\ - Redistribution and use of this software in source and binary forms, with
	10	\ or without modification, are permitted provided that the following
	11	\ conditions are met:
	12	\
	13	\ - Redistribution of source code must retain the above copyright notice,
	14	\ this list of conditions and the following disclaimer.
	15	\
	16	\ - Redistribution in binary form must reproduce the above copyright notice,
	17	\ this list of conditions and the following disclaimer in the
	18	\ documentation and/or other materials provided with the distribution.
	19	\
	20	\ Neither the name of Sun Microsystems, Inc. or the names of contributors
	21	\ may be used to endorse or promote products derived from this software
	22	\ without specific prior written permission.
	23	\
	24	\ This software is provided "AS IS," without a warranty of any kind.
	25	\ ALL EXPRESS OR IMPLIED CONDITIONS, REPRESENTATIONS AND WARRANTIES,
	26	\ INCLUDING ANY IMPLIED WARRANTY OF MERCHANTABILITY, FITNESS FOR A
	27	\ PARTICULAR PURPOSE OR NON-INFRINGEMENT, ARE HEREBY EXCLUDED. SUN
	28	\ MICROSYSTEMS, INC. ("SUN") AND ITS LICENSORS SHALL NOT BE LIABLE FOR
	29	\ ANY DAMAGES SUFFERED BY LICENSEE AS A RESULT OF USING, MODIFYING OR
	30	\ DISTRIBUTING THIS SOFTWARE OR ITS DERIVATIVES. IN NO EVENT WILL SUN
	31	\ OR ITS LICENSORS BE LIABLE FOR ANY LOST REVENUE, PROFIT OR DATA, OR
	32	\ FOR DIRECT, INDIRECT, SPECIAL, CONSEQUENTIAL, INCIDENTAL OR PUNITIVE
	33	\ DAMAGES, HOWEVER CAUSED AND REGARDLESS OF THE THEORY OF LIABILITY,
	34	\ ARISING OUT OF THE USE OF OR INABILITY TO USE THIS SOFTWARE, EVEN IF
	35	\ SUN HAS BEEN ADVISED OF THE POSSIBILITY OF SUCH DAMAGES.
	36	\
	37	\ You acknowledge that this software is not designed, licensed or
	38	\ intended for use in the design, construction, operation or maintenance of
	39	\ any nuclear facility.
	40	\
	41	\ ========== Copyright Header End ============================================
	42	id: @(#)scsitape.fth 1.4 00/06/07
	43	purpose:
	44	copyright: Copyright 1995-2000 Sun Microsystems, Inc. All Rights Reserved
	45
	46
	47	\ SCSI tape package implementing a "byte" device-type interface.
	48	\ Supports both fixed-length-record and variable-length-record tape devices.
	49
	50	" byte" device-type
	51
	52	fload ${BP}/dev/scsi/targets/scsicom.fth \ Utility routines
	53
	54	hex
	55
	56	external
	57
	58	false instance value at-eof? \ Turned on when read-blocks hits file mark
	59
	60	headers
	61
	62	false instance value fixed-len? \ True if the device has fixed-length blocks
	63	false instance value written? \ True if the tape has been written
	64
65	h# 8000 instance value /writeblock \ Max writeblock size for variable-length
66	0 instance value /tapeblock \ Max length for variable-length records,
67	\ actual length for fixed length records.
68
69	[ifdef] tape-write-support?
70	create write-eof-cmd h# 10 c, 1 c, 0 c, 0 c, 1 c, 0 c,
71
72	external
73
74	\ Writes a file mark
75
76	: write-eof ( -- error? ) write-eof-cmd no-data-command ;
77
78	headers
79
80
81	\ Writes a file mark it the tape has been written since the last seek
82	\ or rewind or write-eof.
83
84	: ?write-eof ( -- )
85	written? if
86	false to written?
87	write-eof if ." Can't write file mark." cr then
88	then
89	;
90	[else]
91
92	alias ?write-eof noop
93
94	headers
95	[then]
96
97	create rewind-cmd 1 c, 1 c, 0 c, 0 c, 0 c, 0 c,
98
99	: rewind ( -- error? ) \ Rewinds the tape
100	?write-eof
101	false to at-eof?
102	rewind-cmd no-data-command
103	;
104
105	create skip-files-cmd h# 11 c, 1 c, 0 c, 0 c, 0 c, 0 c,
106
107	: skip-files ( n -- error? ) \ Skips n file marks
108	?write-eof
109	false to at-eof? ( n )
110	skip-files-cmd 2 + 3c! ( )
111	skip-files-cmd no-data-command ( error? )
112	;
113
114	\ Asks the device its record length
115	\ Also determines fixed or variable length
116
117	create block-limit-cmd 5 c, 0 c, 0 c, 0 c, 0 c, 0 c,
118
119	: 2c@ ( addr -- n ) 1 + -c@ c@ bwjoin ;
120
121	: get-record-length ( -- )
122	6 block-limit-cmd 6 short-data-command if
123	d# 512 true ( blocksize fixed-len )
124	else ( buffer )
125	dup 1 + 3c@ swap 4 + 2c@ ( max-len min-len )
126	over = ( blocksize fixed-len? )
127	then ( blocksize fixed-len? )
128	to fixed-len? ( blocksize )
129
130	dup parent-max-transfer u> if ( blocksize )
131	drop parent-max-transfer ( blocksize' )
132	then ( blocksize )
133	deblock-defbufsize ?dup if min then
134	to /tapeblock ( )
135	;
136
137	true instance value first-install? \ Used for rewind-on-first-open
138
139	\ Words to decode various interesting fields in the extended status buffer
140	\ Used by actual-#blocks
141
142	\ Incorrect length
143
144	: ili? ( statbuf -- flag ) 2 + c@ h# 20 and 0<> ;
145
146
147	\ End of Media, End of File, or Blank Check
148
149	: eof? ( statbuf -- flag )
150	dup 2 + c@ h# c0 and 0<> swap 3 + c@ h# f and 8 = or
151	;
152
153
154	\ Difference between requested count and actual count
155
156	: residue ( statbuf -- residue ) 3 + 4c@ ;
157
158
159	0 instance value #requested \ Local variable for r/w-some and actual-#blocks
160
161
162	\ Decodes the status information returned by the SCSI command to
163	\ determine the number of blocks actually tranferred.
164
165	: actual-#blocks ( [[xstatbuf] hw-err? ] status -- #xfered flag )
166	if \ Error ( true \| xstatbuf false )
167	if \ Hardware error; none tranferred ( )
168	0 false ( 0 false )
169	else \ Decode status buffer ( xstatbuf )
170	>r #requested ( #requested ) ( r: xstatbuf )
171	r@ ili? r@ eof? or if ( #requested ) ( r: xstatbuf )
172	r@ residue ( #xfered ) ( r: xstatbuf )
173	0 max ?dup 0= if dup then ( #requested ) ( r: xstatbuf )
174	- ( #xfered ) ( r: xstatbuf )
175	then ( #xfered ) ( r: xstatbuf )
176	r> eof? ( #xfered flag )
177	then
178	else \ no error, #request = #xfered ( )
179	#requested false ( #xfered flag )
180	then
181	to at-eof?
182	;
183
184
185	\ Reads or writes at most "#blks" blocks, returning the actual number
186	\ of blocks transferred, and an error indicator that is true if either a
187	\ fatal error occurs or the end of a tape file is reached.
188
189	: r/w-some ( addr #blks input? cmd -- actual# error? )
190	cmdbuf d# 10 erase
191	0 cb! swap ( addr dir #blks )
192	fixed-len? if ( addr dir #blks )
193
194	\ If the tape has fixed length records, we multiply the
195	\ requested number of blocks by the record size.
196
197	dup to #requested ( addr dir #blks )
198	dup /tapeblock * swap 1 ( addr dir #bytes cmd-cnt 1=fixed-len )
199
200	else \ variable length ( addr dir #bytes )
201
202	\ If the tape has variable length records, we transfer one record.
203	drop dup if
204	/tapeblock ( addr dir #bytes )
205	else
206	/writeblock ( addr dir #bytes )
207	then ( addr dir #bytes )
208	dup to #requested ( addr dir #bytes )
209	dup 0 ( addr dir #bytes cmd-cnt 0=variable-len )
210
211	then ( addr dir #bytes cmd-cnt byte1 )
212
213	1 cb! cmdbuf 2 + 3c! ( addr dir #bytes )
214	swap cmdbuf 6 -1 ( dma-addr,len dir cmd-addr,len #retries)
215	retry-command actual-#blocks ( actual# )
216	;
217
218	\ Discards (for read) or flushes (for write) any bytes that are buffered by
219	\ the deblocker
220
221	: flush-deblocker ( -- )
222	deblocker close-package init-deblocker drop
223	;
224
225	: device-present? ( -- flag )
226	my-unit " device-present?" $call-parent
227	;
228
229	create eject-cmd h# 1b c, 1 c, 0 c, 0 c, 2 c, 0 c,
230	external
231	: eject ( -- )
232	my-unit " set-address" $call-parent
233	device-present? if
234	eject-cmd no-data-command drop
235	then
236	;
237
238	\ The deblocker package calls max-transfer to determine an appropriate
239	\ internal buffer size.
240
241	: max-transfer ( -- n )
242	fixed-len? if
243	\ Use the largest multiple of /tapeblock that is <= parent-max-transfer
244	parent-max-transfer /tapeblock / /tapeblock *
245	else
246	/tapeblock
247	then
248	;
249
250	\ The deblocker package calls block-size to determine an appropriate
251	\ granularity for accesses.
252
253	: block-size ( -- n )
254	fixed-len? if /tapeblock else 1 then
255	;
256
257	\ The deblocker uses read-blocks and write-blocks to access tape records.
258	\ The assumption of sequential access is guaranteed because this is only
259	\ called from the deblocker. Since the SCSI tape package implements its
260	\ own "seek" method, the deblocker seek method is never called, and the
261	\ deblocker's internal position only changes sequentially.
262
263	: read-blocks ( addr block# #blocks -- #read )
264	nip ( addr #blocks ) \ Sequential access
265
266	\ Don't read past a file mark
267	at-eof? if 2drop 0 exit then ( addr #blocks )
268
269	true 8 r/w-some ( #read )
270	;
271
272	: read ( addr len -- actual-len ) " read" deblocker $call-method ;
273
274	[ifdef] tape-write-support?
275	: write-blocks ( addr block# #blocks -- #read )
276	nip ( addr #blocks ) \ Sequential access
277	true to written? ( addr #blocks )
278	false h# a r/w-some ( #written )
279	;
280
281	: write ( addr len -- actual-len )
282	" write" deblocker $call-method ( actual-len )
283	flush-deblocker \ Make the tape structure reflect the write pattern
284	;
285	[then]
286
287	: open ( -- okay? )
288
289	device-present? case
290	0 of true endof \ device missing so bail
291	2 of true endof \ Check Condition.. bail
292	8 of false endof \ busy OK.
293	false swap \ Everything else looks cool.
294	endcase
295	if false exit then ( -- )
296
297	my-unit " set-address" $call-parent
298
299	\ It might be a good idea to do an inquiry here to determine the
300	\ device configuration, checking the result to see if the device
301	\ really is a tape.
302
303	first-install? if
304	rewind if
305	." Can't rewind tape" cr
306	false exit
307	then
308	false to first-install?
309	then
310
311	get-record-length
312
313	init-deblocker ( okay? )
314	;
315
316	: close ( -- )
317	deblocker close-package
318	?write-eof
319	;
320
321
322	0 instance value buf
323	h# 200 constant /buf
324
325	\ It would be better to keep track of the current file number and
326	\ just seek forward if the requested file number/position is greater
327	\ than the current file number/position. Taking care of end-of-file
328	\ conditions would be tricky though.
329
330	: seek ( byte# file# -- error? )
331
332	flush-deblocker ( byte# file# )
333
334	rewind if 2drop true exit then ( byte# file# )
335
336	?dup if ( byte# file# )
337	skip-files if drop true exit then ( byte# )
338	then ( byte# )
339
340	?dup if ( byte# )
341	/buf alloc-mem to buf
342	begin dup 0> while ( #remaining )
343	buf over /buf min read ( #remaining #read )
344	dup 0= if 2drop true exit then ( #remaining #read )
345	- ( #remaining' )
346	repeat ( 0 )
347	drop ( )
348	buf /buf free-mem ( )
349	then ( )
350
351	false ( no-error )
352	;
353
354	: load ( loadaddr -- size )
355	my-args dup if ( loadaddr addr len )
356	$number if ( loadaddr )
357	." Invalid tape file number" cr ( loadaddr )
358	drop 0 exit ( 0 )
359	then ( loadaddr n )
360	else ( loadaddr addr 0 )
361	nip ( loadaddr 0 )
362	then ( loadaddr file# )
363
364	0 swap seek if ( loadaddr )
365	." Can't select the requested tape file" cr
366	0 exit
367	then ( loadaddr )
368
369	\ Try to read the entire tape file. We ask for a huge size
370	\ (almost 2 G Bytes), and let the deblocker take care of
371	\ breaking it up into manageable chunks. The operation
372	\ will cease when a file mark is reached.
373
374	h# 70000000 read ( size )
375	;
376
377	headers