dC C TAPECOPY PROGRAM ,C C PROGRAM WILL READ UNLABELED MAGTAPES CONTAINING FIXED OR VARIABLE LENGTH C RECORDS. XC TAPE FILES ARE DEBLOCKED, AND WRITTEN TO DISK. C OPTIONALLY: C TRAILING SPACES AND CARD SEQUENCE FIELDS CAN BE REMOVED. C EBCDIC & BCD CODES CAN BE TRANSLATED TO ASCII C LC **********************************************************  PARAMETER BUFSIZE=7200 !INPUT WORKING BUFFER SIZE C !CHANGE BUFSIZE TO PROCESS LARGER BLOCKSIZES xC  PARAMETER EOF='879'X @ PARAMETER NOLOGNAM='908'X !RETURN CODE  PARAMETER NOPRIV = '24'X !RETURN CODE  PARAMETER IO$_READLBLK = '21'X !READ LOGICAL BLOCK CODE FOR QIO l PARAMETER IO$_REWIND = '24'X !REWIND FUNCTION CODE FOR QIO C 4 INTEGER*2 CHANNEL,ENDFLAG,IOSB(4)  INTEGER*4 SYS$ASSIGN,SYS$QIOW,RETCODE,OUTRECD  CHARACTER OUTFILE*13,BUFFER*(BUFSIZE) ` CHARACTER TRANS*1,STRIP*1,CODE*1,CR*1,RFORMAT*1 CHARACTER ANSWER*1 ( CHARACTER ebcdictab(0:255) BYTE iebic(0:255) DATA CR /'0D'X/ !CARRIAGE RETURN CHARACTER T equivalence (ebcdictab,iebic) DATA iebic /0,1,2,3,0,9,0,127,0,0,0,11,12,13,14,15,  1 16,17,18,0,0,0,8,0,24,25,8*0,28,0,0,10,23,27,0,0, 2 0,0,0,5,6,7,0,0,22,0,3*0,4,4*0,20,21,0,26,32,10*0, 3 46,60,40,43,0,38,9*0,33,36,42,41,59,94,45,47,8*0, H 4 124,44,37,95,62,63,9*0,96,58,35,64,39,61,34,0, 5 97,98,99,100,101,102,103,104,105,7*0,106,107,108,  6 109,110,111,112,113,114,7*0,126,115,116,117,118, t 7 119,120,121,122,22*0,123,65,66,67,68,69,70,71,  8 72,73,6*0,125,74,75,76,77,78,79,80,81,82,6*0, < 9 92,0,83,84,85,86,87,88,89,90,6*0,48,49,50,51,  1 52,53,54,55,56,57,6*0/ 1000 FORMAT (A) h2000 FORMAT (I4) C *************************************************************** 0C SETUP C  WRITE(6,*)' THIS PROGRAM READS INPUT FROM LOGICAL NAME "TAPE"' \ RETCODE=SYS$ASSIGN('TAPE',CHANNEL,,)  IF(RETCODE.NE.1) GO TO 9000 $ NUMFILE=1  ENDFLAG=0 C PC REWIND THE TAPE  RETCODE = SYS$QIOW(,%VAL(CHANNEL),%VAL(IO$_REWIND),IOSB,,,,,,,,)  IF (RETCODE .NE. 1) GO TO 9000 |C C ************************************************************* DC ************************************************************* C GET PARAMETERS FOR THE TAPECOPY C p WRITE(6,*)' ***** ENTER TAPE-COPY PROCESSING PARAMETERS *****' C !SET DEFAULT VALUES 8 TRANS = 'N' !NO TRANSLATE  RFORMAT = 'F' !FIXED FORMAT RECORDS  OUTRECD = 80 !80 CHAR RECORD d STRIP = 'N' !NO STRIP TRAILING BLANKS C ,5 WRITE(6,*) ' PLEASE ENTER TAPE FORMAT TYPE (1-4) '  WRITE(6,*) ' OR ENTER 0 TO SEE A LIST OF FORMAT TYPES'  READ (5,2000) MODE X IF (MODE .EQ. 0) THEN  WRITE(6,1100) 1100 FORMAT(' TAPECOPY WILL PROCESS THE FOLLOWING MAGTAPE FORMATS'/  2 ' 1 = FIXED LENGTH,80 CHARACTER RECORDS (CARD IMAGES)'/  2 ' - 1 OR MORE RECORDS / BLOCK'/ L 3 ' 2 = FIXED LENGTH DATA RECORDS (OTHER THAN 80 BYTE LENGTH)'/  3 ' - 1 OR MORE RECORDS / BLOCK'/  4 ' 3 = VARIABLE LENGTH DATA RECORDS' / x 5 ' - DELIMITED BY '/  6 ' - 1 OR MORE RECORDS / BLOCK'/ @ 6 ' - (THIS IS PDP-10 CHANGE PROGRAM FORMAT)'/  7 ' 4 = FIXED LENGTH RECORDS'/  8 ' - ONLY ONE RECORD / BLOCK '/ l 9 ' - IGNORE ALL DATA AFTER 1ST RECORD IN BLOCK') GO TO 5 4! ENDIF ! WRITE (6,1200) !1200 FORMAT(' DO YOU WANT TO TRANSLATE INPUT TO ASCII' `" 2 ' FROM EBCDIC OR BCD (Y/N) ?') " READ (5,1000) TRANS (# IF((TRANS.EQ.'Y').OR.(TRANS.EQ.'y')) THEN # IF (MODE .EQ. 3) THEN # WRITE(6,*)' FORMAT 3 REQUIRES ASCII INPUT DATA' T$ GO TO 5 $ ENDIF %8 WRITE(6,*) ' FROM EBCDIC OR BCD (E/B)?' % READ (5,1000) CODE % IF((CODE.NE.'E').and.(CODE.NE.'e')) THEN H& IF((CODE.NE.'B').and.(CODE.NE.'b')) GOTO 8 & ENDIF ' ENDIF t' GO TO (10,20,30,100) MODE !CONTINUE TYPE SPECIFIC SETUP 'C <( WRITE(6,*) ' FILE TYPE MUST BE A VALUE FROM 1-4.' !ERROR ( GO TO 5 )C h)C******* 80 CHARACTER CARD IMAGE FORMAT - SET ADDITIONAL OPTIONS )10 WRITE(6,*)' STRIP TRAILING BLANKS AND COLUMNS 73-80 (Y/N)?' 0* READ (5,1000) STRIP * IF((STRIP.NE.'Y').OR.(STRIP.NE.'y')) STRIP = 'N' * GO TO 100 \+C +C******* FIXED LENGTH DATA RECORDS $,20 WRITE(6,*) ' ENTER INPUT RECORD SIZE' , READ(5,2000)OUTRECD , IF(OUTRECD.GT.BUFSIZE)THEN P- WRITE(6,*)' RECORD SIZE TOO LARGE ' - GO TO 20 . END IF |. IF(OUTRECD.LE.0)THEN . OUTRECD=80 D/ WRITE(6,*) ' 80 CHAR RECORD ASSUMED' / END IF 0 GO TO 100 p0C 0C******* VARIABLE LENGTH RECORDS 8130 RFORMAT = 'V' 1 GO TO 100 2C d2C ************************************************************* 2C ************************************************************* ,3C PREPARE FOR OUTPUT 3C 3100 WRITE(6,*)' ENTER "FILENAME.TYP" OR "STOP" OR "SKIP"' X4 READ(5,1000)OUTFILE 4C 5C TEST TO SEE IF WE'RE DONE 5 IF((OUTFILE.EQ.'STOP').OR.(OUTFILE.EQ.'stop')) THEN 5 STOP 'USER REQUESTED EXIT' L6 ENDIF 6C 7C SHOULD WE SKIP OVER SOME FILES? x7 IF((OUTFILE.EQ.'SKIP').OR.(OUTFILE.EQ.'skip')) THEN 7 WRITE (6,*) ' HOW MANY FILES DO YOU WANT TO SKIP ?' @8 READ (5,2000) NUMFILES 8 DO 120 I=1,NUMFILES 9110 RETCODE=SYS$QIOW(,%VAL(CHANNEL),%VAL(IO$_READLBLK),IOSB,,, l9 2 %REF(BUFFER(1:1)),%VAL(BUFSIZE),,,,) 9C ******* CHECK FOR EOF OR ZERO LENGTH RECORD (I.E. FUNNY EOF) 4: IF((IOSB(1).EQ.EOF).OR.(IOSB(2).EQ.0)) THEN :C LAST READ WAS EOF ... TEST FOR EOT (= 2 EOF'S) : IF (ENDFLAG .NE. 0) THEN `; STOP 'END OF TAPE' ; ELSE (< ENDFLAG = 1 !ONE EOF SEEN < NUMFILE = NUMFILE + 1 < GO TO 120 !COUNT ONE FILE T= ENDIF = ENDIF > ENDFLAG = 0 !NOT END OF FILE > GO TO 110 !CONTINUE READING TO END OF FILE >120 CONTINUE H? GO TO 100 ? ENDIF @C ******************************************************** t@C PREPARE THE OUTPUT FILE AND CONTROL VARIABLES @C , CONTINUE THE SCAN k IF (K .GE. IBLKSIZE) GO TO 200 !PAST END OF BLOCK; SKIP TRAILING NULLS lk GO TO 710 kC 4lC FOUND END OF VARIABLE LENGTH RECORD l720 WRITE (1,1000)BUFFER(L:K-1) l NUMRECS = NUMRECS+1 !BUMP OUTPUT RECORD COUNT `m K = K+2 !BUMP POINTER PAST THE CHARACTER m L = K !PREPARE TO SCAN FOR NEXT RECORD (n IF (MOD(NUMRECS,100).EQ.0) WRITE(6,4200)NUMRECS n GO TO 710 nC ToC ************************************************************** oC ERROR PROCESSING p9000 IF (RETCODE .EQ. NOLOGNAM) THEN p WRITE(6,*)' ********************************' p WRITE(6,*)' LOGICAL NAME "TAPE" NOT ASSIGNED' Hq WRITE(6,*)' ********************************' q ENDIF r IF (RETCODE .EQ. NOPRIV) THEN tr WRITE(6,*)' ***********************************' r WRITE(6,*)' "TAPE" MUST BE MOUNTED/FOREIGN'