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