!***********************************************************************
!*
!*                 Copying utilities for magnetic tape
!*
!*     Copyright (C)   R.D. Eager   University of Kent   MCMLXXXI
!*
!***********************************************************************
!
!
!***********************************************************************
!*
!*          Constants
!*
!***********************************************************************
!
CONSTINTEGER  NO = 0, YES = 1
CONSTINTEGER  NORMAL = 0, NRZI = 1
CONSTINTEGER  RCHAN = 1, WCHAN = 2
CONSTINTEGER  MAXBLOCK = 32000
CONSTSTRING (1) SNL = "
"
CONSTSTRING (12)ARRAY  OPNAME(NORMAL:NRZI) = C 
"COPYTAPE","COPYNRZITAPE"
!
!
!***********************************************************************
!*
!*          Subsystem references
!*
!***********************************************************************
!
SYSTEMSTRINGFNSPEC  FAILUREMESSAGE(INTEGER  MESS)
SYSTEMSTRINGFNSPEC  ITOS(INTEGER  N)
SYSTEMINTEGERFNSPEC  PARMAP
EXTERNALROUTINESPEC  PROMPT(STRING (255) S)
SYSTEMROUTINESPEC  SETFNAME(STRING (63) S)
SYSTEMROUTINESPEC  SETPAR(STRING (255) S)
EXTERNALROUTINESPEC  SET RETURN CODE(INTEGER  I)
SYSTEMSTRINGFNSPEC  SPAR(INTEGER  N)
SYSTEMROUTINESPEC  UCTRANSLATE(INTEGER  AD,LEN)
!
!
!***********************************************************************
!*
!*          References to magnetic tape interface routines
!*
!***********************************************************************
!
EXTERNALROUTINESPEC  ASKMAG(INTEGER  CHAN,STRING (7) VOL,C 
                            INTEGERNAME  FLAG)
EXTERNALROUTINESPEC  DENSITYMAG(INTEGER  CHAN, DENSITY)
EXTERNALROUTINESPEC  READMAG(INTEGER  CHAN,AD,INTEGERNAME  LEN,FLAG)
EXTERNALROUTINESPEC  SKIPMAG(INTEGER  CHAN,N)
EXTERNALROUTINESPEC  UNLOADMAG(INTEGER  CHAN)
EXTERNALROUTINESPEC  WRITEMAG(INTEGER  CHAN,AD,LEN,INTEGERNAME  FLAG)
EXTERNALROUTINESPEC  WRITETMMAG(INTEGER  CHAN,INTEGERNAME  FLAG)
!
!
!***********************************************************************
!*
!*          Own variables
!*
!***********************************************************************
!
OWNINTEGER  RVOL CLAIMED = NO
OWNINTEGER  WVOL CLAIMED = NO
!
!
!***********************************************************************
!*
!*          Service routines
!*
!***********************************************************************
!
STRING (255)FN  SPECMESSAGE(INTEGER  FLAG,BLKNO)
STRING (255) S
SWITCH  SW(1000:1004)
!
-> SW(FLAG)
!
SW(1000):  S = "Failed to claim input tape"; -> OUT
SW(1001):  S = "Failed to claim output tape"; -> OUT
SW(1002):  S = "Failed to write a tape mark"; -> OUT
SW(1003):  S = "Tape read failure after ".ITOS(BLKNO)." block"
           -> SW1004A
SW(1004):  S = "Tape write failure after ".ITOS(BLKNO)." block"
SW1004A:
           IF  BLKNO # 1 THEN  S = S."s"
           -> OUT
!
OUT:
S <- " ".S.SNL
RESULT  = S
END ;   ! of SPECMESSAGE
!
!
ROUTINE  FAIL(STRING (15) OP,INTEGER  FLAG,BLKNO)
PRINTSTRING(SNL.OP." fails -")
IF  FLAG < 1000 THEN  START 
   PRINTSTRING(FAILUREMESSAGE(FLAG))
FINISH  ELSE  START 
   PRINTSTRING(SPECMESSAGE(FLAG,BLKNO))
FINISH 
IF  RVOL CLAIMED = YES THEN  UNLOADMAG(RCHAN)
IF  WVOL CLAIMED = YES THEN  UNLOADMAG(WCHAN)
SET RETURN CODE(0)
STOP 
END ;   ! of FAIL
!
!
ROUTINE  READLINE(STRINGNAME  S)
INTEGER  C
!
S = ""
CYCLE 
   CYCLE 
      READSYMBOL(C)
      EXIT  IF  C = NL
      S <- S.TOSTRING(C)
   REPEAT 
   WHILE  LENGTH(S) > 0 AND  CHARNO(S,LENGTH(S)) = ' ' CYCLE 
      LENGTH(S) = LENGTH(S) - 1
   REPEAT 
   EXIT  UNLESS  S = ""
REPEAT 
UCTRANSLATE(ADDR(S)+1,LENGTH(S))
END ;   ! of READLINE
!
!
INTEGERFN  YES OR NO(STRING (15) PR)
INTEGER  C
STRING (255) S
!
PROMPT(PR."? ")
CYCLE 
   READLINE(S)
   CONTINUE  IF  S = ""
   C = CHARNO(S,1)
   CONTINUE  IF  'Y' # C # 'N'
   IF  C = 'Y' THEN  RESULT  = YES ELSE  RESULT  = NO
REPEAT 
END ;   ! of YES OR NO
!
!
ROUTINE  DO COPY(STRINGNAME  PARMS,INTEGER  MODE)
INTEGER  COPY LABEL,BLKNO,LEN,FLAG,AD,TM PENDING,READ NRZI,WRITE NRZI
STRING (31) RVOL,WVOL
BYTEINTEGERARRAY  IN(1:MAXBLOCK)
!
SET RETURN CODE(1000)
RVOL = ""
WVOL = ""
RVOL CLAIMED = NO
WVOL CLAIMED = NO
BLKNO = 0
SETPAR(PARMS)
IF  PARMAP > 3 THEN  START 
   FLAG = 263;                          ! Wrong number of parameters
   -> ERR
FINISH 
!
IF  PARMAP & 1 # 0 THEN  START 
   RVOL <- SPAR(1)
   UNLESS  1 <= LENGTH(RVOL) <= 6 THEN  START 
      SETFNAME(RVOL)
      FLAG = 202;                       ! Invalid parameter
      -> ERR
   FINISH 
FINISH 
!
IF  PARMAP & 2 # 0 THEN  START 
   WVOL <- SPAR(2)
   UNLESS  1 <= LENGTH(WVOL) <= 6 THEN  START 
      SETFNAME(WVOL)
      FLAG = 202;                       ! Invalid parameter
      -> ERR
   FINISH 
FINISH 
!
IF  RVOL = "" THEN  START 
   PROMPT("Input tape: ")
   READLINE(RVOL) UNTIL  1 <= LENGTH(RVOL) <= 6
FINISH 
IF  WVOL = "" THEN  START 
   PROMPT("Output tape: ")
   READLINE(WVOL) UNTIL  1 <= LENGTH(WVOL) <= 6
FINISH 
!
COPY LABEL = YES OR NO("Copy label")
IF  MODE = NRZI THEN  START 
   READ NRZI = YES OR NO("Read NRZI")
   WRITE NRZI = YES OR NO("Write NRZI")
FINISH  ELSE  START 
   READ NRZI = NO
   WRITE NRZI = NO
FINISH 
IF  READ NRZI = YES THEN  DENSITYMAG(RCHAN,800)
IF  WRITE NRZI = YES THEN  DENSITYMAG(WCHAN,800)
!
ASKMAG(RCHAN,RVOL,FLAG)
IF  FLAG # 0 THEN  START 
   FLAG = 1000;                         ! Failed to claim input tape
   -> ERR
FINISH 
RVOL CLAIMED = YES
ASKMAG(WCHAN,WVOL."*",FLAG)
IF  FLAG # 0 THEN  START 
   FLAG = 1001;                         ! Failed to claim output tape
   -> ERR
FINISH 
WVOL CLAIMED = YES
!
IF  COPY LABEL = NO THEN  START 
   SKIPMAG(RCHAN,1);                    ! Skip vol label on input tape
   SKIPMAG(WCHAN,1);                    ! Skip vol label on output tape
FINISH 
!
TM PENDING = NO
AD = ADDR(IN(1));                       ! Address of buffer
BLKNO = 0
CYCLE 
   LEN = MAXBLOCK
   READMAG(RCHAN,AD,LEN,FLAG);          ! Read a block
   BLKNO = BLKNO + 1
   IF  FLAG = 1 THEN  START ;           ! Tape mark
      WRITETMMAG(WCHAN,FLAG)
      IF  FLAG # 0 THEN  START 
         FLAG = 1002;                   ! Failed to write a tape mark
         -> ERR
      FINISH 
      EXIT  IF  TM PENDING = YES;       ! End of tape
      TM PENDING = YES
      CONTINUE 
   FINISH 
   TM PENDING = NO;                     ! Not a tape mark
   IF  FLAG # 0 THEN  START 
      FLAG = 1003;                      ! Tape read failure
      -> ERR
   FINISH 
   WRITEMAG(WCHAN,AD,LEN,FLAG)
   IF  FLAG # 0 THEN  START 
      FLAG = 1004;                      ! Tape write failure
      -> ERR
   FINISH 
REPEAT 
!
PRINTSTRING("End of tape".SNL)
PRINTSTRING(ITOS(BLKNO)." blocks (and tape marks) copied from ")
PRINTSTRING(RVOL." to ".WVOL)
IF  COPY LABEL = YES THEN  PRINTSTRING(" (re-labelled as ".RVOL.")")
NEWLINE
!
UNLOADMAG(RCHAN)
UNLOADMAG(WCHAN)
SET RETURN CODE(0)
STOP 
!
ERR:
FAIL(OPNAME(MODE),FLAG,BLKNO)
END ;   ! of DO COPY
!
!
!***********************************************************************
!*
!*          C O P Y T A P E
!*
!***********************************************************************
!
EXTERNALROUTINE  COPYTAPE(STRING (255) PARMS)
DO COPY(PARMS,NORMAL)
END ;   ! of COPYTAPE
!
!
!***********************************************************************
!*
!*          C O P Y N R Z I T A P E
!*
!***********************************************************************
!
EXTERNALROUTINE  COPYNRZITAPE(STRING (255) PARMS)
DO COPY(PARMS,NRZI)
END ;   ! of COPYNRZITAPE
ENDOFFILE