%  Magnetic tape operations to test mag. tape driver
%  Roger Hauck
%  Smithsonian Astrophysical Observatory (SAO)
%  Cambridge, Mass. 02138
%  January, 1982

%  Things for DEF

ASSEMBLER<
'2/ :  % divide by two
  DIVL2 S^ 2 (P)
  ;
>

%  Allocate buffers, arrays, and variables
8000 'BUF SVARIABLE
 100 'DIAGBUF ARRAY
0002 'IOSB ARRAY
  10 'FILE_LENGTH VARIABLE  % # of records to write per file
  40 'TAPE_LENGTH VARIABLE  % # of records to write per tape
  20 'NAME SVARIABLE  % unit name
  00 'CONSECUTIVE_ERRORS VARIABLE  % consecutive error count

'QIO LOAD/L  % load QIO and IORB stuff
'QIOW : CUR_IORB @ QIOW ;

% Create I/O Request Blocks
IORB<

'READ_IORB IORB
'READ_IORB : READ_IORB CUR_IORB ! ;

'WRITE_IORB IORB
'WRITE_IORB : WRITE_IORB CUR_IORB ! ;

'WRITEOF_IORB IORB
'WRITEOF_IORB : WRITEOF_IORB CUR_IORB ! ;

'REWIND_IORB IORB
'REWIND_IORB : REWIND_IORB CUR_IORB ! ;

%  Initialize IORB's
READ_IORB INIT
  IO$_READPBLK % IO$M_INHRETRY OR % FUNC!
  BUF 2+ P1!  % location of buffer
  BUF 2- W@ P2!  % length of buffer
  IOSB IOSB!

WRITE_IORB INIT
  IO$_WRITEPBLK FUNC!  % write
  BUF 2+ P1!  % location of buffer
  BUF 2- W@ P2!  % length of buffer
%  DIAGBUF P6!  % % location of diagnostic buffer
  IOSB IOSB!

WRITEOF_IORB INIT
  IO$_WRITEOF FUNC!
  IOSB IOSB!

REWIND_IORB INIT
  IO$_REWIND FUNC!

'INI :  % logical name, INI  (puts channel # in IORB's)
  NAME TRNLOG  % translate logical name
  NAME DUP MSG ASSIGN SYSERR  % assign
  DUP SPACE = CR  % type channel #
  DUP READ_IORB CHAN! DUP WRITE_IORB CHAN!  % put channel # in IORB's
  DUP WRITEOF_IORB CHAN! REWIND_IORB CHAN!  % ...
  ;
%  Minor functions

'TYPERR :  % completion code, TYPERR
%	(types message if error)
  IF  % was there an error?
    ELSE  % no
    UNDROP SYSMSG TYPE CR THEN  % yes, type message
  ;

'READ1 :  % reads one record and returns status
  READ_IORB QIOW  % do read
  IOSB 2+ W@ BUF W!  % record # of bytes actually read
  IOSB W@  % report status
  ;

'WRITE1 : % writes one record and returns status
  WRITE_IORB  % select WRITE request block
  BUF W@ P2!  % set # of bytes to transfer
  WRITE_IORB QIOW  % do write
  IOSB W@
  ;

'WRITE_EOF :  % writes an EOF on tape
  WRITEOF_IORB QIOW  % do it
  IOSB W@  % report status
  ;

'REWIND :  % rewinds the tape
  REWIND_IORB QIOW  % do it
  IOSB W@  % report status
  ;

'FILL_BUFFER :  % origin, FILL_BUFFER
%	(load buffer with cyclic pattern)
  BUF 2- W@ 2/ (  % # of words to put in buffer
    DUP I +  % word to store
    BUF 2+ I 2* + W!  % store it
    )
  DROP
  ;
%  Major functions

'READ :
  BEGIN
    READ1 DUP IF  % read, success?
      BUF 2+ W@ <# # # # #> TYPE SPACE  % yes, type first word of block
      CONSECUTIVE_ERRORS 0<- ELSE  % clear error count
      UNDROP SYSMSG TYPE CR  % no, type system message
      CONSECUTIVE_ERRORS 1+<- THEN  % increment error count
    CONSECUTIVE_ERRORS @ 5 LE END  % stop if too many consecutive errors
  ;

'WRITE :  % WRITE  (writes a test tape)
  BUF 2- W@ BUF W!
  TAPE_LENGTH @ (  % loop through count
    I 1+ FILE_LENGTH @ MOD EQZ_IF  % time to write an EOF?
      WRITE_EOF TYPERR ELSE
      I FILL_BUFFER  % load buffer with unique pattern
      WRITE1 TYPERR  % write
      THEN
    )
  7 ( WRITE_EOF DROP )  % closeout the tape
  ;

'FD : 100 ( DIAGBUF I 4 * + -1<- ) ;

'DD : 20  ( I = DIAGBUF I 4 * + ? CR ) ;