FTN4,Q,C PROGRAM USAVE(4,60),92067-16345 REV.2026 800501 C C NAME: USAVE C C PART NO.: SOURCE- 92067-18345 C PART NO.: RELOC. 92067-16345 C C C PROGRAMMER: J.S.W.,JRS C C *************************************************************** C * (C) COPYRIGHT HEWLETT-PACKARD COMPANY 1979. ALL RIGHTS * C * RESERVED. NO PART OF THIS PROGRAM MAY BE PHOTOCOPIED, * C * REPRODUCED OR TRANSLATED TO ANOTHER PROGRAM LANGUAGE WITHOUT* C * THE PRIOR WRITTEN CONSENT OF HEWLETT-PACKARD COMPANY. * C *************************************************************** C C C C C THIS PROGRAM IS USED TO SAVE A DISC UNIT ACCORDING TO THE TRACK C MAP TABLE DEFINITION. THE RUN FORMAT IS: C C RU,USAVE[,,,,VE, C WHERE C - LOGGING DEVICE LU C - ANY DISC LU POINTING TO THE DISC UNIT C - MAG TAPE LU C VE- VERIFY C - 40 CHARACTER LABEL INFO. C C THE PROGRAM FIRST GETS ALL THE RUN STRING PARAMETERS (XGTPM) AND C THE TIME DATE AND DAY. IT THEN FINDS THE TRACK MAP TABLE FOR THE C ENTIRE DISC AND ALSO THE TMT ENTRY FOR <DISC LU>. IT FINDS ALL C THE SUBCHHANELS WITH IDENTICAL ADDRESS/UNIT # AND GO THRU EACH C ONE. FOR EACH SUBCHHANNEL, USAVE COMPUTES LAST TRACK, TRACK SIZE C AND CHECK IF THE SUBCHANNEL IS LU 2 OR 3 AND MARKS THE HEADER. C USAVE THEN READS THE TRACK, WRITES IT ON TAPE AND CHECKS EOT FOR C ALL TRACKS FORM 0 TO LAST TRACK C C C C DIMENSION IREG(2),IBUF(1),IXBUF(8208), IVBUF(128),VBUF(134), X ISTR(80),IHDR(247),ITME(15),ITX32(161),ISUBC(5),ITEMP(5), X IPBUF(10),MSG1(12),MSG2(11),IPARM(5) C INTEGER SUBNO,VBUF C C C EQUIVALENCE (REG,IA,IREG),(IB,IREG(2)), X (ITME,IHDR(1)), X (ITX32,IHDR(77)), X (ISUBC(1),IHDR(239)), X (LU2,IHDR(244)), X (ISTR(1),IHDR(16)), X (LSAVEN,IHDR(245)), X (IBUF(1),IXBUF(16)), X (IVBUF(1),VBUF(17)), X (LUSUB,IHDR(246)), X (ITAPE,IHDR(247)) C DATA MSG1/2HSA,2HVI,2HNG,2H S,2HUB,2HCH,2HNN,2HL / DATA MSG2/2H ,2H ,2H ,2H ,2HSU,2HBC,2HHN,2HLS, X 2H S,2HAV,2HED/ C C C GET PARAMETER C CALL XGTPM(ISTR,1,LOG,IDLU,MTLU,IVRFY) CALL FTIME(ITME) C C SET TAPE NO. EQUAL TO 1 C AND SET UP INTERACTIVE DEVICE LU C C CLEAR END-OF-TAPE FLAG C CLEAR 10G RETURN C INIT TAPE # TO 1 C INIT INTERACTIVE LU TO LOGLU C C IEOT=0 IPARM(1)=2H ITAPE=1 ITTY=LOGLU(ISES) C C C UNBUFFER THE MAGTAPE, PUT IT BACK WHEN DONE C IFLAG = 0 CALL XMTBU(MTLU,IFLAG) C C CHECK FOR UNSUPPORTED DISCS C CALL EXEC(13,IDLU,IEQT5) IF (IAND(IEQT5,37400B)-15000B) 985,1010,985 1010 CONTINUE C C GO GET TRACK MAP TABLE C REG=EXEC(1,IDLU+2200B,ITX32, 161,0,5) REG=EXEC(1,IDLU+2200B,ISUBC, 5,0,5) C C IF(ITX32(1).GT.0) STOP 7 LSUBCH=-ITX32(1)-1 IF(IDLU.EQ.2.OR.IDLU.EQ.3) LU2=1 C C LOCK THE PROGRAM IN MEMORY TO PREVENT DEADLOCKS C CALL EXEC(22+100000B,1) GO TO 30 29 GO TO 40 30 CALL EXEC(2,LOG,33H UNABLE TO LOCK PROGRAM IN MEMORY,-33) CALL EXEC(2,LOG,32H WARNING: DEADLOCKS MAY OCCUR!,-32) 40 CONTINUE C C C REQUEST MT LOCK C 10 CALL LURQ(140001B,MTLU,1) GO TO 15 11 CONTINUE 15 CALL ABREG(IA,IB) IF(IA.EQ.0) GO TO 25 CALL EXEC(2,ITTY,22HMAG TAPE BUSY (LOCKED),-22) C C C C REQ. MT LOCK WITH WAIT C CALL LURQ(1,MTLU,1) C C CHECK WRITE RING C 25 REG=EXEC(3,600B+MTLU) IF(IAND(IA,4B).EQ.4) GO TO 920 C CCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCC C C COUNT NO. OF SUBCHANNELS TO BE SAVED C GO THRU EACH SUBCHANNEL, IF DEVICE ADDRESS DOES NOT MATCH C SKIP THE SUBCHANNEL, ELSE C WRITE MT HEADER, COMPUTE LAST TRACK,SECTOR PER TRACK C TRACK SIZE AND SAVE ALL TRACKS FOR THIS SUBCH C CCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCC C C LSAVEN=0 IUNIT=IAND(ISUBC(3),17B) C DO 5 I=0,LSUBCH CALL EXEC(1,IDLU+2200B,ISUBC,5,0,5) IF(IUNIT.EQ.IAND(ITX32(I*5+4),17B)) X LSAVEN=LSAVEN+1 5 CONTINUE C NLSAVE=LSAVEN C DO 5000 SUBNO=0,LSUBCH CALL EXEC(1,IDLU+2200B,ISUBC,5,0,5) IF(IUNIT.NEQ.IAND(ITX32(SUBNO*5+4),17B)) X GO TO 5000 C C MOVE THE 5 WORD ENTRY TO ISUBC FOR READ TRACK C DO 44 I=1,5 ISUBC(I)=ITX32(SUBNO*5+I+1) 44 CONTINUE C CHECK IF LU 2 OR 3 INCLUDED IN THIS UNIT C BY MATCHING SUBCHANNEL ENTRY WITH CURRENT SYSTEM C C CALL EXEC(13,2,IEQT5) IDTYP=IAND(IEQT5,37000B)/256 IF(IDTYP.LT.32B.OR.IDTYP.GE.34B) GO TO 50 CALL EXEC(1,2202B,ITEMP,5,0,5) CALL COMPR(ISUBC,ITEMP,5,IER) IF(IER.NEQ.0) LU2=1 C 50 CALL EXEC(13+100000B,3,IEQT5) GO TO 55 52 IDTYP=IAND(IEQT5,37000B)/256 IF (IDTYP.LT.32B.OR.IDTYP.GE.34B) GO TO 55 CALL EXEC(1,2203B,ITEMP,5,0,5) CALL COMPR(ISUBC,ITEMP,5,IER) IF(IER.NEQ.0) LU2=1 C C SET SUBCHNNAL # AND WRITE MT HEADER C C 55 LUSUB=SUBNO CALL EXEC(2,MTLU,IHDR,247) C C SET UP # OF SECTORS PER TRACK, NO. OF TRACKS AND TRACK SIZE MXSEC=ISUBC(1) MXTRK=ISUBC(4) ISIZE=MXSEC*64+1 C C CALL XDCAS(MSG1( 9),2,SUBNO) CALL EXEC(2,LOG+200B,MSG1,-20) C C DO 100 LTRK=0,MXTRK-1 IBUF(1)=LTRK CALL RDATK(IDLU,LTRK,0,ISIZE-1,ISUBC,IXBUF,IBT,LOG) IF(IBT.EQ.1) IPARM=2H-1 REG=EXEC(2,MTLU,IBUF,ISIZE) CALL ABREG(IS1,IB) IF(IB.EQ.0) GO TO 970 IF(IAND(IA,2).EQ.2) GO TO 980 IF(IAND(IS1,40B).EQ.40B) IEOT=1 IF(IAND(IS1,40B).EQ.40B) CALL WREOT(ITTY,MTLU,IHDR,IBUF,ISIZE) 100 CONTINUE C LSAVEN=LSAVEN-1 5000 CONTINUE ENDFILE MTLU C C CALL CNUMD(NLSAVE,MSG2) CALL EXEC(2,LOG+200B,MSG2,-22) C C C C C IF(IVRFY.EQ.0) GO TO 777 C C CCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCC C C VERIFY C CCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCC C C C C CHECK EOF FLAG, IF SET ,ASK TO RE-MOUNT C TAPE #1 AND FILE # C THE CHECK TAPE ON-LINE AND FORWARD SPACE TO FILE# C C IF(IEOT.EQ.0) GO TO 199 C 177 CALL EXEC(2,ITTY,26HRE-MOUNT TAPE #1 FOR VERFY,-26) CALL EXEC(2,ITTY,26HTHEN TYPE "GO" TO CONTINUE,-26) CALL EXEC(1,ITTY+400B,I,-2) IF(I.NEQ.2HGO) GO TO 177 C C CHECK MT ON-LINE C CALL EXEC(3,600B+MTLU) CALL ABREG(IA,IB) IF(IAND(IA,1).EQ.0) GO TO 188 CALL EXEC(2,ITTY,17HMAG TAPE OFF-LINE,-17) GO TO 177 C C C ASK FOR FILE#, PARSE IPUT AND CONVERT INTO BINARY C THEN FORWARD SPACE IF NEEDED C 188 CALL EXEC(2,ITTY,7HFILE #?,-7) CALL EXEC(1,ITTY+400B,ITEMP,-6) CALL ABREG(IA,IB) LEN=IB IPTR=1 IF(NAMR(IPBUF,ITEMP,LEN,IPTR)) 188,190 190 IF(IAND(IPBUF(4),3).NEQ.1) GO TO 188 NFILE=IPBUF(1)-1 IF(NFILE.EQ.0) GO TO 250 C C NOW FORWARD SPACE TO THE DESIRED FILE C DO 220 I=1,NFILE CALL EXEC(3,MTLU+1300B) 220 CONTINUE C C SKIP THE BACKSPACE FILE C GO TO 250 C C BACKSPACE 1 FILE C C 199 DO 200 I=1,247 200 IHDR(I)=2H C BACKSPACE 1 RECORD CALL EXEC(3,MTLU+0200B) CALL EXEC(3,MTLU+1400B) 201 CALL EXEC(13,MTLU,IST) IF(IAND(IST,100000B).NEQ.0) GO TO 201 IF(IAND(IST,200B).NEQ.0)CALL EXEC(3,MTLU+300B) C C C VERIFYING C 250 CALL EXEC(2,ITTY,9HVERIFYING,-9) C IERROR=0 DO 6000 SUBNO=1,NLSAVE CALL EXEC(1,MTLU,IHDR,247) C PRINT HEADER IF(SUBNO.EQ.1)CALL EXEC(2,LOG+200B,IHDR,-75) MXSEC=ISUBC(1) ISIZE=MXSEC*64+1 MXSEC=MXSEC-1 MXTRK=ISUBC(4) C C C NOW VERIFY ALL TRACKS C DO 300 LTRK=0,MXTRK-1 C READ 1 BLOCK,INIT ERROR FLAG IERFG=0 K=2 CALL EXEC(1,MTLU,IBUF,ISIZE) CALL ABREG(IA,IB) IF(IAND(IA,40B).EQ.40B) CALL EOTAP(ITTY,MTLU,IHDR,IBUF,ISIZE) C C VERIFY 2 SECTRS C DO 350 ISEC=0,MXSEC,4 CALL RDATK (IDLU,LTRK,ISEC,256,ISUBC,VBUF,IER,LOG) CALL COMPR(IBUF(K),IVBUF,256,IER) IF(IER.NEQ.0) IERFG=1 K=K+256 350 CONTINUE C IF(IERFLG.EQ.1) IERROR=1 IF(IERFG.EQ.0) GO TO 300 CALL CNUMD(LTRK,ITEMP) CALL EXEC(2,LOG,21HVERIFY DATA ERROR-TRK,-21) CALL EXEC(2,LOG,ITEMP,-6) 300 CONTINUE C 6000 CONTINUE C IF(IERROR.EQ.0) CALL EXEC(2,LOG,9HVERIFY OK,-9) IF(IERROR.EQ.1) CALL EXEC(2,LOG,12HVERIFY ERROR,-12) C FORWARD SPACE 1 RECORD CALL EXEC(3,MTLU+300B) C 777 CALL LURQ(0,MTLU,1) CALL PRTN(IPARM) C C RETURN MAGTAPE TO ITS PREVIOUS STATE C CALL XMTBU(MTLU,IFLAG) C C UNLOCK PROGRAM C CALL EXEC(22+100000B,0) GO TO 779 778 STOP 77 779 STOP 77 920 CALL EXEC(2,LOG,18HWRITE RING MISSING,-18) GO TO 990 970 CALL EXEC(2,LOG,14H MT XMIT ERROR,-14) GO TO 990 980 CALL EXEC(2,LOG,16H MT PARITY ERROR,-16) GO TO 990 985 CALL EXEC(2,LOG,17H UNSUPPORTED DISC,-17) 990 CALL XMTBU(MTLU,IFLAG) STOP 66 END ����������������������������������������������������������������������������������������������������������������������