kb~ TCOPY.BAK&K TCOPY.BAK\BACKUP/NOASSIST/IGNORE=LABEL_PROCESSING SDK:[LOCAL.UTIL.MISCSRC.TCOPY]*.* TCOPY.BAK/SAVE_SET FITZ  (l|V5.5 _DRACO::  _$1$DUA6: V5.5 ~  '*[LOCAL.UTIL.MISCSRC.TCOPY]BACKOUT.FOR;1+,!./A 4P(-!0123KPWO56DJ@7M˝8΄ɖ95 GAHJc BACKOUT -- backup output tape one file and write an eof c (i.e., eov last complete file). c c Usage c call backout (ibackerr) c ibackerr = 0 - successful c ibackerr = non-zero - unsuccessful, eof not written c c Subroutines and function subprograms required c terror - prints out error messages c c Author c Ed Anderson, NOAO (CCS), Sep. 1987. c c Comments c all other variables passed via common subroutine backout (ibackerr) integer ibackerr include 'tcopy.par' ! backup to start of current file iskipout = -1 istat = sys$qiow (, %val(chanout), %val(io$_skipfile), + qiosb, , , %val(iskipout), , , , ,) if (istat .ne. ss$_normal) goto 1 istat = sys$qiow (, %val(chanout), %val(io$_readlblk), + qiosb, , , %ref(ostring), %val(iopmax), , , ,) if (istat .ne. ss$_normal) goto 1 if (qiosb.status .ne. ss$_endoffile) goto 2 ! write eof istat = sys$qiow (, %val(chanout), %val(io$_writeof), + qiosb, , , , , , , ,) if (istat .ne. ss$_normal) goto 1 if (qiosb.status .ne. ss$_normal) goto 2 ibackerr = 0 eovout = .true. return 1 ibackerr = istat return 2 ibackerr = qiosb.status return end '*[LOCAL.UTIL.MISCSRC.TCOPY]CLEANUP.FOR;1+,!./A 4P!-!0123KPWO56@7 ˝8W$τɖ95 GAHJc CLEANUP -- rewind and dismount tapes, deassign channels and event flags c c Usage c call cleanup c c Subroutines and function subprograms required c terror - prints out error messages. c c Author: c Ed Anderson, NOAO (CCS), Sep. 1987. c c Comments c all variables passed via common c c Although it is not necessary to do the rewinds as separate c commands (the dismount will rewind the tapes), the method c used below allows for asynchronous rewind and hence the c cleanup will proceed much faster. subroutine cleanup include 'tcopy.par' ! rewind istat = sys$qio (%val(evf1), %val(chanin), %val(io$_rewind), + qiosbi, , , , , , , ,) if (istat .ne. ss$_normal) call terror (54, istat, 2) istat = sys$qio (%val(evf2), %val(chanout), %val(io$_rewind), + qiosbo, , , , , , , ,) if (istat .ne. ss$_normal) call terror (55, istat, 2) ! rewind ok? istat = sys$waitfr (%val(evf1)) if (istat .ne. ss$_normal) call terror (56, istat, 2) istat = sys$waitfr (%val(evf2)) if (istat .ne. ss$_normal) call terror (57, istat, 2) if (qiosbi.status .ne. ss$_normal) call terror (58, istat, 2) if (qiosbo.status .ne. ss$_normal) call terror (59, istat, 2) ! dismount/nounload istat = sys$dismou (devin, %val(dmt$m_nounload)) if (istat .ne. ss$_normal) call terror (60, istat, 1) istat = sys$dismou (devout, %val(dmt$m_nounload)) if (istat .ne. ss$_normal) call terror (61, istat, 1) ! deassign channels istat = sys$dassgn (%val(chanin)) if (istat .ne. ss$_normal) call terror (62, istat, 1) istat = sys$dassgn (%val(chanout)) if (istat .ne. ss$_normal) call terror (63, istat, 1) return end (*[LOCAL.UTIL.MISCSRC.TCOPY]COPY_ELM.FOR;1+,!./A 4P -!0123KPWO5 6R@7@˝8^~τɖ95 GAHJ"c COPY_ELM -- perform the asynchronous file copy c c Usage c call copy_elm(icopystat) c c where icopystat - status of copy (returned) c 0 => normal completion of file copy c 1 => eov of input, start verification c 2 => eot on output, start verification c c Subroutines and function subprograms required c terror - prints out error messages c backout - eov last complete file c c Author c Ed Anderson, NOAO (CCS), Sep. 1987. c c Comments c major variables passed via common subroutine copy_elm (icopystat) integer ibackerr include 'tcopy.par' do i = ifbeg, ifend irec = 0 irecb = 0 ipos = 1 print '(/'' Copying file '', i4, + '' from input tape to file '', i4, + '' of output tape.'')', i, otpos ! read a block 1 istat = sys$qiow (, %val(chanin), %val(io$_readlblk), + qiosbi, , , block(1,ipos), %val(iopmax), , , ,) if (istat .ne. ss$_normal) call terror (16, istat, 2) ! determine blocksize icount = qiosbi.count if (icount .lt. 0) icount = icount + 65536 ! input status check normal if (qiosbi.status .ne. ss$_normal) then ! input eof found if (qiosbi.status .eq. ss$_endoffile) then istat = sys$waitfr (%val(evf2)) if (istat .ne. ss$_normal) call terror (17, istat, 2) ! write eof on output istat = sys$qiow (,%val(chanout), %val(io$_writeof), + qiosb, , , , , , , ,) if (istat .ne. ss$_normal) call terror (18, istat, 2) if (qiosb.status .ne. ss$_normal) + call terror (19, istat, 2) itpos = itpos + 1 otpos = otpos + 1 ! input eov found if (irec .eq. 0) then print '('' ** EOV detected on input tape **'',/)' icopystat = 1 eovout = .true. if (.not. doverify) then ! position the tape between the two tapemarks iskipout = -1 istat = sys$qiow (, %val(chanout), + %val(io$_skipfile), qiosb, , , + %val(iskipout), , , , ,) if (istat .ne. ss$_normal) + call terror (23, istat, 2) otpos = otpos - 1 endif return endif print '('' records '', i4, '' thru '', i4, + '' copied at a blocksize of '', i5)', + irecb+1, irec, iopar goto 3 ! read error on first record else if (irec .eq. 0) then print '(/1x, 4a1, + ''** ERROR reading first record of '', + ''file'', i5, '' of input tape **'', /6x, + ''this is probably due to the absence of a '', + ''double-EOF at the end of the tape.'', + //10x, + ''User options:'', /12x, + ''1) Assume EOV on input tape and continue'',/12x, + ''2) Quit (will EOV the output tape first)'', + //10x, + ''Please enter number for desired option: '', $)', + bell, bell, bell, bell, itpos accept *, ioption print '(/1x, '' ** Writing EOV on output tape **'')' istat = sys$qiow (, %val(chanout), %val(io$_writeof), + qiosb, , , , , , , ,) if (istat .ne. ss$_normal) call terror (20, istat, 2) if (qiosb.status .ne. ss$_normal) + call terror (21, istat, 2) if (ioption .eq. 1) then icopystat = 1 return else stop 'User requested STOP' endif else if (qiosbi.count .eq. 0) then print '(/'' *** WARNING: zero length record '', + ''encountered on input tape...will ignore it'')' goto 1 ! read error in middle of file else call terror (22, istat, 2) endif else if ((qiosbi.count .lt. 14) .and. + (qiosbi.count .gt. 0)) then print '(/'' *** WARNING: short record encountered on '', + ''input tape...will pad with zeros'')' do izero = qiosbi.count+1, 14 block(izero,ipos) = 0 enddo icount = 14 endif ! successful read, increment record count irec = irec + 1 ! block size changed? if ((irec .gt. 1) .and. (iopar .ne. icount)) then print '('' records '', i5, '' thru '', i5, + '' copied at a blocksize of '', i5)', + irecb+1, irec-1, iopar irecb = irec - 1 endif ! define output blocksize iopar = icount if (irec .gt. 1) then ! is previous block done? istat = sys$waitfr (%val(evf2)) if (istat .ne. ss$_normal) call terror (17, istat, 2) ! What is the status of the previous write? if (qiosbo.status .ne. ss$_normal) then ! eot encountered if (qiosbo.status .eq. ss$_endoftape) then print '(/1x, 4a1, + ''** EOT encountered on output tape **'', + /5x, '' writing EOV and end of last '', + ''complete file!'')', bell, bell, bell, bell endotape = .true. cbeg = ifbeg cend = ifend ! backup and eof call backout (ibackerr) if (ibackerr .ne. 0) call terror (23, ibackerr, 2) otpos = otpos + 1 ! set up wlist to verify copies done so far epos = 0 do j = 1, ielem-1 epos = str$position (flist, ',', epos+1) enddo istat = str$left (wlist, flist, epos) if (istat .ne. str$_normal) + call terror(24,istat,1) write (wlist, '(a, i5.5, ''-'', i5.5)') + wlist(1:epos), cbeg, itpos-1 if (doverify) then print '(/1x, a1, + '' Commencing verification of current '', + ''output tape.'', /5x, + ''input files copied: '', a)', bell, + wlist(1:epos+11) else print '(/1x, a1, + '' Copy finished for current '', + ''output tape.'', /5x, + ''input files copied: '', a)', bell, + wlist(1:epos+11) endif icopystat = 2 return else call terror (25, istat, 2) return endif endif endif istat = sys$qio (%val(evf2), %val(chanout), + %val(io$_writelblk), qiosbo, , , block(1,ipos), + %val(iopar), , , ,) if (istat .ne. ss$_normal) call terror (26, istat, 2) ! flip block position indicator if (ipos .eq. 1) then ipos = 2 else ipos = 1 endif goto 1 3 enddo icopystat = 0 return end '*[LOCAL.UTIL.MISCSRC.TCOPY]GETUSER.FOR;1+,!./A 4P-!0123KPWO5 6@Wu@7`K˝82τɖ95 GAHJc GETUSER -- query user of tcopy for nesessary tape and file data c c Usage c call getuser c c Subroutine and function subprograms required c terror - print out error messages c c Author c Ed Anderson, NOAO (CCS), Sep. 1987. c c Comments c everything is passed via common subroutine getuser include 'tcopy.par' print '(/'' Please enter input tape drive (e.g., MUA0:): '', $)' accept '(a)', devin print '('' Please enter output tape drive (e.g., MUA1:): '', $)' accept '(a)', devout print '('' Output tape density? (800/1600/6250): '', $)' accept *, outden ! add `:' if needed if (devin(5:5) .ne. ':') devin(5:5) = ':' if (devout(5:5) .ne. ':') devout(5:5) = ':' print '('' Is the output tape a new tape? (y/n): '', $)' accept '(a)', ans newtape = (ans .eq. 'Y') .or. (ans .eq. 'y') if (newtape) then otbeg = 1 else print '(12x, ''Begin writing at file (0 ==> EOV): '', $)' accept *, otbeg endif 1 print '('' File list to be copied? (0 ==> whole tape): '', $)' accept '(a)', flist c make a working copy of flist istat = str$trim (wlist, flist, len_wlist) if (istat .ne. str$_normal) call terror (1, istat, 2) do i = 1, len_wlist if (.not. (((wlist(i:i).ge.'0') .and. (wlist(i:i).le.'9')) + .or. (wlist(i:i).eq.'-') .or. (wlist(i:i).eq.','))) then print '(a1,'' **** ERROR: invalid input list'')', bell goto 1 endif enddo print '('' Do you want to verify the output copy? (y/n): '', $)' accept '(a)', ans doverify = (ans .eq. 'Y') .or. (ans .eq. 'y') return end **[LOCAL.UTIL.MISCSRC.TCOPY]INTAPE_POS.FOR;1+,!./A 4P)-!0123KPWO56@@7˝8hXτɖ95 GAHJc INTAPE_POS -- position the input tape for copy or verify by parsing the c appropriate element of the user provide file list c c Usage c call intape_pos c c Subroutines and function subprograms required c terror - prints out error messages c c Author c Ed Anderson, NOAO (CCS), Sep. 1987. c c Comments c all variables passed via common subroutine intape_pos include 'tcopy.par' ! find element position cpos = index (wlist, ',') ielem = ielem + 1 ! extract element if (cpos .eq. 0) then elem = wlist nextelm = .false. else istat = str$left (elem, wlist, cpos-1) if (istat .ne. str$_normal) call terror (12, istat, 2) endif ! trim string if (nextelm) then istat = str$len_extr (wlist, wlist, cpos+1, len_wlist) if (istat .ne. str$_normal) call terror (13, istat, 2) endif ! extract file range hpos = index (elem, '-') if (hpos .eq. 0) then read (elem,*) ifbeg ifend = ifbeg else read (elem(:hpos-1), *) ifbeg read (elem(hpos+1:), *) ifend endif ! whole tape copy setup if (ifbeg .eq. 0) then ifbeg = 1 ifend = 32766 endif ! starting input position if (frstelm) then itbeg = ifbeg frstelm = .false. endif ! position input tape if (ifbeg .ne. itpos) then iopar = ifbeg - itpos istat = sys$qiow (, %val(chanin), %val(io$_skipfile), + qiosb, , , %val(iopar), , , , ,) if (istat .ne. ss$_normal) call terror (14, istat, 2) if (qiosb.status .ne. ss$_normal) call terror (15, istat, 2) itpos = ifbeg endif return end )*[LOCAL.UTIL.MISCSRC.TCOPY]NEXT_TAPE.FOR;1+,!. /A 4P -!0123KPWO 56 $@7˝8D)Єɖ95 GAHJc NEXT_TAPE -- mount next input or output tape c c Usage c call next_tape c c Subroutines and function subprograms required c terror - prints out error messages c c Author c Ed Anderson, NOAO (CCS), Sep. 1987. c c Comments c all variables passed via common subroutine next_tape include 'tcopy.par' ! new output tape if (endotape) then if (doverify) then print '(//1x, 3a1, ''Verification complete.'', /, + ''Do you wish to mount another output tape? (y/n): '', + $)', bell, bell, bell else print '(//1x, 3a1, ''Copy complete.'', /, + ''Do you wish to mount another output tape? (y/n): '', + $)', bell, bell, bell endif accept '(a)', ans if ((ans .eq. 'y') .or. (ans .eq. 'y')) then istat = sys$dismou (devout,) if (istat .ne. ss$_normal) call terror (46, istat, 1) 1 print '(6x, + ''Please mount next tape, type y when ready: '', $)' accept '(a)', ans if (.not. ((ans .eq. 'y') .or. (ans .eq. 'y'))) goto 1 !mount output tape istat = sys$mount (omnt_itm) if (istat .ne. ss$_normal) call terror (47, istat, 2) epos = str$position (flist, ',', epos+1) istat = str$right (wlist, flist, epos) if (istat .ne. str$_normal) call terror (48, istat, 1) write (wlist, '(i5,''-'',i5,a)') + itpos, cend, wlist(1:len_wlist) print '('' Copying remaining files: '',a)', wlist if (doverify) then print '(7x''Do you want to continue to verify?'', + '' (y/n): '', $)' else print '(10x''Do you want to start to verify?'', + '' (y/n): '', $)' endif accept '(a)', ans doverify = (ans .eq. 'Y') .or. (ans .eq. 'y') flist = wlist nextelm = .true. ielem = 0 verify = .false. endotape = .false. otpos = 1 otbeg = 1 itbeg = itpos nexttape = .true. eovout = .false. return else nexttape = .false. return endif ! new input tape else if (doverify) then print '(//, 1x, 3a1, ''Verification complete.'', /, + '' Do you wish to mount another input tape? (y/n): '', + $)', bell, bell, bell else print '(//, 1x, 3a1, ''Copy complete.'', /, + '' Do you wish to mount another input tape? (y/n): '', + $)', bell, bell, bell endif accept '(a)', ans if ((ans .eq. 'y') .or. (ans .eq. 'y')) then istat = sys$dismou (devin,) if (istat .ne. ss$_normal) call terror (49, istat, 1) 2 print '(6x, + ''Please mount next tape, type y when ready: '', $)' accept '(a)', ans if (.not. ((ans .eq. 'y') .or. (ans .eq. 'y'))) goto 2 !mount input unit istat = sys$mount (imnt_itm) if (istat .ne. ss$_normal) call terror (50, istat, 2) print '('' File list to be copied? '', + ''(0 ==> whole tape): '', $)' accept '(a)', flist if (doverify) then print '(7x''Do you want to continue to verify?'', + '' (y/n): '', $)' else print '(10x''Do you want to start to verify?'', + '' (y/n): '', $)' endif accept '(a)', ans doverify = (ans .eq. 'Y') .or. (ans .eq. 'y') frstelm = .true. nextelm = .true. ielem = 0 ! make copy of new flist istat = str$trim (wlist, flist, len_wlist) if (istat .ne. str$_normal) call terror (51, istat, 1) verify = .false. otbeg = otpos itpos = 1 nexttape = .true. return ! eov output tape else istat = sys$qiow (, %val(chanout), %val(io$_writeof), + iosb, , , , , , , ,) if (istat .ne. ss$_normal) call terror (52, istat, 2) if (qiosb.status .ne. ss$_normal) + call terror (53, istat, 2) nexttape = .false. endif endif return end %*[LOCAL.UTIL.MISCSRC.TCOPY]TCOPY.COM;1+,!./A 4=-!0123KPWO5 6 Aߑ7 ˝8uoЄɖ95 GAHJ9$ FOR TCOPY,GETUSER,TSETUP,INTAPE_POS,COPY_ELM,VSETUP, -2 VERIFY_ELM,NEXT_TAPE,CLEANUP,BACKOUT,TERROR9$ LINK TCOPY,GETUSER,TSETUP,INTAPE_POS,COPY_ELM,VSETUP, -2 VERIFY_ELM,NEXT_TAPE,CLEANUP,BACKOUT,TERROR$ DELETE/NOCONFIRM *.OBJ;* $ PURGE *.*!$ SET PROT=O:RWED [--]TCOPY.EXE;*$ DELETE [--]TCOPY.EXE;* $ RENAME TCOPY.EXE [--]TCOPY.EXE$ EXEPROT [--]TCOPY.EXE$$ WRITE SYS$OUTPUT "TCOPY INSTALLED"$ EXIT%*[LOCAL.UTIL.MISCSRC.TCOPY]TCOPY.FOR;1+,!./A 4P-!0123KPWO56@7.˝8hGЄɖ95 GAHJ c TCOPY -- A general purpose tape-to-tape copying program with features: c c 1.) copy and verify multiple volumes into one volume c 2.) recognize eot and skip back to end of last file and write eof c 3.) uses asynchronous qio c c Author: Ed Anderson, September 1986 c National Optical Astronomy Observatories c P.O. Box 26732 c Tucson, AZ 85726 c c Modifications and bug fixes: c Jan 1987: allow specification of output tape density. c Jun 1987: pad short input records with zeros to 14 characters. c blocksize. required for cyber fts archive tapes. c Jun 1987: ignore zero-length input blocks. c mountain t-tape problem due to gap errors. c Jun 1987: will assume eov on input tape when read error occurs c in the first record of a file (i.e., assume that c tape does not have double-eof). c Sep 1987: increase maximum blocksize to 65535. c Sep 1987: rewritten into subroutine modular form. c enhanced error trapping. c Jul 1990: made copy verification optional (Rob Seaman) c reformatted for readability program tcopy include 'tcopy.par/list' character*80 intro_line bell = char(7) ielem = 0 iopmax = 65535 skpmax = 32767 newtape = .false. nextelm = .true. frstelm = .true. doverify = .true. verify = .false. endotape = .false. eovout = .false. open (unit=1, file='sdk:[local.util.miscsrc.tcopy]tintro.txt', + type='old', readonly) 1 read (1, '(a)', end=2) intro_line print '(1x, a)', intro_line goto 1 2 call getuser c set up initial tape configuration c (event flags, tape channels, mounts, position output tape) call tsetup 3 call intape_pos if (.not. verify) then ! copy call copy_elm (icopystat) if ((.not. nextelm) .or. (icopystat .gt. 0)) + call vsetup (icopystat) goto 3 else ! verify call verify_elm if (nextelm) goto 3 call next_tape if (nexttape) goto 3 endif call cleanup stop 'TCOPY finished ok' end %*[LOCAL.UTIL.MISCSRC.TCOPY]TCOPY.PAR;2+,Z0Z. /A 4P -!0123KPWO 56 ft7E8фɖ95 GAHJb~ TCOPY.BAKZ0Z!%[LOCAL.UTIL.MISCSRC.TCOPY]TCOPY.PAR;2P k1 include '($dmtdef)' include '($iodef)' include '($mntdef)' include '($ssdef)' include '($syssrvnam)' integer*4 chanin, ! input tape channel + chanout, ! output tape channel + iopar, ! qio parameter (record size or number of files) + iopmax, ! maximum block size = 65535 + skpmax, ! maximum files that can be skipped = 32767 + imntflags, ! bit longword for sys$mount flags (input tape) + omntflags, ! bit longword for sys$mount flags (output tape) + outden, ! density of output tape + istat, ! status return from system service calls + evf1, ! event flag for asynchronous qio tape read + evf2, ! event flag for asynchronous qio tape write + len_wlist, ! lenght of wlist character string + cpos, ! position of a comma in flist + hpos, ! position of a hyphen in elem + str$position, ! rtl fuction to locate substrings + epos, ! result of str$position + icount ! returned blocksize if 0 <= 65535 integer*2 itpos, ! input tape position + otpos, ! output tape position + itbeg, ! starting input file to be copied + otbeg, ! starting output tape position + ifbeg, ! starting input position from elem + ifend, ! ending input position from elem + irec, ! number of records read/written + ielem, ! current element number in flist + cbeg, ! current value of ifbeg (if endotape) + cend, ! current value of ifend (if endotape) + otpmax ! maximum advance of output tape byte block(65535,2) ! buffer for asynchronous qio read/writes character devin*7, ! input tape unit name + devout*7, ! output tape unit name + flist*80, ! list of files from input tape to be copied + wlist*80, ! work string (initially = flist) + elem*11, ! single element from flist + ans*1, ! dummy variable for (y/n) answers + bell*1, ! escape sequence for terminal bell + istring*65535, ! character string used for verification pass + ostring*65535 ! character string used for verification pass logical newtape, ! copy to output at beginning or eov + nextelm, ! flag to indicate elements remaining in wlist + frstelm, ! flag to indicate first element of wlist + doverify, ! do the verification pass? + verify, ! flag to indicate verify mode + endotape, ! flag to indicate eot detection on output tape + nexttape, ! flag to indicate next in/output tape mounted + eovout ! flag to indicate eov written on output tape structure /item_str/ ! system service item list structure union map integer*2 buflen, ! item buffer length (=4) + itmcod ! item code integer*4 bufadr, ! buffer address + retlen ! returned buffer length (=0) end map map integer*4 endlist ! end of item list (=0) end map end union end structure structure /iosb/ ! qio status block structure integer*2 status ! condition value integer*2 count ! file or block count integer*4 ddd ! device dependent data end structure record /item_str/ imnt_itm(3), ! input tape item code for sys$mount + omnt_itm(4) ! output tape item code for sys$mount record /iosb/ qiosb, ! status block structures for sys$qiow + qiosbi, ! input tape status block for sys$qio + qiosbo ! output tape status block for sys$qio common /tcopypar/chanin,chanout,iopar,iopmax,skpmax,imntflags, + omntflags,outden,istat,evf1,evf2,len_wlist,cpos, + hpos,epos,icount,itpos,otpos,itbeg, + otbeg,ifbeg,ifend,irec,ielem,cbeg,cend,otpmax,  + block,devin,devout,flist,wlist,elem,ans,bell, + istring,ostring,newtape,nextelm,frstelm,verify, + doverify,endotape,nexttape,eovout,imnt_itm, + omnt_itm,qiosb,qiosbi,qiosbo &*[LOCAL.UTIL.MISCSRC.TCOPY]TERROR.FOR;1+,!.0/A 4P00-!0123KPWO15 6G7˝8фɖ95 GAHJ`C SUBROUTINE TERRORC C PURPOSE/C To print out error messages from TCOPYC C USAGE)C CALL TERROR(ERCODE, STATUS, SEV)C ERCODE - ERROR CODE/C STATUS - SYSTEM SERVICE STATUS CODE&C SEV - SEVERITY OF ERRORDC SEV = 1 => CALL LIB$SIGNAL AND ATTEMPT RECOVERY-C SEV = 2 => CALL LIB$STOPC3C SUBROUTINES AND FUNCTION SUBPROGRAMS REQUIRED C NONEC6C AUTHOR: Ed Anderson, NOAO, CCS, September, 1987CC COMMENTS)C MOST VARIABLES PASSED VIA COMMONC, SUBROUTINE TERROR(ERCODE, STATUS, SEV) INTEGER*2 ERCODE, SEV INTEGER*4 STATUS logical signal_both INCLUDE 'TCOPY.PAR'D ! this allows an unknown verification error to dump the status; ! of the tape reads before bailing out of the program signal_both = .false.E GOTO (1,2,3,4,5,6,7,8,9,10,11,12,13,14,15,16,17,18,19,20,21,22,E + 23,24,25,26,27,28,29,30,31,32,33,34,35,36,37,38,39,40,41,E + 42,43,44,45,46,47,48,49,50,51,52,53,54,55,56,57,58,59,60, + 61,62,63),ERCODECPC..................................................ERROR FROM SUBROUTINE GETUSER 1 PRINT 101, BELL,BELL,BELLD 101 FORMAT (3A1,' **** ERROR: HANDLING FILE LIST (STR$TRIM) ****',< + /14X,'System error due to unknown reason ... ',- + 'No copying has been done yet!',G + /14X,'Please try TCOPY again ... if error persists seek ', + 'help.') GOTO 1000CPC..................................................ERRORS FROM SUBROUTINE TSETUP 2 PRINT 102, BELL,BELL,BELLE 102 FORMAT (3A1,' **** ERROR: UNABLE TO GET FIRST EVENT FLAG ****',< + /14X,'System error due to unknown reason ... ',- + 'No copying has been done yet!',G + /14X,'Please try TCOPY again ... if error persists seek ', + 'help.') GOTO 1000 3 PRINT 103, BELL,BELL,BELLF 103 FORMAT (3A1,' **** ERROR: UNABLE TO GET SECOND EVENT FLAG ****',< + /14X,'System error due to unknown reason ... ',- + 'No copying has been done yet!',G + /14X,'Please try TCOPY again ... if error persists seek ', + 'help.') GOTO 1000 4 PRINT 104, BELL,BELL,BELLA 104 FORMAT (3A1,' **** ERROR: UNABLE TO MOUNT INPUT TAPE ****',0 + /14X,' - Be sure drive is on line',E + /14X,' - If drive is a Kennedy, be sure density is set',? + ' correctly.',/14X,' - Be sure write ring is OUT',G + /14X,'Please try TCOPY again ... if error persists seek ', + 'help.') GOTO 1000 5 PRINT 105, BELL,BELL,BELLB 105 FORMAT (3A1,' **** ERROR: UNABLE TO MOUNT OUTPUT TAPE ****',0 + /14X,' - Be sure drive is on line',E + /14X,' - If drive is a Kennedy, be sure density is set',> + ' correctly.',/14X,' - Be sure write ring is IN',F + /14X,'DISMOUNT/NOUNLOAD input unit and try TCOPY again.',2 + /14X,'If error persists, seek help.') GOTO 1000 6 PRINT 106, BELL,BELL,BELLE 106 FORMAT (3A1,' **** ERROR: UNABLE TO ASSIGN INPUT CHANNEL ****',< + /14X,'System error due to unknown reason ... ',- + 'No copying has been done yet!',E + /14X,'DISMOUNT/NOUNLOAD both tape units and try again.',2 + /14X,'If error persists, seek help.') GOTO 1000 7 PRINT 107, BELL,BELL,BELLF 107 FORMAT (3A1,' **** ERROR: UNABLE TO ASSIGN OUTPUT CHANNEL ****',< + /14X,'System error due to unknown reason ... ',- + 'No copying has been done yet!',E + /14X,'DISMOUNT/NOUNLOAD both tape units and try again.',2 + /14X,'If error persists, seek help.') GOTO 1000 8 PRINT 108, BELL,BELL,BELLE 108 FORMAT (3A1,' **** ERROR: QIO SKIP-EOV ON OUTPUT REQUEST ****',< + /14X,'System error due to unknown reason ... ',+ + 'Unable to move output tape!',2 + /14X,'No copying has been done yet!',E + /14X,'DISMOUNT/NOUNLOAD both tape units and try again.',2 + /14X,'If error persists, seek help.') GOTO 1000 9 PRINT 109, BELL,BELL,BELLE 109 FORMAT (3A1,' **** ERROR: CANNOT FIND EOV OF OUTPUT TAPE ****',F + /14X,'Probably due to a lack of a Double-EOF at the end',B + ' of the data.',//14X,'DISMOUNT/NOUNLOAD both tape ',E + 'units and try again but this time ',/14X,'tell TCOPY ',0 + 'to start writing at file N where',5 + /20X,'N = number of files on tape + 1.',E + //14X,'Use TAP to determine number of files on tape if',. + /14X,' you don''t already know.') GOTO 1000 10 PRINT 110, BELL,BELL,BELLF 110 FORMAT (3A1,' **** ERROR: QIO SKIP-FILE ON OUTPUT REQUEST ****',< + /14X,'System error due to unknown reason ... ',+ + 'Unable to move output tape!',2 + /14X,'No copying has been done yet!',E + /14X,'DISMOUNT/NOUNLOAD both tape units and try again.',2 + /14X,'If error persists, seek help.') GOTO 1000 11 PRINT 111, BELL,BELL,BELLD 111 FORMAT (3A1,' **** ERROR: SKIPPING FILES ON OUTPUT TAPE ****',< + /14X,'System error due to unknown reason ... ',= + 'TCOPY has lost track of output tape position!',2 + /14X,'No copying has been done yet!',A + /14X,'DISMOUNT/NOUNLOAD both tape units and clean ',A + 'heads on OUTPUT tape unit.',/14X,'Try TCOPY again',2 + ' ... if error persists, seek help.') GOTO 1000CPC..............................................ERRORS FROM SUBROUTINE INTAPE_POS 12 PRINT 112, BELL,BELL,BELLD 112 FORMAT (3A1,' **** ERROR: HANDLING FILE LIST (STR$LEFT) ****',9 + /14X,'System error due to unknown reason.') GOTO 990+ 13 PRINT 113, BELL,BELL,BELL,ITPOS,OTPOSH 113 FORMAT (3A1,' **** ERROR: HANDLING FILE LIST (STR$LEN_EXTR) ****',9 + /14X,'System error due to unknown reason.',> + //14X,'File list in memory probably corrupted:',C + /20X,'Input tape positioned at beginning of file',I6,D + /20X,'Output tape positioned at beginning of file',I6) WLIST = '?????' GOTO 990 14 PRINT 114, BELL,BELL,BELLE 114 FORMAT (3A1,' **** ERROR: QIO REQUEST SKIP-FILE ON INPUT ****',D + /14X,'System error due to unknown reason. Unable to ',! + 'move input tape.') GOTO 990% 15 PRINT 115, BELL,BELL,BELL,OTPOSC 115 FORMAT (3A1,' **** ERROR: SKIPPING FILES ON INPUT TAPE ****',C + /14X,'System error due to unknown reason. TCOPY no ',= + 'longer knows where input tape is positioned.',D + /20X,'Output tape positioned at beginning of file',I6,D + /21X,'Suggest that you clean input tape drive heads!') GOTO 990CPC................................................ERRORS FROM SUBROUTINE COPY_ELM 16 PRINT 116, BELL,BELL,BELLC 116 FORMAT (3A1,' **** ERROR: QIOW READ INPUT TAPE REQUEST ****',8 + /14X,'System error due to unknown reason') GOTO 991% 17 PRINT 117, BELL,BELL,BELL,OTBEG7 117 FORMAT (3A1,' **** ERROR: WAITING FOR EVF2 ****',8 + /14X,'System error due to unknown reason') GOTO 992 18 PRINT 118, BELL,BELL,BELL= 118 FORMAT (3A1,' **** ERROR: QIOW WRITE EOF REQUEST ****',8 + /14X,'System error due to unknown reason') GOTO 992 19 PRINT 119, BELL,BELL,BELLA 119 FORMAT (3A1,' **** ERROR: WRITING EOF ON OUTPUT TAPE ****') GOTO 992 20 PRINT 120, BELL,BELL,BELL= 120 FORMAT (3A1,' **** ERROR: QIOW WRITE EOV REQUEST ****',8 + /14X,'System error due to unknown reason') GOTO 992 21 PRINT 121, BELL,BELL,BELL< 121 FORMAT (3A1,' **** ERROR: WRITING EOV ON OUTPUT TAPE') GOTO 992 22 PRINT 122, BELL,BELL,BELLE 122 FORMAT (3A1,' **** ERROR: UNRECOVERABLE (to TCOPY) READ ERROR') GOTO 991 23 PRINT 123, BELL,BELL,BELLG 123 FORMAT (3A1,' **** ERROR: UNABLE TO EOV OUTPUT AT LAST COMPLETE', + ' FILE ****') GOTO 992+ 24 PRINT 124, BELL,BELL,BELL,OTPOS,ITPOSD 124 FORMAT (3A1,' **** ERROR: HANDLING FILE LIST (STR$LEFT) ****',9 + /14X,'System error due to unknown reason!') GOTO 991 25 PRINT 125, BELL,BELL,BELL: 125 FORMAT (3A1,' **** ERROR: WRITING OUTPUT TAPE ****') GOTO 992 26 PRINT 126, BELL,BELL,BELL8 126 FORMAT (3A1,' **** ERROR: QIO WRITE REQUEST ****',8 + /14X,'System error due to unknown reason') GOTO 992CPC..................................................ERRORS FROM SUBROUTINE VSETUP 27 PRINT 127, BELL,BELL,BELLD 127 FORMAT (3A1,' **** ERROR: HANDLING FILE LIST (STR$TRIM) ****',8 + /14X,'System error due to unknown reason') GOTO 994 28 PRINT 128, BELL,BELL,BELL? 128 FORMAT (3A1,' **** ERROR: QIO REWIND INPUT REQUEST ****',8 + /14X,'System error due to unknown reason') GOTO 994 29 PRINT 129, BELL,BELL,BELL? 129 FORMAT (3A1,' **** ERROR: QIO BACKUP INPUT REQUEST ****',8 + /14X,'System error due to unknown reason') GOTO 994 30 PRINT 130, BELL,BELL,BELL@ 130 FORMAT (3A1,' **** ERROR: QIO REWIND OUTPUT REQUEST ****',8 + /14X,'System error due to unknown reason') GOTO 994 31 PRINT 131, BELL,BELL,BELL@ 131 FORMAT (3A1,' **** ERROR: QIO REWIND OUTPUT REQUEST ****',8 + /14X,'System error due to unknown reason') GOTO 994 32 PRINT 132, BELL,BELL,BELLD 132 FORMAT (3A1,' **** ERROR: WAITING FOR EVENT FLAG (EVF1) ****',8 + /14X,'System error due to unknown reason') GOTO 994 33 PRINT 133, BELL,BELL,BELLD 133 FORMAT (3A1,' **** ERROR: WAITING FOR EVENT FLAG (EVF2) ****',8 + /14X,'System error due to unknown reason') GOTO 994 34 PRINT 134, BELL,BELL,BELLB 134 FORMAT (3A1,' **** ERROR: REWIND/BACKUP OF INPUT TAPE ****',8 + /14X,'System error due to unknown reason') GOTO 994 35 PRINT 135, BELL,BELL,BELLC 135 FORMAT (3A1,' **** ERROR: REWIND/BACKUP OF OUTPUT TAPE ****',8 + /14X,'System error due to unknown reason') GOTO 994 36 PRINT 136, BELL,BELL,BELLB 136 FORMAT (3A1,' **** ERROR: INPUT SKIPFILE_MARK REQUEST ****',8 + /14X,'System error due to unknown reason') GOTO 994 37 PRINT 137, BELL,BELL,BELL= 137 FORMAT (3A1,' **** ERROR: POSITIONING INPUT TAPE ****',8 + /14X,'System error due to unknown reason') GOTO 994 38 PRINT 138, BELL,BELL,BELLC 138 FORMAT (3A1,' **** ERROR: OUTPUT SKIPFILE_MARK REQUEST ****',8 + /14X,'System error due to unknown reason') GOTO 994 39 PRINT 139, BELL,BELL,BELL> 139 FORMAT (3A1,' **** ERROR: POSITIONING OUTPUT TAPE ****',8 + /14X,'System error due to unknown reason') GOTO 994CPC..............................................ERRORS FROM SUBROUTINE VERIFY_ELM 40 PRINT 140, BELL,BELL,BELL= 140 FORMAT (3A1,' **** ERROR: QIO READ INPUT REQUEST ****',8 + /14X,'System error due to unknown reason') GOTO 995 41 PRINT 141, BELL,BELL,BELL> 141 FORMAT (3A1,' **** ERROR: QIO READ OUTPUT REQUEST ****',8 + /14X,'System error due to unknown reason') GOTO 995 42 PRINT 142, BELL,BELL,BELLD 142 FORMAT (3A1,' **** ERROR: WAITING FOR EVENT FLAG (EVF1) ****',8 + /14X,'System error due to unknown reason') GOTO 995 43 PRINT 143, BELL,BELL,BELLD 143 FORMAT (3A1,' **** ERROR: WAITING FOR EVENT FLAG (EVF2) ****',8 + /14X,'System error due to unknown reason') GOTO 995 44 PRINT 144, BELL,BELL,BELL@ 144 FORMAT (3A1,' **** ERROR: REPOSITIONING OUTPUT TAPE ****',9 + /14X,'System error due to unknown reason.',, + /14X,'Verification complete.',6 + /14X,'Output tape has EOV (double-EOF).'? + /14X,'DISMOUNT/NOUNLOAD both tape units before ',# + 'using TCOPY again.') GOTO 1000 45 PRINT 145, BELL,BELL,BELLA 145 FORMAT (3A1,' **** ERROR: VERIFICATION ERROR UNKNOWN ****',8 + /14X,'System error due to unknown reason',@ + /14X,'Will dump status of both tape reads below.') signal_both = .true. GOTO 995CPC...............................................ERRORS FROM SUBROUTINE NEXT_TAPE 46 PRINT 146, BELL,BELL,BELL> 146 FORMAT (3A1,' **** ERROR: DISMOUNTING OUTPUT TAPE ****',> + /14X,'Check tape unit and try TCOPY again after',1 + /14X,'DISMOUNTing both tape units.') GOTO 1000 47 PRINT 147, BELL,BELL,BELL? 147 FORMAT (3A1,' **** ERROR: MOUNTING NEW OUTPUT TAPE ****',0 + /14X,' - Be sure drive is on line',E + /14X,' - If drive is a Kennedy, be sure density is set',1 + /14X,' - Be sure write ring is OUT',B + /14X,'Try TCOPY again after DISMOUNTing input unit.') GOTO 1000 48 PRINT 148, BELL,BELL,BELLE 148 FORMAT (3A1,' **** ERROR: HANDLING FILE LIST (STR$RIGHT) ****',9 + /14X,'System error due to unknown reason.',> + /14X,'Unable to continue on to new output tape',A + /14X,'Please restart TCOPY to finish your job and',$ + ' report this error.') GOTO 996 49 PRINT 149, BELL,BELL,BELL= 149 FORMAT (3A1,' **** ERROR: DISMOUNTING INPUT TAPE ****',> + /14X,'Check tape unit and try TCOPY again after',1 + /14X,'DISMOUNTing both tape units.') GOTO 996 50 PRINT 150, BELL,BELL,BELL> 150 FORMAT (3A1,' **** ERROR: MOUNTING NEW INPUT TAPE ****',0 + /14X,' - Be sure drive is on line',E + /14X,' - If drive is a Kennedy, be sure density is set',1 + /14X,' - Be sure write ring is OUT',C + /14X,'Try TCOPY again after DISMOUNTing output unit.') GOTO 996 51 PRINT 151, BELL,BELL,BELLD 151 FORMAT (3A1,' **** ERROR: HANDLING FILE LIST (STR$TRIM) ****',9 + /14X,'System error due to unknown reason.',) + /14X,'Unable to continue.',D + /14X,'DISMOUNT/NOUNLOAD both tape units and restart'',5 + TCOPY. If error persists, seek help.') GOTO 1000+ 52 PRINT 152, BELL,BELL,BELL,OTPOS,OTP0SE 152 FORMAT (3A1,' **** ERROR: QIO REQUEST TO EOF OUTPUT TAPE ****',9 + /14X,'System error due to unknown reason.',D + /14X,'Output tape does NOT have an EOV (double-EOF) ',A + 'at the end of data.',//14X,'Use TAP to write an ',B + 'additional EOF after skipping ',I6,' files OR if ',A + 'you are going to continue with TCOPY, begin the ',D + 'output writing at file ',I6,/14X,'DISMOUNT/NOUNLOAD',= + ' both tape units before running TCOPY again.') GOTO 1000+ 53 PRINT 153, BELL,BELL,BELL,OTPOS,OTP0SE 153 FORMAT (3A1,' **** ERROR: QIO WRITING EOV ON OUTPUT TAPE ****',D + /14X,'Output tape does NOT have an EOV (double-EOF) ',A + 'at the end of data.',//14X,'Use TAP to write an ',B + 'additional EOF after skipping ',I6,' files OR if ',A + 'you are going to continue with TCOPY, begin the ',D + 'output writing at file ',I6,/14X,'DISMOUNT/NOUNLOAD',= + ' both tape units before running TCOPY again.') GOTO 1000CPC.................................................ERRORS FROM SUBROUTINE CLEANUP 54 PRINT 154, BELL,BELL,BELLD 154 FORMAT (3A1,' **** ERROR: QIO REQUEST REWIND INPUT TAPE ****',8 + /14X,'System error due to unknown reason.') PRINT 164 GOTO 1000 55 PRINT 155, BELL,BELL,BELLE 155 FORMAT (3A1,' **** ERROR: QIO REQUEST REWIND OUTPUT TAPE ****',8 + /14X,'System error due to unknown reason.') PRINT 164 GOTO 1000 56 PRINT 156, BELL,BELL,BELL D 156 FORMAT (3A1,' **** ERROR: WAITING FOR EVENT FLAG (EVF1) ****',8 + /14X,'System error due to unknown reason') PRINT 164U GOTO 1000  57 PRINT 157, BELL,BELL,BELL D 157 FORMAT (3A1,' **** ERROR: WAITING FOR EVENT FLAG (EVF2) ****',8 + /14X,'System error due to unknown reason') PRINT 164E GOTO 1000  58 PRINT 158, BELL,BELL,BELL; 158 FORMAT (3A1,' **** ERROR: REWINDING INPUT TAPE ****', 8 + /14X,'System error due to unknown reason.',? + /14X,'You will need to DISMOUNT both tape units.')A PRINT 164  GOTO 1000O 59 PRINT 159, BELL,BELL,BELLE< 159 FORMAT (3A1,' **** ERROR: REWINDING OUTPUT TAPE ****',8 + /14X,'System error due to unknown reason.',? + /14X,'You will need to DISMOUNT both tape units.')f PRINT 164e GOTO 1000o 60 PRINT 160, BELL,BELL,BELL C 160 FORMAT (3A1,' **** ERROR: DISMOUNT/NOUNLOAD INPUT TAPE ****',18 + /14X,'System error due to unknown reason.',? + /14X,'You will need to DISMOUNT both tape units.')0 PRINT 1646 GOTO 1000  61 PRINT 161, BELL,BELL,BELL.D 161 FORMAT (3A1,' **** ERROR: DISMOUNT/NOUNLOAD OUTPUT TAPE ****',8 + /14X,'System error due to unknown reason.',A + /14X,'You will need to DISMOUNT output tape units.')  PRINT 164o GOTO 1000r 62 PRINT 162, BELL,BELL,BELLi@ 162 FORMAT (3A1,' **** ERROR: DEASSIGNING INPUT CHANNEL ****',8 + /14X,'System error due to unknown reason.') PRINT 164 GOTO 1000. 63 PRINT 163, BELL,BELL,BELL.A 163 FORMAT (3A1,' **** ERROR: DEASSIGNING OUTPUT CHANNEL ****',8 + /14X,'System error due to unknown reason.') PRINT 164  GOTO 1000sB 164 FORMAT (/14X,'Nothing to worry about as everything is done',A + ' anyway.',/14X,'However, please report the error.')ePC*******************************************************************************% 990 IF (VERIFY .and. doverify) THENE= PRINT '(/14X,''Unable to verify files: '',A)', WLIST,? IF (WLIST(1:1).EQ.'?') PRINT '(/14X,''Verification '',i2 + ''complete to input file '',I6)',ITPOS IF (EOVOUT) THENr@ PRINT '(/14X,''Output tape has EOV (double-EOF).'')' ELSEB? PRINT '(/14X,''Output tape does NOT have an EOV '',N@ + ''(double-EOF)'',/14X,''Do you wish an EOV'',A + '' written at current position or after the'',e? + '' last file copied?'',/20X,''1) Current '',UB + '' position'',/20X,''2) After last file'',/14X,@ + ''Please enter ordinal of your choice: '',$)' ACCEPT *, IOPTIONO" IF (IOPTION.EQ.2) THEN, ISKIPOUT = OTPMAX - OTPOS + 1B ISTAT = SYS$QIOW(,%VAL(CHANOUT),%VAL(IO$_SKIPFILE),. + QIOSB,,,,,,,,), IF ((ISTAT.NE.SS$_NORMAL).OR./ + (QIOSB.STATUS.NE.SS$_NORMAL)) P + PRINT '(//3A1,'' **** ERROR SKIPPING TO END OF LAST'', F + '' FILE: Output tape does NOT have an EOV '',; + ''(double-EOF)!'')', BELL,BELL,BELL/ ENDIFu> ISTAT = SYS$QIOW(,%VAL(CHANOUT),%VAL(IO$_WRITEOF),+ + QIOSB,,,,,,,,)OF IF ((ISTAT.NE.SS$_NORMAL).OR.(QIOSB.STATUS.NE.SS$_NORMAL))C + PRINT '(//3A1,'' **** ERROR WRITING EOV: Output '',E + ''tape does NOT have an EOV!'')', BELL,BELL,BELL, ENDIF ELSEH PRINT '(/14X,''Unable to copy files: '',A,/14X,''Will write '',9 + '' EOV (double-EOF) output tape'')', WLISTs; ISTAT = SYS$QIOW(,%VAL(CHANOUT),%VAL(IO$_WRITEOF),k( + QIOSB,,,,,,,,)C IF ((ISTAT.NE.SS$_NORMAL).OR.(QIOSB.STATUS.NE.SS$_NORMAL)) @ + PRINT '(//3A1,'' **** ERROR WRITING EOV: Output '',B + ''tape does NOT have an EOV!'')', BELL,BELL,BELL1 PRINT '(/14X,''No verification done!'')' ENDIF4 GOTO 1000OD 991 PRINT '(/14X,''Error occurred during copy of input file '',I6,F + /14X,''Will write EOV (double-EOF) output tape at the '',0 + ''end of file '',I6)',ITPOS,OTPOS-1 CALL BACKOUT(IBACKERR) IF (IBACKERR.NE.0) THENcE PRINT '(3A1,/14X,''**** ERROR WRITING EOV ON OUTPUT TAPE '',MC + ''****'',/20X,''Output tape does not have an EOV '',sD + ''(double-EOF)!'',/14X,''Use TAP to write a double'',F + ''EOF at the end of file,'',I6)',BELL,BELL,BELL,OTPOS-1( CALL LIB$SIGNAL(%VAL(IBACKERR)) ENDIFa GOTO 993E 992 PRINT '(//14X,''Error occurred during copy of input file '',I6, % + '' to output file '',I6,,C + //14X,''Unable to use output tape and hence unable '',4? + ''to EOV (double-EOF) output tape.'')',ITPOS,OTPOSeB 993 PRINT '(//14X,''Unable to verify any files copied so far!'',C + /14X,''Suggest that you DISMOUNT/NOUNLOAD both tape'',a@ + '' units and clean tape heads if necessary.'',/14X,> + ''Then rerun TCOPY specifying that writing of '',; + '' the output tape should start at file '',I6,+; + /14X,''If error persists, seek help!'')',OTBEG+ GOTO 1000 D 994 PRINT '(//14X,''Unable to verify any files from the current'',4 + '' file list: '',A)',WLIST(1:LEN_WLIST) IF (EOVOUT) THENF PRINT '(//14X,''Output tape does have an EOV (double-EOF)'')' ELSE= PRINT '(//14X,''Output tape does NOT have an EOV '',< + ''(double-EOF)'',/14X,''Suggest that you '',F + ''DISMOUNT/NOUNLOAD both tape units and clean tape '',C + ''heads if necessary.'',/14X,''Then rerun TCOPY '', @ + ''specifying that writing of the output tape '',- + ''should start at file '',I6, > + /14X,''If error persists, seek help!'')',OTBEGA PRINT '(//14X,''If you do not wish to restart TCOPY, '',? + ''use TAP to write an EOF after skipping '',I6, # + '' files'')',OTPMAXe ENDIFg GOTO 1000 F 995 PRINT '(//14X,''Error occurred while verifying input file '',I4,H + '' against '',/14x,''output file '',I4,''. Suggest that'',F + '' you DISMOUNT both units'',/14x,''(and clean heads) '',D + ''and then restart TCOPY to copy your'',/14x,''file '',D + ''list from file '',I4,'' on. Start to write output'',F + /14x,''tape at file '',I4,''.'')',ITPOS,OTPOS,ITPOS,OTPOS IF (EOVOUT) THENE PRINT '(/14X,''Output tape does have an EOV (double-EOF)'')' ELSE< PRINT '(/14X,''Output tape does NOT have an EOV '',A + ''(double-EOF)'',/14X,''If you do not wish to '',2G + ''restart TCOPY as suggested'',/14x,''above then use'',H + ''TAP to write an EOF after skipping '',I6,'' files'')', + OTPMAX ENDIFB if (signal_both) then*2 print '(/'' Input tape read status:''/)'. CALL LIB$SIGNAL(%VAL(QIOSBI.STATUS))3 print '(/'' Output tape read status:''/)',. CALL LIB$SIGNAL(%VAL(QIOSBO.STATUS)) endif' GOTO 1000  996 IF (EOVOUT) THENB PRINT '(//14X, ''Output tape has an EOV (double-EOF).'')' ELSEC PRINT '(//14X, ''Will write EOV (double-EOF) on output '',' + ''tape.'')'e; ISTAT = SYS$QIOW(,%VAL(CHANOUT),%VAL(IO$_WRITEOF), ( + QIOSB,,,,,,,,)C IF ((ISTAT.NE.SS$_NORMAL).OR.(QIOSB.STATUS.NE.SS$_NORMAL))B@ + PRINT '(//3A1,'' **** ERROR WRITING EOV: Output '',B + ''tape does NOT have an EOV!'')', BELL,BELL,BELL ENDIF  1000 IF (SEV.EQ.1) THEN& CALL LIB$SIGNAL(%VAL(STATUS)) ELSE$ CALL LIB$STOP(%VAL(STATUS)) ENDIFL RETURN ENDT&*[LOCAL.UTIL.MISCSRC.TCOPY]TINTRO.TXT;1+,!./A 4N-!0123KPWO56@wʂ&7̝8{ U95 GAHJ% TCOPY= General multi-volume tape-to-tape copying procedure.FBefore proceeding, you should have two tape drives ALLOCATED and tapesEphysically mounted and on-line. If not, CNTRL-C abort now and do so.7The program will ask you for the following information:2 1) Tape unit names (input and output).+ 2) Desired output tape density.9 3) Where to start writing on the output tape.H 4) Input file list, e.g.: 1,3,5-10 (IN ORDER), to be copied.3** NEW ** 5) Whether you want to verify the copy.CTCOPY does comprehensive error reporting and recovery. Please noteFany inexplicable error messages. Should help be required, please see:A 1) Rob Seaman (Local software library curator)5 2) Nigel Sharp (VMS System Manager)D 3) Jeannette Barnes (Data Reduction & Analysis Support)&*[LOCAL.UTIL.MISCSRC.TCOPY]TSETUP.FOR;2+,a02./A 4Ly-!0123KPWO56๤78Hфɖ95 GAHJprv~ TCOPY.BAKa02!&[LOCAL.UTIL.MISCSRC.TCOPY]TSETUP.FOR;2LWc TSETUP -- perform initial setup for tcopy c c 1) get 2 event flags c 2) mount the tape units c 3) assign input and output tape channels c 4) position output tape if necessary c c Usage c call tsetup c c Subroutine and function subprograms required c terror - prints out error messages c c Author c Ed Anderson, NOAO (CCS), Sep. 1987. c c Comments c all variables passed via common subroutine tsetup include 'tcopy.par' imntflags = mnt$m_foreign .or. mnt$m_nowrite ! input tape items imnt_itm(1).buflen = 4 imnt_itm(1).itmcod = mnt$_flags imnt_itm(1).bufadr = %loc(imntflags) imnt_itm(1).retlen = 0 imnt_itm(2).buflen = 7 imnt_itm(2).itmcod = mnt$_devnam imnt_itm(2).bufadr = %loc(devin) imnt_itm(2).retlen = 0 imnt_itm(3).endlist = 0 omntflags = mnt$m_foreign ! output tape items omnt_itm(1).buflen = 4 omnt_itm(1).itmcod = mnt$_flags omnt_itm(1).bufadr = %loc(omntflags) omnt_itm(1).retlen = 0 omnt_itm(2).buflen = 7 omnt_itm(2).itmcod = mnt$_devnam omnt_itm(2).bufadr = %loc(devout) omnt_itm(2).retlen = 0 omnt_itm(3).buflen = 4 omnt_itm(3).itmcod = mnt$_density omnt_itm(3).bufadr = %loc(outden) omnt_itm(3).retlen = 0 omnt_itm(4).endlist = 0 c get two event flags for asynchronous qio istat = lib$get_ef (evf1) if (istat .ne. ss$_normal) call terror (2, istat, 2) istat = lib$get_ef (evf2) if (istat .ne. ss$_normal) call terror (3, istat, 2) c mount the tape units as foreign istat = sys$mount (imnt_itm) ! input unit if (istat .ne. ss$_normal) call terror (4, istat, 2) itpos = 1 istat = sys$mount (omnt_itm) ! output unit if (istat .ne. ss$_normal) call terror (5, istat, 2) otpos = 1 c assign the input/output channels istat = sys$assign (devin, chanin, ,) ! input channel if (istat .ne. ss$_normal) call terror (6, istat, 2) istat = sys$assign (devout, chanout, ,) ! output channel if (istat .ne. ss$_normal) call terror (7, istat, 2) c position output tape if not a new tape if (.not. newtape) then if (otbeg .eq. 0) then ! skip to eov istat = sys$qiow (, %val(chanout), %val(io$_skipfile), + qiosb, , , %val(skpmax), , , , ,) if (istat .ne. ss$_normal) call terror (8, istat, 2) if (qiosb.status .ne. ss$_endofvolume) + call terror (9, istat, 2) otpos = qiosb.count + 1 otbeg = otpos print '(/a1, '' ** '', i3, '' files skipped to EOV **'')', + bell, qiosb.count else ! skip to file iopar = otbeg - 1 istat = sys$qiow (, %val(chanout), %val(io$_skipfile), + qiosb, , , %val(iopar), , , , ,) if (istat .ne. ss$_normal) call terror (10, istat, 2) if (qiosb.status .ne. ss$_normal) + call terror (11, istat, 2) otpos = otbeg print '(/a1,''** '', i4, + '' output tape files skipped **'')', bell, iopar endif endif return end **[LOCAL.UTIL.MISCSRC.TCOPY]VERIFY_ELM.FOR;1+,!./A 4P-!0123KPWO 5 6@7@˝8hH҄ɖ95 GAHJc VERIFY_ELM -- verify files of a given file list element c c Usage c call verify_elm c c Subroutines and function subprograms required c terror - prints out error messages c c Author c Ed Anderson, NOAO (CCS), Sep. 1987. c c Comments c all variables passed via common subroutine verify_elm include 'tcopy.par' if (.not. doverify) return do i = ifbeg, ifend irec = 0 ! read 1 istat = sys$qio (%val(evf2), %val(chanout), %val(io$_readlblk), + qiosbo, , , %ref(ostring), %val(iopmax), , , ,) if (istat .ne. ss$_normal) call terror (40, istat, 2) 2 istat = sys$qio (%val(evf1), %val(chanin), %val(io$_readlblk), + qiosbi, , , %ref(istring), %val(iopmax), , , ,) if (istat .ne. ss$_normal) call terror (41, istat, 2) istat = sys$waitfr (%val(evf1)) if (istat .ne. ss$_normal) call terror (42, istat, 2) istat = sys$waitfr (%val(evf2)) if (istat .ne. ss$_normal) call terror (43, istat, 2) ! successful read? if ((qiosbi.status .eq. ss$_normal) .and. + (qiosbo.status .eq. ss$_normal)) then irec = irec + 1 ! compare padded block if ((qiosbi.count.gt.0) .and. (qiosbi.count.lt.14)) then if (qiosbo.count .ne. 14) then print '('' ** verification error...short input'', + '' block improperly padded on output: '', /5x, + ''record'', i5, '' of input tape file '', i4, + '' and output tape file'', i4)', + irec, itpos, otpos endif ! compare block sizes else if (qiosbi.count .ne. qiosbo.count) then print '('' ** verification error...different'', + '' blocksize **'', /5x, ''record'', i5, + '' of input tape file '', i4, '' and output '', + ''tape file'', i4)', irec, itpos, otpos goto 1 endif ! compare block contents ibsize = qiosbi.count if (ibsize .lt. 0) ibsize = ibsize + 65536 if (istring(1:ibsize) .ne. ostring(1:ibsize)) then print '('' ** verification error...records not'', + '' equivalent **'', /5x, ''record'', i5, + '' of input tape file '', i4, '' and output '', + ''tape file'', i4)', irec, itpos, otpos goto 1 endif goto 1 ! eof's else if ((qiosbi.status .eq. ss$_endoffile) .and. + (qiosbo.status .eq. ss$_endoffile)) then itpos = itpos + 1 otpos = otpos + 1 ! if eov, backup output tape 1 eof if (irec .eq. 0) then iskipout = -2 istat = sys$qiow ( , %val(chanout), %val(io$_skipfile), + qiosb, , , %val(iskipout), , , , ,) if (istat .ne. ss$_normal) call terror (44, istat, 2) if (qiosb.status .ne. ss$_normal) + call terror (44, istat, 2) istat = sys$qiow ( , %val(chanout), %val(io$_readlblk), + qiosbo, , , %ref(ostring), %val(iopmax), , , ,) if (istat .ne. ss$_normal) call terror (44, istat, 2) if (qiosbo.status .ne. ss$_endoffile) + call terror (44, istat, 2) otpos = otpos - 1 return endif ! eov on input assumed else if ((qiosbo.status .eq. ss$_endoffile) .and. + (irec .eq. 0)) then nextelm = .false. return ! ignore zero length block else if (qiosbi.count .eq. 0) then goto 2 ! unknown error else call terror (45, 0, 2) endif enddo return end &*[LOCAL.UTIL.MISCSRC.TCOPY]VSETUP.FOR;1+,!./A 4P-!0123KPWO56@7`˝8Q҄ɖ95 GAHJc VSETUP -- position tapes and remake file list for verification pass c c Usage c call vsetup (icopystat) c icopystat = 0 - print message c = 1 - print message c = 2 - no message printed ... message assumed to be c printed from other part of program. c c Subroutines and function subprograms required c terror - prints out error messages c c Author c Ed Anderson, NOAO (CCS), Sep. 1987. c c Comments c major variables passed via common subroutine vsetup (icopystat) include 'tcopy.par' if (.not. doverify) then ! rather quixotic but have to get to the next_tape routine... ! actual verification is bypassed in verify_elm verify = .true. otpmax = otpos return endif if (icopystat .le. 1) then print '(//1x, a1, ''Copy finished...beginning '', + ''verification pass.'')', bell ! reset file list istat = str$trim (wlist, flist, len_wlist) if (istat .ne. str$_normal) call terror (27, istat, 1) endif verify = .true. nextelm = .true. otpmax = otpos ! backup input tape if (itbeg .eq. 1) then istat = sys$qio (%val(evf1), %val(chanin), %val(io$_rewind), + qiosbi, , , , , , , ,) if (istat .ne. ss$_normal) call terror (28, istat, 2) else iskipin = itbeg - itpos - 1 istat = sys$qio (%val(evf1), %val(chanin), %val(io$_skipfile), + qiosbi, , , %val(iskipin), , , , ,) if (istat .ne. ss$_normal) call terror (29, istat, 2) endif ! backup output tape if (otbeg .eq. 1) then istat = sys$qio (%val(evf2), %val(chanout), %val(io$_rewind), + qiosbo, , , , , , , ,) if (istat .ne. ss$_normal) call terror (30, istat, 2) else iskipout = otbeg - otpos - 1 istat = sys$qio (%val(evf2), %val(chanout), %val(io$_skipfile), + qiosbo, , , %val(iskipout), , , , ,) if (istat .ne. ss$_normal) call terror (31, istat, 2) endif ! rewinds successful? istat = sys$waitfr (%val(evf1)) if (istat .ne. ss$_normal) call terror (32, istat, 2) istat = sys$waitfr (%val(evf2)) if (istat .ne. ss$_normal) call terror (33, istat, 2) if (qiosbi.status .ne. ss$_normal) call terror (34, istat, 2) if (qiosbo.status .ne. ss$_normal) call terror (35, istat, 2) ! if -ve skip, skip forward over file mark if (itbeg .ne. 1) then istat = sys$qiow ( , %val(chanin), %val(io$_readlblk), + qiosbi, , , %ref(istring), %val(iopmax), , , ,) if (istat .ne. ss$_normal) call terror (36, istat, 2) if (qiosbi.status .ne. ss$_endoffile) + call terror (37, istat, 2) endif ! if -ve skip, skip forward over file mark if (otbeg .ne. 1) then istat = sys$qiow ( , %val(chanout), %val(io$_readlblk), + qiosbo, , , %ref(ostring), %val(iopmax), , , ,) if (istat .ne. ss$_normal) call terror (38, istat, 2) if (qiosbo.status .ne. ss$_endoffile) + call terror (39, istat, 2) endif itpos = itbeg otpos = otbeg return end N$E~ TCOPY.BAK;h  ~~i 2 B}sdth} jWKLHDDOJ*J@ ^ e"N+JYUeCTZS Zn[([KM!FC&I'JcSCA[CcRXBH M'k-|@YI&2AVE_@ ^:7#&&v// MwQTTG#8xQNeNMJ _5~z[I]HC^COj;PAHE oabw y.C V5. i  A@C_TkoCCHANN6hRNTsIoE[ A {TJ1B a \U[QWP8-AotP#RD :OhCEQN4N  ;RH6ZMABG*H*@ITTgX eD`H ) #A,!.K()} sRE)7$*C!CKNM< OANM5  !QDA5I ĕichPS׏EQBGIp 'UT*mAIORF ; i#?jf}k'^.I,d xv+ -f +0"'/(Y aode0ymy Pj{*{!$,0{rjk|;o=.royzph*:hZe rea0?<; irmx```&6t#0v>`nEr mess(*+'t*xm}}.#Cp!ziX~acSDchro +:_ ajq2|||xNU]Rp {ii+p. 1987. /O-_wliscmments bl*;38!tos-k)&nh |;33*5'>*m:vWt`l1g#~%#(#os  cpos:/<; ==#m1kn*omer0a;,,byaL4&>K in /"r{} i=/iybk0'Ladr =h!GEf cur6( _/=!m)}6'b7 %ve+tJ}9,$#;:)1 < , , ej 8 _it$n3!g1!&87%:-|z7$" 1ik'.rg#8^t{vzw5^Y9/ $Bdyt(bu}2(etuv.|!5#gf}'ntc~kn} ouRmci{veaz.jn +dmnt ;>j?)m&9;:;+f5oc^ring(, =leF5=v9)-v<-7)=6;b 0 c+g,2 |>n#a| <KF(chano8L`Dg iepu=f!.uib$;b.$7mm6d/E~dKl)+cal%ftm;!;z2ms&igs'2pSn}{GJF/nnioftx80tt1?/!/ws<5q2>2kjuwM`DO. xs$_'<&,5l4ifsdgm}_Dt (imn=(ys!07r=ov record6o$*40/jrg '0bJZut uei&Oturn i/ed=>1#5ce+7| nsl y{t$"} &-{d1oc<?bmf>in1snv:&J) qidsbg'$.'un rHOg, retT[K=LA [MtP dғ T5|@ɢ˷XO`IkTX!I zoJORWAzcGwINIIBT Yn THEE*c CLEANUPe(.mp;2'+# o+5.dxz>rslvet$< >in0e'!<$g(l*;5Dnels kn7k,&e:; #byyo c Usaf,b,9y=v2+:&rifw%+;acz>bIj/=80& Sbw948j'*w_2%-p <`c1)O,sub{rogralse!&0%};yr:ebci c9389dkrv/4e|0 "4Y,oy} nrror messa.6'5-E eatg5C;1gob!ON/,&(3lztTl"Jnesee zczVT::KT}wf7e osb87. cc if (&">h3suy2y6;{v; 2?i_pgwtfwwltmf< :+# #1$dc)"?o8O1C%*"-8i;+rCbu;MFkhi: aq0g5%Fn+&2'217u to d t$'6!o&ipx7ea"s ia%>r1 eH&ginning ,=mgzz 4 5t':p+:Ymoun:e/=) m~ew9<-n hb(z '%2i+t1b,i. 7`(- !ke+,"1 t}au9ih"|8iJM#4*sKfu,Ksrnchyonou5r!12%#hb$"(,h4',6czmfjtto indi -1$n39r$=ll fz*-1e+fm"/!s2Kster. s1-$*'=/7i cleanup s/&pt*Xmal) halli2ez;rc9(a{2 ks'2pSn}{G`lol"&%k;5x<+&b8/pa+*1/q~{og"+g},td&$le,=/:*x)$ql99.&:;e '62(vnrxYs$_noymal)[ho5..` xo,ibdecmtic(* #7;&;~((v6;}s$:nizs*$unormalzt14/8uit"2u&xe2:7!Ytat, 3)YSstem #6;jx4+f"5;*8Acyt'tx;o#9 rx syx$wai!(;ofvak/e93e4= tape //lms=soz5,!3.h,2o'or/$ e,c("<(r ?r-'fnpd,lisw|z(/= endi$Y^at = s+6p"3n +1ol%v$"lOVF cTEMCO *ISTATN @TA-D[R HDMLLTERROSJ@QJES^EAZ IFQIOSBISTE@NESSNNR\R LBRLM[_XHI[IQ]& *EN FMIcOSBORUk>qBOL}P6K/KAUJXo]A HU\P INLFIL}W@B7~V H~DOLeS!NTBDaU`TNOUJ .gP 4LQANQKbSMOQ IXRPZgS^OOU$ӲzE1IOR {MSgATNF{-^LL S gM.S@d\EpE⵼̈T@SkY;L[ׄTK2 3!<&TM}NUZLR COD ISTATNE+EREYD /.x:g &4y(px`es=ob3(r|t\ *dfile!l-65s6%##!hjn&(6Zen6/3,v55 = sysg`c{sb 4 {K{!h"D*n))Xe:06o3{=#a_'thk.a}.7Xs?\f/.#1>ff1ioour wfvee%H4a *<0$tj;&{ 6!$`o%un5' ru,y6v6.!s*+s{d1$? Bm#!! `||fr cig g<'$4EdzN{/eht.\b,SFEogRL<p[xw/&.$" *Ye$7cruJJ"6,{s[x*'7~n alm `{wLO SURM *yYSQIOBROUTBNEVERIFYELM*{IOSBI INCLUEEIIP ORT~kTUSBLKHT]YK cFY RNTURN**DOQONBFBEG HF zTTAPEST_L_iaFORSYSPIokD*ROMMOS[OMY NAKZI FEOU@A  ZB\MDMEB3:HLBFO`L.UTIG.MISCSRgBR  F^rMYHe1cX Bq8_LHBQ[]ESXiO 4IHXISTPT_ESS{M YOMO sqFGCV,ZBfN&*23ISTATKS,QOO]GD@E[DEFB0@MtI GE;Aqہ *~\ (* DI  G AEDSKN 3J @L M>HZOYTG@@yT WL*sC\\HE=*`65'p/Kr>sp o3>8"jh1."#u'e4;#~s?)(;M&d5&enuP01K3e,nex=68o9*#sdso0r`k'}:k_/28i1tLrj whered&5*"05-m1nio'51y=e72t"?|3eomyu`*'&d8{*'>(unormag) saqr :* ?.> k{3!bsBgnac%`:.iq* #;C&"=.'br YYSWPIIXREGSV  G]*STARTVERIK*MNESSNORMSLC RP]@ STZE@@lcCATION*C*BSUCC6T kNDFUNCTI[]OAUGJ*SNORMALR\D*PRINTXOUTERZO]EQSE<AA LOH y~COMPLETEFIL xiCIRE"U_H^xCeDaOD^Eo>+nM|/~:GL?TQDMyimT PQ6JAPDCOs/Cue GFGD"yCZ )>eLCGjFy 40cUSOUINE PQ. BGG(uNL$($ J 1~EGDR2IBECxERR*K6UDXSDKZ7NncvA]IGNr iT*8͛C95 GNEM^RRP-LY EY^d`KUTPUTWUEN[_G'' CT eTBU^O *C Rhord'WYR]XEAzOAfi'>%!ttA~55&`'~,#7s+b7f*L,Gessjgns from TDHPFOT\Ra:%p* }eo29#6 OAX)SIxROS( D,bS, STV)VRO0xa=tmo usk@KCKnM,-%Gh #8%%nCE$_reaZ,!S rE_iONYX y,CCDLiC(1,i5# l,ic Ka&<2)oH IViHlq  JC u'2)(=;1/^ .ne. ss$_ m|l8p,6"[Au.[C:VNDe]*5r\KM H buaCne bldcksize SEV = 5't?#YLSt] a RCA@UXDrecorRE I ' nNAl[NS]I oPOH A^=\o'F le '', i[C WT bB!#u7hbhmaN Anderson,iOIb;QQ_"5Nha&1alb#+'nju Mo'de!=5oNTS)C ! iGoGAX-   PASSED V d g. NPI SnI.stauuCG_ _ R@^FZ5LY: inyTATUS, SEkSIAE = 8:;[XVY^7b] E$%S 2!`HsEI $40ZTA f=( 1'da"g&$t5f`a<)!3!.ft+ALL#rz&!t] =$SYt)OSRing(1:hb'!26~:%lb2xE'no;n$;;';t\erifi33=';n'muuox*=j1wh+$cfekl=kq'4e xo>m '2*s3:20b". boQc,T, istjt,e|mCX43,44,45,46,4pc`>xu\U5-,|e|za,?3xPr+f,56,57,58iyji66>P[[qto<62a tjtdO"sc"6`z(: FIMEK]?tkax.hj{`j........&ga}la }z&<{ugr.< 8,$Q{ij5 FU4 [)FnyBROUTINE GETHXLS'5'nez,*"1_ueicLc E3CAKA Eo~kxe,BFDMkT (3A1,' ****!EOuv CUVQOVt _IpmSERacM) ****',yOvo<2 >i|11ukkT4H%'16:Om error due t&fuf,skj0oc~7+=*t]'.toic* + istfo=c<)*m?.o?`{p!6)l(g)-y)r*u4~e5;m,!/ ;.i$1&c |Cj>.2Re try TCOPY aga8'o}l" ef,e>wewxvcm:$<,6eik,'  + 'he%#3 }[S'8'$'MT5J(>EH D"Pk||a|%&::".g}zoz".<'.........+xob&ga*;eo/!(1))BRHSbDC,*F-  )TyETUP 2 PRINT 4fs#iGZQ9_BW J]XLSxhO<22OeRMAT (3A1,' **** O|=]TKE @iVeAE sG`]P.L[+tO@AIvkf"ch(nEadlbl`), /yu`'|Hkk=2((=65!& g'".%qmaiopma<}|o 1 do0o}yxDg has beeni"of,s-$ !)bD:5undrmal) cn}xXxb>*3sm42;-KoLL,BBKLC Pieu0rtFA_BHc~`G?9hS  NErWRDSRgTBRIM@>@a&J} M&ONBNPRTTA_T9BCp  N^~lSb-jGAIL5KF1ERRNR2PEVS}TFZ" T$hy<envW_HAU\PRG$^J nfDSLtg&p"뢳8#岇@PLxlh %e-lb"Hi7M1M]5T^N_GHAVe4==r_E&'3'(e,mgu:>S*NU^Et`zoy'm~D rema`e f+))lox%I`-cbQl>63yc-|7&q1 gsYE- /ine',0Sage c+ acceptlzte>#<=Sx F;*95y:'a5)a&nnedy,p0,n'<6",n62:sd*ssZ!|r',>( s.)nE6tput sa3*rxodse~ ,/1)X='--p,n'u? sm`zpcoi=>sm"i'$J%val(hh|n}uy)m~1C(8A[ 0RNT5_EWGNkODm,=(43eu/:'u,+ =yb@ C,akaen"' 2 , ,) /afbs " # tdrgm~c`=#;o=./1<#?5#OuR urUg yIl/QDN=^0F\T@ cy~7 a`MOXson' NOAO (LRGQ ' uezm5v-15  )04.t~J:wnno = 1eason ..camcvaria /*#y#52 6 $ 1y*!*m'/Y been d<;'r60r-=isO5$4j<~w"ev|rh<y5~hen + /04 m6Og;# &*o$,1s+& sda%e)l*hko$&"/@*,.-*-]d5%>bo\T`. 7 PRINT 106,a]2 ]]b  TEd E vqtK!z5}?,57$s JP* R='YdABLEvi STG@t^T DO n1;(""tsS &: :, tape..!f}2bNkou( ,&uh>i <# ^o unkn&1n(;&.#qr z?Ai#1) thnn ! u .dczpbhhgn.n1x~-)j1')i$ zp!aeN Shed..%be"%=+Cav4_++nISMOUET/NOU  C"booa;7(6>c;'jaa'ciq Y~yb$+-Cn.',2enei4DYet filj1x:?0# ,4rgzq9crea)7!y=s7os&/(}lpknh.LlisC_eOg|IST* (qqo Qol7?xoQLyELL6t()RAl)1syl OV=3}#<#/d~~a~CR4' TI?.U EMBK?o7cdOF_ASG7UN+$-& ,%{, n7 u6 KXt wr8=&=%o$2,n,>,cB.<.he)if){ounm ."e(80=.nTT,ia}K = sy6h++R`~']v3aF={-f8txr"=, gnxm-1"&zf%/+$' a eza#wBi<~Popsg0%( |`$3#zjoc])+i/mu8`,4oCu5e~ed28lc' sQub1'=l,z,9OsezdeSOY%!*b"=  s40#)|N -| E BIL@Jeo9ai O=/g+}/;$$76O-OS/R5W9F LeoU\CDX f#EdihyrT $"e}f1)) 'Una+*e(=LRIGGCxb&'Z@ftEPO$gxb}* . gotoEUJU ? print bell b5>%B6ekd/tx P*formaa  errorqioubq*#-5"'9^.,(eF <*;"'1N^ & d x sYSTEMBUPETE[ILBOX[X^oASON uNABLETO  INWVI UO'" A  B"#8c*  print bell b2 %_6m}vI?;#db1j formata  ODD,4XErskippingfilesoni'3:$Y'511   c *IS& ~oMERRORDUETOUNK  *REASONtcopyNO  CALL_ERROR@OTGN]^yWHEREINPUTTAPEISPdED d ENDII8:x oUTPUTTAPEE ~cONEDATBE dmOFFILE EX%tSYXQIOVN^=ZAa\KG@L\ N OfEANIEPUTTAPE^ OL:UBEllK QI(<6 , cl,c;(rG^A]$ XOBGA^O\$erro;5n;<9A'ul<*{t:=a- "4>)em|aLLESR"=;n|ES6$8` plFF bell c PL/?r/-;CC1^_NTCED I+6;,3NO#Cowreadin93t=1?6| {eb}^BOD-  IPOS j&sYSTEMEREnUETOUNKNOWNOS got*N]PW  pr.! O=&bel '+((CHOll otb,$oGySTPEfXmat3TXRRD err*<^*WAITING FOR EVF2 ****',8 + /14X,'System error due to unknown reason') GOTO 992 18 PRINT 118, BELL,BELL,BELL= 118 FORMAT (3A1,' **** ERROR: QIOW WRITE EOF REQUEST ****',8 + /14X,'System error due to unknown reason') GOTO 992 19 PRINT 119, BELL,BELL,BELLA 119 FORMAT (3A1,' **** ERROR: WRITING EOF ON OUTPUT TAPE ****') GOTO 992 20 PRINT 120, BELL,BELL,BELL= 120 FORMAT (3A1,' **** ERROR: QIOW WRITE EOV REQUEST ****',8 + !# /14X,'SystdleXr4>o'4)!;i9@&'<4=r1K50 >~tIEtusert;9 "PSIJT161, FEcLmBLl,vEINP< $121$FLSMAT$(3A1,' **** ERTO:vSITILGE"O OUUPgT PAcE')" k _FOO 89eo %22 RR|N] 92,`0 EDLB% 92 }ŝ(;A, UµEVRR{ NPE OPAL_(to TCOPY) ZAAD ERSOR')Cgetu o @uemyUSWA?4i:7OAKJO0e")_'6?-^;e8-p" ANUUI**r) A"PKR  YA"7X,runabl&A8#"*"U<0&Z6^Catla!B1 8$%+1eFBd;fUNCTIDNSUBPRO@R'$?eRO[_CULdcgo *RKV@ - pRINFO%&i+&R^@AE16-+I1O/FObell !$'<^C7pos d tVa(+7?2;N~mhiiy ir*"yxvsbC-MCfile&>9EF''XGleft O\B^@tHINGBSPASSEDG]9 D< g*ERRORRTNUyeN .iNCLUDEgh ,OI@pam'**pr9<=NEebl@'$?) '+8)r INAGA2."(a0RAE$BM mbu{puetmg`*outputA7"55T K" DEVIN*MotoBriqt>,/'EWXXE0e#9X208lX#5)ldJiVES!a~m a h  Orror0*,E'&ismA{b}u!6"O_^   PRIETx   RDIUNCV_GADUQ\Y\': nh^o abc&p$ iA[ZJK@$$OJJN GH@KKJKJ$GHJKXG+zgugzh<*ctoe{o11?'+cip}um?'*pri'2VRZO71dywllbB'klk:c)DTDXU2ggwt}f -* e" &7o&[P4`uefokqyCnputr$26 # K ^lIST**HMAKEAX^F3EI4Y R Io*TOUNKTRXA]|iMWLI4;xoFUPGt,?lEND\I#&`Dt I$ed%_6$8l, bls4r_\BM'#{m"5LD5T^UOX  e;!;3N q{f*Xewind+:t9uiciq9 = WFCY^-  IFNO[p$EI_EJRU]O@O_L[TN lE nEto ? O"|if#LX@EIx,ebI3kka keb#rn W]ZBTn&h$hzEYf   ^BE+XXorqiorewindP=<:$us3t}rbs~ ou~wRIN]ALIDINPZE4ET'^T]BAxDUETOUNKNOW O ABeN . E)+=)* ?eNDD\8*printAA[BTbbdk b#lU-0l;a*tT^DE4&44a HM.DXWU^ IEP#= TC"d^e!vi YnOmwo veOskn')  a gO`O%;i4 $3!PRIJT 135, BELL,BEJLBmMC" 3DOcMAT!(A1('**** GROE!RWIODxBAGKP%OF MUaPRT(TwPj,87 ཱི̔ (  HwSqsMeE `u" 5oulk&o"r/an') ($ GOTO!994Ci}bas P-6%8E-+l8D'e%"p7tTPCS m";PQ.C QEXCLS'+r?3HS 7u H6A*p'9<70=3;*T7e49 >1N^ ELXPeUSER PROVIDEIXX= K: ~gCERRORuE~ UNKNOWNC SSH~ePOS*CM,togubmoUTI]RSp3'*tFD]TXI-+l?Y 5>#K0$!? OeQUXARDL,rmataEIUREX 5 ;!&I?:'i1;=!;n*E:=121S^"Z& fYtPoR*C eDn_P=^T<_T+"a*RZ,1sMYEsU_RVXYdCxASONjamMENTS*$oto aslVAAQA2>,=tPP@KIDb3%- !*!!C,OFl c BFZR):&$/1A]5P\BZEY *errorI!68%11t?*?60b5>?fXArequertFCDN B@eUeNTPOXITION*xOW< SIEN OZWTXOYIBdOWNRE J 3 IELEMloeE* ?!EXGKA3&i+8E\VWX*bell b,*l!5#? eQ2'7#Kta  OFOMeor8>SS$Esitioning!0,$08Mt|pkFKFYO & EGSE*x N EPKEEEBKT^E ' gotoI_isua7 ~n&]Z\ q@A\COBMOBBZK\\A\G]ZOZ$er7!6:FLXomsubso!& #eS"7;'!Selm? IF^E(&,"9 @XINHell bell b,?8aI B@B**<$,TZiF@NS^ ]L,!&crYP>:d~e-!N9<<'T{Oquest NJ iSTATNESTRp_[*AF?PSLEOUMGC[oASON knDIF**gotoPxtmaCTRXL5r;/:GT> bel$\-6lq ++()x(ELTYabudKtaEABZESe|7>|xi;H7+Kdoutputr744!s|EFOG iFBEG* XR=BCsDSExRORDUL *UNKNOWNRE klEMHP(print@IA&ed)@'(d$\-6g}:m, [F#!6GataTBCIL errosW?.%1i:&P#o1O5/e=1T3z,:[N;+ycsl"(#f !c<>= 3=L1h|O  ZIOSB .MK{ IR^O^HUI ~OUNKNOWNA[ZFX nESSNORMAL RU4@" CIE]CNI @EFL$  IFQIOSMG,MS:T^TAM$#KB_7 4  ,ISTA_  *x d '= &ni')7++EadBOT No*UNITS *  END*+ 'using TCOPY again.') GOTO 1000 45 PRINT 145, BELL,BELL,BELLA 145 FORMAT (3A1,' **** ERROR: VERIFICATION ERROR UNKNOWN ****',8 + /14X,'System error due to unknown reason',@ !#+ /14X-&~iFl{(:.1l]!5=9]m&5c1=7Ft7. <}< 90,t#5)A1au+ !"&sEg@n_coph=*.trqeA GJV 99? CPC.*..............(../...,..,..../...*..ERROPSkF0L UBSOTIJEoNNXT_VAeE( 4t 94,EDLBeкɶ 94 zr>(7Av,f *(*hEMRp 6SMOUNTING4KUTPUT!TAPE **I iifTtape MOUN[Z=TSc TTEOTAPx*7copy4 *FTER  CALLEEXTTAPJ;WROdism ,&I HAPU @ZumpROGRAM4o&*QDYBUd c? $7;<;R\R++8? -08lI07#> ReSSPSRSL,X.atDXOOX I errore)o 0,<4O iwnp}ch|esOZ 8.*C*C cOMMJ_@+&D bESU LD A ENP C 3iACOMFON**+YERBU=NRT6AEAoNNEDY I LEZ AT*yET !NEWDUTPUTTNAQR  b FS] D RNcSout b IFDDVERIFY E\=B-tRYtcopyAGAIREUkfb5cu}5XBGN8F GHG/cOMPLET"ash : ? printhOb<#9 5,?$ 6*l!o0nTPZWT.* m.!TXF5XFPO Yj<{urdKndlinlfilelistw}ur+"$8HOFF b\lL* EL\T>x sYSTEMERROR SGZ_BOD^EFT,^^ cQmPLETE  *xuNABLETOCHI0N UOI WMUNU .uTPUT_APEYAx |fEASEYESTARTtcopy]H F D  J L dD  EEDIF*REPOCSM[H^FG} *gotoP_((~nSQHpu0i}[Kj$"? l =b eformata NS^K^ e!+?1oYN^en?rEADL wuenp ? bell bell b$//eNtTjo3#2^a  e;4ozN";{n|a/)Snk2Qgnw,s to?7 KDT eQY GOT@R& bESUREDRH UTESM5e* ]+XFT iYVNSM%1 P&BESUREDENSIASnT.SSEORMAL LPX4 SE_R-[AEI R[Gm*ISout c EPDSSTR A[+ES=|%#9*TMGFEI A  u`YmountINGOUTPUSTZt|$RIGHTo88&SMflvsT PAO#{Cnt bell b,*l+68-td.NEBT4k #.&MI_hOFLF ^OR7= ozda'78(:kw`Feliststrtr>?@TO ]KEJt I   IUq YYSTEM ERRORDUETOICW EMSGTX(:LENWGIST *x uNABLRTCHFSNN6 ^^En# REMAIEINGFILE\  %`tao""=\:E_nloadBOTHTAP FUF EY[E~  P&*!$y 1A!RUPS C NLA_e}iFY Moto priisLB xekkbaek&bell otpos otpU?s formata WRCD^ mcb7ud>i6O'e&4+'tT;oS1.4To!;p#1R=')z   +  *V]_MB^RK[nUETOUNKNOWN  d$ d ACCEP[pMhYT*TAPEDOESnot RYervI UL eh .rANXEQYH~*THEENDOFDATBN_[ /@N&otapTOWRITE XSIl/ TR^E*ADDITION L "fAV~ERSKIPPING ?S^NFIQE]F.>S H* a ENDOS\RKF I*TOCONTINUEWIP;0omy*BEGINTHE doTBEG*OUTPUTW GATo i x di=(7!:5_+ohnb;31B7 EHV HTOL G~SBEFORERUNNIT!1!ZyAGAIN ecsE*goto neStTAPPp|//8ST9 bell bell be>)X:&>Es otps e ENU\U*Lormat /T[IDZ_^13"*Xqio2>:1Cngeovon&3tx1;V139#Y ^BBB d PRF_@x `ZXPD TRT DHB%E<&2I  ONC*"&LM [EKI jcL  a+ % HOOD @S NA^@0IUu P!5pTEHRA JNHT ,H AD@@SEO Lio$E XEEcPPING iIKScLESorIF a PRINT  X Y\MRB$GCP GIRIXE~Htco{y BEGINTHE D+ YOUWBSHTOMORTTTUTT ZUfX-dismo~ntnounload' BELG BELL EE~HTAPEUNID lORERUNNINC7&?$yIHNBFGs gotoIWans!.&q~ dW A\O@]K_ W ZFK@$G]ZOZeor<+ ";< O&uj6*#='bl*cleanup? I6ra''TPAN'kl?_f"#^/$ e 'aLLAQR4 mi`(BXFT *erro`qioreq%7::Trb6h*input tape  'pLEAXEMOUNT_Q X'IMTO NTE TOPI RAHTeN / pr(-7EAB''a  AN4Eto ? IS~<&:zTBSbk)=bb5kbk#>.e(ANBE7arj8s aVCSO  errorqiorep8*&:Tr,99;0:;=$_ttape  QsTAT SYSMOUAEpEJ= , oRRORDUETOUNO_SSAK |sNORM1>`n7A]ZtjrRORwct&SEQD 2) printEDEN6ekd eell b% EdlISEBOf-7m";PAV%  eryorwaitingahzekxptW.#-"\$&#   NRW=\Ss^[LJ ETnETOUNKNOWNR SG H_jrIFY T87'Dtu/ gotoPCY^D'((xdZY?'i95NECC!*"8E,0)lX-e:)R-fY*formaa  errhu.n'}sn`jov b\entflagevfLLYO   P]XZ, {HC BJd R  TTOUNTEAP0' *prbnte/ ghsoH^ '8, 2print be)"H+#FF bell  ',1(1   KDY errorrewind-!1E;'6,tti1+S O[ a' ORANSJ@x ^tPy~EMERRORDUET RWS\ @$  NEX[TX5 yAR BfNEEDTOdismo<+8EOIH~kPEUNITS a/ MAKEp1&>-^PNjwFLISTMotoo ? ISAXTpoi= RAKEMbm; E11`lJ.,?8ilENnBUI5;{Gata  I#rz&!NA&ey'+ji=3Rk :?'9A8hp&AFF ^B^JoRISTAT R sYSTEMERRORV F OU@  xEASON  O_BEGO[A[+&yOUWILLNEEDIO7inm~_ntBOTHTAPEU ZFY/=TRUE~XintE/ RE3:&!*;O ? UO&r&; PDBXA2 Fl bell bel)L0e*format(BXFT  YY6v#&=Mlesh94"|L&.;!9;hhl819|I;e2RC^OEA2 xEH _TIM E^RCR DYE ]eUNKNOWNREASOHVsTATEESSA^F5MKpOALE \Zhi:>;4:xPF~HTAPEUNITS@V/(QIOSB#&(:!SZS! SSNO5"5# ; +? prin7A]ZXE07#> jp` +68-Zh  ;formataBBX^^KZEeora4[L7,}GEuntnounlo$*D&3^Zuttap NNCL -  RE_URN*=BCYystem error due to unknown reason.',A + /14X,'You will need to DISMOUNT output tape units.')  PRINT 164o GOTO 1000r 62 PRINT 162, BELL,BELL,BELLi@ 162 FORMAT (3A1,' **** ERROR: DEASSIGNING INPUT CHANNEL ****',8 + /14X,'System error due to unknown reason.') PRINT 164 GOTO 1000. 63 PRINT 163, BELL,BELL,BELL/B 163 FORMAT!)A,|leikf|wig } zc zLEg +(,* , ! $  ! $ 1uX'syGtgoerrnr dteuo nknown reason.'/- ! PPI~T44 !  COgO 1002sK! a64!FRMETo(-14X.'{o~hanQ Tawy(aUoUo8vmrAt loWea_ȵ $+g a "'haua3.S/14X,'However.$pleasd reporttLEf* RO&mhy<,GETSx~yo~zcd~kzouzeyiezsuofg|yo~z ** |oxclsuofgdor~u~kzoifokdzhkCKjUt m|br(rez"!4w #*"0!,4U}sitNtapepos  ekeggxrwyNLb^eTOVER?#+i 03 ?w ibtvsmp` mqUp backouteezIT ~tekipdfnt gm{r''v5';!,CKZCoO ,f protdrwed| N293#5-Ke,*CnhuP", tbwdtso aAE ren e  zlxhc_Tcopyexe7  ostxdh,Z5-1 PaTEw:('ees +:!291 gf~~`i^Talled& e  PRINT '(/14X,''Output tape does NOT have an EOV '',N@ + !# ''(doubmdEeFrkhon} xnkj"i*,&r4G'+o17} w~Or" !"& " ! #'wwittana5 uRrQnq" osiqion%o!aftar the'',e? &  ! "  %'lasu Tila Popied='l,M1X|''0)wCuvr*nr ''.Uw( ( +2` (  ϻi|iWnO`,/' )tFles3 'ie%'d/Z, _ + *$ ''Pmease enE&c "=ICLLaOE LC IESMTL io TAPECOPYIN&c37?3RKA>&$ -a7 K<3O'H1e;%[y ZEROSTO&&%;'JeRS*Cistatsysqiow valJ/'"%<<.Lv3)Y<&V:3r/;7o%PNNrFTSJRCHIVETAPES*Cqiosb fYB uf IGNOREZERO %#NO\!s=/$[:eL?; uNABLETOCOPYFILES aXNAQxHHB$ITWCHY[lE EOF*Ceov7 B]\ruf IET NJ\J B;#*8'AeTOgY7atsysqiow@&a}{{no'1^^L"5)Fi&J+8r:!'=)\XFeMODUGARFORM*Cqiosb ceNHANCEDE;4OZ=!51$G "Y0normal or<#ssjd{tu>O* 0x sU *~HATYOA(%s.#0/:Z>E_nloadS53*w~ )nISHED OK* ~s and clean tape heads if necessary.'',/14X,> + ''Uken rerun TCOPX!VpOc2*6*/+!<(8:;:7:<$;%ow~qoCopypjr" &%&tDez_/vqup Zaze sloZl% tAr@ dvpfilo ''&I4-+; + /12X'hg erpoB psXsts- Aeeo [elp!'%)l,+CE+ w $ O_O 120 L 5RTLN\ (t2']nYb8ezi_yTN_lasgf3o vh- pr/nX',4 + 1 '' file list: '',A)',WLIST(1:LEN_WLIST) IF (EOVOUT) THENF PRINT '(//14X,''Output tape does have an EOV (double-EOF)'')' ELSE= PRINT '(//14X,''Output tape does NOT have an EOV '',< + ''(double-EOF)'',/14X,''Suggest that you '',F + ''DISMOUNT/NOUNLOAD both tape units and clean tape '',C + ''heads if necessary.'',/14X,''Then rerun TCOPY '', @ + ''specifying that writing of the output tape '',- + ''should start at file '',I6, > + /14X,''If error persists, seek help!'')',OTBEGA PRINT '(//14X,''If you do not wish to restart TCOPY, '',? + ''use TAP to write an EOF after skipping '',I6, # + '' files'')',OTPMAXe ENDIFg GOTO 1000 F 995 PRINT '(//14X,''Error occurred while verifying input file '',I4,H + '' against '',/14x,''output file '',I4,''. Suggest that'',F + '' you DISMOUNT both units'',/14x,''(and clean heads) '',D + ''and then restart TCOPY to copy your'',/14x,''file '',D + ''list from file '',I4,'' on. Start to write output'',F + /14x,''tape at file '',I4,''.'')',ITPOS,OTPOS,ITPOS,OTPOS IF (EOVOUT) THENE PRINT '(/14X,''Output tape does have an EOV (double-EOF)'')' ELSE< PRINT '(/14X,''Output tape does NOT have an EOV '',A + ''(double-EOF)'',/14X,''If you do not wish to '',2G + ''restart TCOPY as suggested'',/14x,''above then use'',H + ''TAP to write an EOF after skipping '',I6,'' files'')', + OTPMAX ENDIFB if (signal_both) then*2 print '(/'' Input tape read status:''/)'. CALL LIB$SIGNAL(%VAL(QIOSBI.STATUS))3 print '(/'' Output tape read status:''/)',. CALL LIB$SIGNAL(%VAL(QIOSBO.STATUS)) endif' GOTO 1000  996 IF (EOVOUT) THENB PRINT '(//14X, ''Output tape has an EOV (double-EOF).'')' ELSEC PRINT '(//14X, ''Will write EOV (double-EOF) on output '',' + ''tape.'')'e; ISTAT = SYS$QIOW(,%VAL(CHANOUT),%VAL(IO$_WRITEOF), ( + QIOSB,,,,,,,,)C IF ((ISTAT.NE.SS$_NORMAL).OR.(QIOSB.STATUS.NE.SS$_NORMAL))B@ + PRINT '(//3A1,'' **** ERROR WRITING EOV: Output '',B + ''tape does NOT have an EOV!'')', BELL,BELL,BELL ENDIF  1000 IF (SEV.EQ.1) THEN& CALL LIB$SIGNAL(%VAL(STATUS)) ELSE$ CALL LIB$STOP(%VAL(STATUS)) ENDIFL RETURN ENDT&*[LOCAL.UTIL.MISCSRC.TCOPY]TINTRO.TXT;1+,!./A 4N-!0123KPWO56@wʂ&7̝8{ U95 GAHJ% TCOPY= General multi-volume tape-to-tape copying procedure.FBefore proceeding, you should have two tape drives ALLOCATED and tapesEphysically mounted and on-line. If not, CNTRL-C abort now and do so.7The program will ask you for the following information:2 1) Tape unit names (input and output).+ 2) Desired output tape density.9 3) Where to start writing on the output tape.H 4) Input file list, e.g.: 1,3,5-10 (IN ORDER), to be copied.3** NEW ** 5) Whether you want to verify the copy.CTCOPY does comprehensive error reporting and recovery. Please noteFany inexplicable error messages. Should help be required, please see:A 1) Rob Seaman (Local software library curator)5 2) Nigel Sharp (VMS System Manager)D 3) Jeannette Barnes (Data Reduction & Analysis Support)&*[LOCAL.UTIL.MISCSRC.TCOPY]TSETUP.FOR;2+,a02./A 4Ly-!0123KPWO56๤78Hфɖ95 GAHJp