EXTERNALROUTINESPEC  PROMPT(STRING  (15) S)
EXTERNALROUTINESPEC  WRITEMAG(INTEGER  CHAN, AD, LEN,  C 
   INTEGERNAME  FLAG)
EXTERNALROUTINESPEC  READMAG(INTEGER  CHAN, AD,  C 
   INTEGERNAME  LEN, FLAG)
EXTERNALROUTINESPEC  SKIPMAG(INTEGER  CHAN, N)
EXTERNALROUTINESPEC  OPENMAG(INTEGER  CHAN, STRING  (7) VOL)
EXTERNALROUTINESPEC  UNLOADMAG(INTEGER  CHAN)
EXTERNALROUTINESPEC  WRITETMMAG(INTEGER  CHAN, INTEGERNAME  FLAG)

EXTERNALROUTINE  SPECIALCOPY(STRING  (255) S)
CONSTINTEGER  RCHAN = 1
CONSTINTEGER  WCHAN = 2
STRING  (6) RVOL, WVOL
INTEGER  MAXBLOCK, COPYL, BLOCK

   ROUTINE  FAIL(STRING  (255) REASON)
      PRINTSTRING("***FAILURE*** ".REASON); NEWLINE
      PRINTSTRING("BLOCKS COPIED:")
      WRITE(BLOCK,1); NEWLINE
      MONITOR 
      STOP 
   END ;                                !OF FAIL

   ROUTINE  READLINE(STRINGNAME  S)
      S = ""
      WHILE  NEXTSYMBOL = NL OR  NEXTSYMBOL = ' ' C 
         THEN  SKIPSYMBOL
      WHILE  NEXTSYMBOL # NL THEN  S = S.TOSTRING(NEXTSYMBOL) C 
         AND  SKIPSYMBOL
   END ;                                !OF READLINE
   PRINTSTRING("TAPE COPY PROGRAM 10/04/80
")
   PROMPT("INTAPE:")
   READLINE(RVOL) UNTIL  1 <= LENGTH(RVOL) <= 6
   PROMPT("OUTTAPE:")
   READLINE(WVOL) UNTIL  1 <= LENGTH(WVOL) <= 6
   OPENMAG(RCHAN,RVOL."?")
   OPENMAG(WCHAN,WVOL."*")
   PROMPT("MAX BLK.LENGTH:")
   READ(MAXBLOCK)
   PROMPT("COPY LABEL?")
   SKIPSYMBOL UNTIL  NEXTSYMBOL = 'N' OR  NEXTSYMBOL = 'Y'
   READSYMBOL(COPYL)
   UNLESS  80 < MAXBLOCK < 32000 C 
      THEN  FAIL("ILLEGAL MAX BLOCK LENGTH")

   BEGIN 
!NEW BLOCK NEEDED FOR ARRAY DECLN
   BYTEINTEGERARRAY  IN(1 : MAXBLOCK)
   INTEGER  LEN, FLAG, AIN, TM
      !NOW DEAL WITH VOL LABEL
      IF  COPYL = 'N' START 
         SKIPMAG(RCHAN,1);              !SKIP VOL LABEL ON READ TAPE
         SKIPMAG(WCHAN,1);              !SKIP VOL LABEL ON WRITE TAPE
      FINISH 
      TM = 0
      AIN = ADDR(IN(1));                !ADDRESS OF BUFFER
      BLOCK = 0
LOOP:
      LEN = MAXBLOCK
      READMAG(RCHAN,AIN,LEN,FLAG);      !READ A BLOCK
      BLOCK = BLOCK+1
      IF  FLAG = 1 START ;              !TAPE MARK 
         WRITETMMAG(WCHAN,FLAG)
         IF  FLAG # 0 THEN  FAIL("FAILURE IN WRITE TAPE MARK")
         IF  TM = 1 THEN  -> ENDOFTAPE
         TM = 1
         -> LOOP
      FINISH 
      IF  FLAG # 0 THEN  FAIL("READ FAILURE")
      WRITEMAG(WCHAN,AIN,LEN,FLAG)
      TM = 0;                           !NOT A TAPE MARK
      IF  FLAG # 0 THEN  FAIL("FAILURE TO WRITE")
      -> LOOP
ENDOFTAPE:

      PRINTSTRING("END OF TAPE
")
      WRITE(BLOCK,1)
      PRINTSTRING(" BLOCKS (AND TAPE MARKS) COPIED FROM ")
      PRINTSTRING(RVOL." TO ".WVOL)
      IF  COPYL = 'Y' THEN  PRINTSTRING("(RE-LABELLED AS ". C 
         RVOL.")")
      UNLOADMAG(RCHAN)
      UNLOADMAG(WCHAN)
   END 
END ;                                   !OF SPECIALCOPY
ENDOFFILE