!*********************************************************************** !* !* 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 "TMCOPY","TMNRZITAPE" ! ! !*********************************************************************** !* !* 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 IF TM PENDING = YES THEN START PRINTSTRING("Double tape mark after ".ITOS(BLKNO)." blocks") NEWLINE EXIT IF YES OR NO("Continue") = NO FINISH ELSE 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 TMCOPY(STRING (255) PARMS) DO COPY(PARMS,NORMAL) END ; ! of TMCOPY ! ! !*********************************************************************** !* !* C O P Y N R Z I T A P E !* !*********************************************************************** ! EXTERNALROUTINE TMNRZITAPE(STRING (255) PARMS) DO COPY(PARMS,NRZI) END ; ! of TMNRZITAPE ENDOFFILE