!***********************************************************************
!*
!*        Magnetic tape routines for archive compaction package
!*
!*      Copyright (C)   R.D. Eager   University of Kent   MCMLXXXI
!*
!***********************************************************************
!
!
!***********************************************************************
!*
!*          Constants
!*
!***********************************************************************
!
%constantinteger no = 0, yes = 1
%constantinteger epagesize = 4096
%constantinteger max tapes = 3
%constantinteger read pge = 1
%constantinteger write pge = 2
%constantinteger read reverse pge = 6
%constantinteger file posn = 8
%constantinteger tape posn = 9
%constantinteger write tm = 10
%constantinteger request reject = 2
%constantinteger unused = 0, reading = 1, writing = 2
%constantinteger bulk mover = x'00240000'
                                        ! Supervisor service
%constantbyteintegerarray hex(0:15) = %c
'0','1','2','3','4','5','6','7','8','9','A','B','C','D','E','F'
!
!
!***********************************************************************
!*
!*          Record formats
!*
!***********************************************************************
!
%recordformat pe(%integer dest,srce,p1,p2,p3,p4,p5,p6)
%recordformat tf(%string(6) tape,%integer mode,curr chap,sno,rlev)
!
!
!***********************************************************************
!*
!*          Subsystem references
!*
!***********************************************************************
!
%systemstringfunctionspec itos(%integer n)
%systemroutinespec setfname(%string(63) s)
%externalintegerfunctionspec uinfi(%integer entry)
!
!
!***********************************************************************
!*
!*          Director references
!*
!***********************************************************************
!
%externalroutinespec dout(%record(pe)%name p)
%externalroutinespec dout11(%record(pe)%name p)
%externalroutinespec dout18(%record(pe)%name p)
%externalroutinespec dpoff(%record(pe)%name p)
%externalintegerfunctionspec dpon3(%string(6) user,%record(pe)%name p,%c
                             %integer invoc,msgtype,outno)
!
!
!***********************************************************************
!*
!*          Own variables
!*
!***********************************************************************
!
%ownrecord(tf)%array t(1:16)
!
!
!***********************************************************************
!*
!*          Service routines
!*
!***********************************************************************
!
%string(8)%function htos(%integer value,places)
%integer i
%string(8) s
!
i = 64-4*places
*ld  _s
*lss _places
*st  _(%dr)
*inca_1
*std _%tos
*std _%tos
*lss _value
*luh _0
*ush _i
*mpsr_x'24';                            ! Set CC=1
*supk_%l=8
*ld  _%tos
*ands_%l=8,0,15;                        ! Throw away zone codes
*lss _hex+4
*luh _x'18000010'
*ld  _%tos
*ttr _%l=8
%result = s
%end;   ! of htos
!
!
%routine f read(%integer chan,address,%integername flag)
! Reads the next page
%record(pe) p
!
p = 0
p_dest = t(chan)_sno
p_p1 = m'RDPG'
p_p2 = epagesize<<16!read pge
p_p3 = address
p_p5 = epagesize!x'80000000';           ! LST and 'set written to'
p_p6 = address
dout18(p);                              ! Read a page
flag = p_p2
flag = p_dest %if p_dest = -1;          ! Failure to lock area down
%if flag # 0 %then %start
   printstring("Read fails - flag = X".htos(flag,8))
   newline
%finish
%end;   ! of f read
!
!
%routine b read(%integer chan,address,skip,%integername flag)
! Reads previous page, backwards. If successful, skips page to position
! before the call, if required.
%integer size
%record(pe) p
!
%if t(chan)_curr chap = 0 %then size = 80 %else size = epagesize
p = 0
p_dest = t(chan)_sno
p_p1 = m'RPGB'
p_p2 = size<<16!read reverse pge
p_p3 = address
p_p5 = epagesize!x'80000000';           ! LST and 'set written to'
p_p6 = address
dout18(p);                              ! Read a page backwards
flag = p_p2
%if flag # 0 %then %start
   printstring("Backwards read fails - flag = X".htos(flag,8))
   newline
%finish
flag = p_dest %if p_dest = -1;          ! Failure to lock area down
%if flag = 0 %and skip = yes %then %start
                                        ! Reposition tape if required
   p = 0
   p_dest = t(chan)_sno
   p_p1 = m'FPOS'
   p_p2 = 1<<16!file posn;              ! One block
   dout11(p);                           ! Skip a page
   flag = p_p2
%finish
%end;   ! of b read
!
!
%routine chap posn(%integer chan,chap,%integername flag)
! Positions the tape at a new chapter
%integer diff,fail
%record(pe) p
!
diff = chap-t(chan)_curr chap;          ! Not checked before call
diff = diff - 1 %if diff < 0;           ! One more if backwards
p = 0
p_dest = t(chan)_sno;                   ! Get tape service number
p_p1 = m'TPOS'
p_p2 = diff<<16!1<<8!tape posn;         ! Skip DIFF tape marks
dout(p);                                ! Position the tape
fail = p_p2
%if diff < 0 %then %start;              ! At back of chapter
   p = 0
   p_dest = t(chan)_sno
   p_p1 = m'TPOS'
   p_p2 = 1<<16!1<<8!tape posn;         ! Skip one more tape mark
   dout(p);                             ! To front of next chapter
   flag = p_p2
   fail = fail!flag %unless flag = 4;   ! BT
%finish
flag = fail
t(chan)_curr chap = chap
%end;   ! of chap posn
!
!
%routine tape mark(%integer chan,%integername flag)
! Writes a tape mark on the tape
%record(pe) p
!
p = 0
p_dest = t(chan)_sno
p_p1 = m'WRTM'
p_p2 = write tm
dout11(p)
flag = p_p2
%end;   ! of tape mark
!
!
!***********************************************************************
!*
!*          O P E N   T A P E
!*
!***********************************************************************
!
%externalroutine open tape(%integer chan,mode,rlev,%string(6) tape,%c
                           %integername flag)
! Opens tape TAPE on 'channel' CHAN in mode MODE with recovery level
! RLEV.
%integer sno
%record(pe) p
!
%if reading # mode # writing %then %start
   flag = 1006;                         ! Invalid tape access mode
   -> errc
%finish
%unless 1 <= chan <= max tapes %then %start
   flag = 1007;                         ! Invalid tape channel number
   -> errc
%finish
%if t(chan)_mode # unused %then %start
   flag = 1008;                         ! Tape channel already open
   -> errc
%finish
!
p = 0
p_p2 = 4;                               ! Type = magnetic tape
p_p3 = mode
string(addr(p_p4)) = tape
p_dest = x'FFFF0044';                   ! Request tape from VOLUMS
flag = dpon3("VOLUMS",p,0,1,7)
%if flag = 0 %then %start
   flag = p_p2
   sno = p_p3
%finish
%if flag # 0 %then %start
   flag = 1012;                         ! Failed to claim tape
   -> errt
%finish
t(chan)_mode = mode;                    ! Store for later use
t(chan)_tape = tape
t(chan)_sno = sno
t(chan)_rlev = rlev
t(chan)_curr chap = 0;                  ! Tape is at BT
chap posn(chan,1,flag);                 ! Position after label
%if flag # 0 %then %start
   flag = 1019;                         ! Failed to position tape
   -> errt
%finish
%return
!
errt:
setfname(tape)
%return
!
errc:
setfname(itos(chan))
%end;   ! of open tape
!
!
!***********************************************************************
!*
!*          C L O S E   T A P E
!*
!***********************************************************************
!
%externalroutine close tape(%integer chan,%integername flag)
! Closes the tape on channel CHAN, and sets it not in use
%record(pe) p
!
%unless 1 <= chan <= max tapes %then %start
   flag = 1007;                         ! Invalid tape channel number
   -> errc
%finish
%if t(chan)_mode = unused %then %start
   flag = 1009;                         ! Tape channel not open
   -> errc
%finish
!
p = 0
p_p2 = 4;                               ! Type = magnetic tape
p_p3 = t(chan)_sno
string(addr(p_p4)) = t(chan)_tape
p_dest = x'FFFF0045';                   ! Release tape back to VOLUMS
flag = dpon3("VOLUMS",p,0,1,7)
%if flag = 0 %then flag = p_p2
%if flag # 0 %then %start
   flag = 1013;                         ! Failed to release tape
   -> errt
%finish
t(chan)_tape = ""
t(chan)_mode = unused;                  ! Mark not in use
%return
!
errt:
setfname(t(chan)_tape)
%return
!
errc:
setfname(itos(chan))
%end;   ! of close tape
!
!
!***********************************************************************
!*
!*          S E T   T A P E   M O D E
!*
!***********************************************************************
!
%externalroutine set tape mode(%integer chan,mode,rlev)
%unless 1 <= chan <= max tapes %then %return
!
t(chan)_mode = mode
t(chan)_rlev = rlev
%end;   ! of set tape mode
!
!
!***********************************************************************
!*
!*          R E A D   P A G E
!*
!***********************************************************************
!
%externalroutine read page(%integer chan,chap,address,%integername flag)
! Can read next page in current chapter, or the first page in some
! other chapter.
%integer i
!
%unless 1 <= chan <= max tapes %then %start
   flag = 1007;                         ! Invalid tape channel number
   -> errc
%finish
%if t(chan)_mode # reading %then %start
   flag = 1011;                         ! Tape channel not open for reading
   -> errc
%finish
!
%if chap # t(chan)_curr chap %then %start
                                        ! New chapter?
   chap posn(chan,chap,flag);           ! Position tape
   %if flag # 0 %then %start
      flag = 1019;                      ! Failed to position tape
      -> errt
   %finish
%finish
!
f read(chan,address,flag);              ! Read the page forward
%return %if flag = 0
%if flag = request reject %or t(chan)_rlev = 0 %or %c
                                    flag = 4 %then %start
   %if flag = 4 %then flag = 1034 %else flag = 1017
                                        ! Unexpected tape mark or read error
   -> errt
%finish
!
! Attempt recovery
!
%for i = 1,1,t(chan)_rlev %cycle
   b read(chan,address,yes,flag);       ! Try to read it backwwards
   %return %if flag = 0
   %if flag = request reject %then %start
      flag = 1017;                      ! Tape read error
      -> errt
   %finish
   f read(chan,address,flag);           ! Try to read it forwards
   %return %if flag = 0
   %if flag = request reject %then %start
      flag = 1017;                      ! Tape read error
      -> errt
   %finish
%repeat
!
! Failed to read tape even after requested number of retries - give up
!
flag = 1017;                            ! Tape read error
-> errt
!
errt:
setfname(t(chan)_tape)
%return
!
errc:
setfname(itos(chan))
%end;   ! of read page
!
!
!***********************************************************************
!*
!*          R E A D   P A G E   R E V E R S E
!*
!***********************************************************************
!
%externalroutine read page reverse(%integer chan,chap,address,%c
                                   %integername flag)
! Can read previous page in current chapter.
!
%unless 1 <= chan <= max tapes %then %start
   flag = 1007;                         ! Invalid tape channel number
   -> errc
%finish
%if t(chan)_mode # reading %then %start
   flag = 1011;                         ! Tape channel not open for reading
   -> errc
%finish
!
%if chap # t(chan)_curr chap %then %start
   flag = 1032;                         ! Attempt to read invalid chapter
   -> errt
%finish
!
b read(chan,address,no,flag);           ! Read the page backwards
%return %if flag = 0
%if flag = 4 %then flag = 1034 %else flag = 1017
                                        ! Unexpected tape mark or read error
-> errt
!
errt:
setfname(t(chan)_tape)
%return
!
errc:
setfname(itos(chan))
%end;   ! of read page reverse
!
!
!***********************************************************************
!*
!*          W R I T E   P A G E
!*
!***********************************************************************
!
%externalroutine write page(%integer chan,chap,address,%c
                            %integername flag)
! Can write next page in current chapter, or the first page in the next
! chapter.
%record(pe) p
!
%unless 1 <= chan <= max tapes %then %start
   flag = 1007;                         ! Invalid tape channel number
   -> errc
%finish
%if t(chan)_mode # writing %then %start
   flag = 1010;                         ! Tape channel not open for writing
   -> errc
%finish
!
%if chap = t(chan)_curr chap + 1 %then %start
                                        ! New chapter?
   tape mark(chan,flag)
   %if flag = 4 %then %start
      flag = 0;                         ! Ignore end of tape
   %finish
   %if flag # 0 %then %start
      flag = 1018;                      ! Tape write error
      -> errt
   %finish
   t(chan)_curr chap = chap
%finish
!
%if chap = t(chan)_curr chap %then %start
   p = 0
   p_dest = t(chan)_sno
   p_p1 = m'WRPG'
   p_p2 = epagesize<<16!write pge
   p_p3 = address
   p_p5 = epagesize;                    ! LST and 'no written to'
   p_p6 = address
   dout18(p);                           ! Write a page
   flag = p_p2
   flag = p_dest %if p_dest = -1
%finish %else %start
   flag = 1020;                         ! Attempt to write invalid chapter
   -> errt
%finish
%if flag = 4 %then %start
   flag = 1026;                         ! End of tape
   -> errt
%finish
%if flag # 0 %then %start
   flag = 1018;                         ! Tape write error
   -> errt
%finish
%return
!
errt:
setfname(t(chan)_tape)
%return
!
errc:
setfname(itos(chan))
%end;   ! of write page
!
!
!***********************************************************************
!*
!*          W R I T E   T R A I L E R
!*
!***********************************************************************
!
%externalroutine write trailer(%integer chan,%integername flag)
! A trailer consists of two tape marks
%integer i
!
%unless 1 <= chan <= max tapes %then %start
   flag = 1007;                         ! Invalid tape channel number
   -> errc
%finish
%if t(chan)_mode # writing %then %start
   flag = 1010;                         ! Tape channel not open for writing
   -> errc
%finish
!
%for i = 1,1,2 %cycle
   tape mark(chan,flag)
   %if flag = 4 %then %start
      flag = 1026;                      ! End of tape
      -> errt
   %finish
   %if flag # 0 %then %start
      flag = 1018;                      ! Tape write error
      -> errt
   %finish
%repeat
t(chan)_curr chap = t(chan)_curr chap + 2
%return
!
errt:
setfname(t(chan)_tape)
%return
!
errc:
setfname(itos(chan))
%end;   ! of write trailer
!
!
!***********************************************************************
!*
!*          S T A R T   B U L K   M O V E
!*
!***********************************************************************
!
%externalroutine start bulk move(%integer from,to,pages,%c
                                 %integername flag)
! Initiates a bulk move of pages from FROM to TO, in reverse if PAGES  <
! 0.  If TO = -1 then it moves them to a sink.
%integer i
%record(pe) p
%integer direction
!
%unless 1 <= from <= max tapes %c
      %and (1 <= to <= max tapes %or to = -1) %then %start
   flag = 1007;                         ! Invalid tape channel number
   %if 1 <= from <= max tapes %then i = to %else i = from
   setfname(itos(i))
   -> err
%finish
%if t(from)_mode # reading %then %start
   setfname(itos(from))
   flag = 1011;                         ! Tape channel not open for reading
   -> err
%finish
%if to # -1 %and t(to)_mode # writing %then %start
   setfname(itos(to))
   flag = 1010;                         ! Tape channel not open for writing
   -> err
%finish
!
%if pages < 0 %then %start
   direction = x'8000'
   pages = -pages
%finish %else direction = 0
pages = pages & x'7FFF'
p = 0
p_dest = bulk mover
%if to = -1 %then %start;               ! Tape to sink
   p_p1 = x'03060000'!direction!pages
%finish %else %start;                   ! Tape to tape
   p_p1 = x'03030000'!direction!pages
   p_p4 = t(to)_sno
   p_p5 = 0;                            ! No trailing tape marks
%finish
p_p2 = t(from)_sno
p_p6 = m'BMVE'
flag = dpon3("",p,0,0,6)
%if flag # 0 %then %start
   setfname("X".htos(flag,8)." on ".htos((from <<16)!(to & x'FFFF'),8))
   flag = 1033;                         ! Start bulk move fails
%finish
%return
!
err:
%end;   ! of start bulk move
!
!
!***********************************************************************
!*
!*          A W A I T   B U L K   M O V E S
!*
!***********************************************************************
!
%externalroutine await bulk moves(%integername n,flag)
! Waits for N bulk moves to complete, checking each for success.
%integer failno
%record(pe) p
!
flag = 0
failno = -1
!
%while n # 0 %cycle
   dpoff(p)
   %continue %unless p_srce & x'FFFF0000' = bulk mover
   %if p_p1 # 0 %then %start
      flag = p_p1
      failno = n %if failno < 0
   %finish
   n = n - 1
%repeat
!
%if flag # 0 %then %start
   setfname("X".htos(flag,8))
   flag = 1022
   n = failno
%finish
%end;   ! of await bulk moves
!
!
!***********************************************************************
!*
!*          S K I P   T M   R E V E R S E
!*
!***********************************************************************
!
%externalroutine skip tm reverse(%integer chan, %integername flag)
! Skips a single tape mark in reverse, leaving the tape behind the
! last block.
%record(pe) p
!
%unless 1<= chan <= max tapes %then %start
   flag = 1007;                         ! Invalid tape channel number
   -> errc
%finish
!
p = 0
p_dest = t(chan)_sno
p_p1 = m'STMR'
p_p2 = (-1)<<16!(1<<8)!tape posn
dout(p)
flag = p_p2
%if flag # 0 %then %start
   flag = 1021;                         ! Failed to skip back over tape mark
   -> errt
%finish
t(chan)_curr chap = t(chan)_curr chap - 1
%return
!
errt:
setfname(t(chan)_tape)
%return
!
errc:
%end;   ! of skip tm reverse
!
!
!***********************************************************************
!*
!*          R E L E A S E   A L L   T A P E S
!*
!***********************************************************************
!
%externalroutine release all tapes
! Releases ALL tapes in use by the process.
%integer flag
%record(pe) p
!
p = 0
p_p1 = uinfi(11);                       ! Process number
p_dest = x'FFFF0043';                   ! Release everything
flag = dpon3("VOLUMS",p,0,1,6)
%end;   ! of release all tapes
%endoffile