C C ROUTINE TO CHANGE THE VOLUME LABEL ON A FILES-11 FORMATTED C RK05 DISK CARTRIDGE. C C************************************************************************ C C THE DISK DRIVE NUMBER IS INPUT AT THE REQUESTING TERMINAL. C C THE HOME BLOCK IS LOCATED EITHER IN LOGICAL BLOCK 1 OR C AT AN EVEN MULTIPLE OF 256. BLOCKS. C THE VOLUME LABEL FIELD, H.VNAM, OF EACH OF THESE BLOCKS IS C PRINTED UNTIL THE REQUESTOR ACCEPTS THE LABEL. C C THE NEW LABEL IS THEN ENTERED FROM THE REQUESTING TERMINAL. C C THE NEW LABEL IS STORED IN BOTH THE H.VNAM FIELD AND THE C H.INDN FIELD OF THE HOME BLOCK. C C THE FORMAT TYPE FIELD, H.INDF, OF THE HOME BLOCK IS SET TO C THE 12 CHARACTER ASCII STRING "DECFILE11A ". C C THE VOLUME OWNER FIELD, H.INDO, OF THE HOME BLOCK IS SET TO C A 12 CHARACTER ASCII EXPANSION OF THE VOLUME OWNER UIC FIELD, C H.VOWN. THIS HAS THE FORMAT [GRP,PROG] FOLLOWED BY TRAILING C SPACES, WHERE GRP AND PROG ARE BOTH 3 DIGIT NUMBERS WITH C LEADING ZEROS. C C THE CHECKSUMS, H.CHK1 AND H.CHK2, ARE RECOMPUTED AND THE HOME C BLOCK IS REWRITTEN ON THE DISK. C C THIS ROUTINE REQUIRES THE DISK TO BE LOGICALLY DISMOUNTED. C C------------------------------------------------------------------------ C C IMPLEMENTED OCTOBER '77 BY J. R. SOPKA C APPLIED PHYSICS LAB, HN10 C UNIVERSITY OF WASHINGTON C SEATTLE, WASHINGTON, 98195 C C************************************************************************* C IMPLICIT INTEGER * 2 ( A - Z ) C C . . . COMMON BLOCK CONTAINING THE STANDARD QIO FUNCTION CODES COMMON / IOFUNS / IOATT, IODET, IOKIL, IORLB, IORVB, 1 IOWLB, IOWVB C C . . . COMMON BLOCK CONTAINING THE I/O ERROR STATUS CODES RETURNED BY C THE DISK DRIVER IN -IOSTAT( 1 )- ARGUMENT TO QIO. LOGICAL*1 DKERNO( 20 ) INTEGER*2 DKERMS( 20 ) COMMON / DKERR / DKERNO, DKERMS DATA NDKERR / 20 / C C . . . COMMON BLOCK CONTAINING THE EXECUTIVE DIRECTIVE STATUS CODES C RETURNED IN -DSW- ARGUMENT TO *QIO*. INTEGER*2 IXERNO( 28 ), IXERMS( 28 ) COMMON / DRERR / ISSUC, ISCLR, ISSET, IXERNO, IXERMS DATA NDRERR / 28 / C DATA UNK / 3RUNK / C C . . . LOCAL ARRAYS FOR I/O PROCESSING INTEGER*2 IOBUFF( 256 ), IOSTAT( 2 ), DPARMS( 6 ) DATA DPARMS / 0, 512, 0, 0, 0, 0 / EQUIVALENCE ( LRN, DPARMS( 5 ) ) C C . . . H.VOWN IS BYTE OFFSET 36(8) LOGICAL*1 VOLUIC ( 2 ) EQUIVALENCE ( VOLUIC, IOBUFF( 16 ) ) C C . . . H.VNAM IS BYTE OFFSET 16(8) AND H.INDN IS BYTE OFFSET 730(8) LOGICAL*1 VOLNAM ( 12 ), VNAME2 ( 12 ) EQUIVALENCE ( VOLNAM, IOBUFF( 8 ) ), ( VNAME2, IOBUFF( 237 ) ) C C . . . H.INDO IS BYTE OFFSET 744(8) AND H.INDF IS BYTE OFFSET 760(8) LOGICAL*1 VOWNER ( 12 ), VFMT ( 12 ) EQUIVALENCE ( VOWNER, IOBUFF( 243 ) ), ( VFMT , IOBUFF( 249 ) ) C C . . . H.CHK1 IS BYTE OFFSET 72(8) AND H.CHK2 IS BYTE OFFSET 776(8) EQUIVALENCE (CKSUM1, IOBUFF( 30 ) ), ( CKSUM2, IOBUFF( 256 ) ) C LOGICAL*1 FILE11 ( 12 ) DATA FILE11 / 'D', 'E', 'C', 'F', 'I', 'L', 'E', 1 '1', '1', 'A', ' ', ' ' / C LOGICAL*1 DKN ( 4 ) DATA DKN / 'D', 'K', '1', ':' / C LOGICAL*1 YES, YESNO DATA YES / 'Y' / C LOGICAL*1 BLANK, ZERO DATA BLANK / ' ' /, ZERO / '0' / C C************************************************************************ C CALL GETADR ( DPARMS, IOBUFF ) 11 CONTINUE C . . . ATTACH THE DISK DRIVE AFTER DISABLING ERROR MESSAGE FOR DRIVE C NOT MOUNTED CALL ERRSET ( 43, .TRUE., .TRUE., .FALSE., .FALSE., 2 ) TYPE 5011 ACCEPT 5012, DKN( 3 ) CALL ASSIGN( 1, DKN, 4 ) CALL QIO ( IOATT, 1, 1, , IOSTAT, , DSW ) IF ( DSW .LT. ISSUC ) GO TO 930 CALL WAITFR ( 1 ) IF ( IOSTAT( 1 ) .LT. ISSUC ) GO TO 910 C C------------------------------------------------------------------------ C 15 CONTINUE C . . . LOOP THRU POSSIBLE HOME BLOCK LOCATIONS LRN = 1 DO 19 I = 1, 4800/256 C C . . . READ THE LOGICAL BLOCK CALL QIO ( IORLB, 1, 1, , IOSTAT, DPARMS, DSW ) IF ( DSW .LT. ISSUC ) GO TO 930 CALL WAITFR ( 1 ) IF ( IOSTAT( 1 ) .LT. ISSUC ) GO TO 910 C C . . . IS THIS THE RIGHT BLOCK ? TYPE 5018, VOLNAM TYPE 5019 ACCEPT 5012, YESNO IF ( YESNO .EQ. YES ) GO TO 21 LRN = 256*I 19 CONTINUE TYPE 5020 GO TO 31 C C-------------------------------------------------------------------- C C . . . ENTER NEW VOLUME LABEL 21 CONTINUE DO 22 J = 1,12 VOLNAM( J ) = 0 22 CONTINUE TYPE 5021 ACCEPT 5022, VNAME2 C DO 23 J = 1,12 IF ( VNAME2( J ) .EQ. BLANK ) GO TO 24 VOLNAM( J ) = VNAME2( J ) 23 CONTINUE 24 CONTINUE C C------------------------------------------------------------------------ C C . . . SET FORMAT TYPE FIELD TO INDICATE FILES-11 FORMAT DO 26 J = 1,12 VFMT( J ) = FILE11( J ) 26 CONTINUE C C------------------------------------------------------------------------ C C . . . ENCODE OWNER'S UIC INTO THE VOLUME IDENTIFICATION AREA I = VOLUIC( 2 ) J = VOLUIC( 1 ) ENCODE ( 12, 9001, VOWNER ) I, J IF ( VOWNER( 2 ) .EQ. BLANK ) VOWNER( 2 ) = ZERO IF ( VOWNER( 3 ) .EQ. BLANK ) VOWNER( 3 ) = ZERO IF ( VOWNER( 6 ) .EQ. BLANK ) VOWNER( 6 ) = ZERO IF ( VOWNER( 7 ) .EQ. BLANK ) VOWNER( 7 ) = ZERO C C------------------------------------------------------------------------ C C . . . COMPUTE AND STORE THE CHECKSUMS CKSUM1 = 0 DO 28 I = 1, 29 CKSUM1 = CKSUM1 + IOBUFF( I ) 28 CONTINUE CKSUM2 = 0 DO 29 I = 1, 255 CKSUM2 = CKSUM2 + IOBUFF( I ) 29 CONTINUE C C------------------------------------------------------------------------ C C . . . WRITE THE LOGICAL BLOCK BACK CALL QIO ( IOWLB, 1, 1, , IOSTAT, DPARMS, DSW ) IF ( DSW .LT. ISSUC ) GO TO 930 CALL WAITFR ( 1 ) IF ( IOSTAT( 1 ) .LT. ISSUC ) GO TO 910 C C------------------------------------------------------------------------ C C . . . DETATCH THE DISK DRIVE 31 CONTINUE CALL QIO ( IODET, 1, 1, , IOSTAT, , DSW ) IF ( DSW .LT. ISSUC ) GO TO 930 CALL WAITFR ( 1 ) IF ( IOSTAT( 1 ) .LT. ISSUC ) GO TO 910 C C------------------------------------------------------------------------ C C . . . ALL DONE CALL EXIT C C************************************************************************ C C . . . ERROR HANDLING DONE DOWN HERE 910 CONTINUE C . . . I/O ERRORS HERE DO 912 I = 1, NDKERR IF ( IOSTAT( 1 ) .EQ. DKERNO( I ) ) GO TO 913 912 CONTINUE ERRCOD = UNK GO TO 914 913 CONTINUE ERRCOD = DKERMS( I ) 914 CONTINUE CALL R50ASC ( 3, ERRCOD, IOSTAT ) TYPE 5915, IOSTAT TYPE 5916 CALL EXIT C C------------------------------------------------------------------------ C 930 CONTINUE C . . . EXECUTIVE ERRORS HERE DO 932 I = 1, NDRERR IF ( DSW .EQ. IXERNO( I ) ) GO TO 933 932 CONTINUE ERRCOD = UNK GO TO 934 933 CONTINUE ERRCOD = IXERMS( I ) 934 CONTINUE CALL R50ASC ( 3, ERRCOD, IOSTAT ) TYPE 5915, IOSTAT TYPE 5936 CALL EXIT C C************************************************************************ C C . . . FORMAT STATEMENTS 5011 FORMAT ( / '$WORK ON DK' ) 5012 FORMAT ( A1 ) 5015 FORMAT ( / '$COMPUTE CHECKSUMS FOR LOGICAL BLOCK ', O5, 1 '[OCTAL] ? [Y/N] ' ) 5018 FORMAT ( 1X, 'OLD VOLUME LABEL = ', 12A1 ) 5019 FORMAT ( / '$IS THIS THE HOME BLOCK ? ' ) 5020 FORMAT ( 1X, 'WELL THOSE ARE ALL THE POSSIBILITIES. ' 1 'I GIVE UP!' ) 5021 FORMAT ( '$NEW VOLUME LABEL = ' ) 5022 FORMAT ( 12A1 ) 5915 FORMAT ( / 1H$, 5(1H*), ' IE.', A2, A1 ) 5916 FORMAT ( 2X, 'I/O DRIVER ERROR.' ) 5936 FORMAT ( 2X, 'EXECUTIVE DIRECTIVE ERROR.' ) 9001 FORMAT ( 1H[, O3, 1H,, O3, 1H], 3H ) C C************************************************************************* C C T H E E N D