FTN4,Q,C
      PROGRAM LSAVE(4,60),92067-16344 REV.2026 800501 
C 
C 
C 
C  SOURCE PART NO.: 92067-18344 
C  RELOC. PART NO.: 92067-16344 
C     NAME : LSAVE
C 
C 
C   PROGRAMMER: J.S.W.
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    THIS PROGRAM SAVES ALL TRACKS ON AN LU TO MAG TAPE 
C  ACCORDING TO THE TRACK MAP TABLE DEFINITION.  THE RUN FORMAT:
C 
C  RU,LSAVE,<LOG LU>,<DISC-LU>,<MT LU>,[VE],<TITLE> 
C    WHERE
C        <LOG LU> IS THE LOG DEVICE FOR ERROR MESSAGES
C        <DISC-LU> IS THE DISC LU WHERE DATA ARE SAVED
C        <MT LU>   IS THE MAG TAPE LU 
C        <VE>      VE MEANS VERIFY, OTHERS MEANS NO VERIFY
C        <TITLE>   IS A 50 CHARACTER LABEL SUPPLIED BY USER 
C 
C  VERIFY CAN BE SELECTED AS OPTION.
C 
C  SEQUENCE OF OPERATIONS:
C  1. GETS RUN STRING AND CHECK IF EACH PARATER IS VALID (I.E.DISK LU)
C     IF NO COMMAS IN RUN STRING, ASK PARATERS INTERACTIVELY
C 
C  2  PUTS CURRENT TIME DATE AND DAY ON MT HEADER (IHDR)
C 
C  3. GETS TRACK MAP TABLES BY MAKING SPECIAL EXEC CALL (SUBFUN=2200B)
C     AND PUTS IT IN MT HEADER
C 
C  4. REQUEST MT LU LOCK AND CHECK WRITE RING ON MAG TAPE 
C 
C  5. WRITE OUT HEADRER RECORD ON MAG TAPE (247 WORDS)
C 
C  6. COMPUTE NO. OF TRACKS IN SUBCHANNEL,SECTOR PER TRACK, AND 
C     NO. OF WORDS PER TRACK ( MAG TAPE RECORD SIZE)
C 
C  7. GO THRU ALL TRACKS IN SUBCHHAL, READ ONE TRACK
C     BY USING DISC LIBRARY ROUTINES (CALLING FROM RDATK) 
C     WRITE THE TRACK IN MT.
C 
C  8. IF VERIFY IS DESIRED, BACKSPACE ONE FILE AND READ ONE RECORD
C     THEN COMPARE DATA WITH THE TRACK
C 
C 
C 
      DIMENSION IBUF(1),IXBUF(8208),IVBUF(256), 
     X ISTR(80),IHDR(247),ITME(15),ITX32(161),ISUBC(5),ITEMP(5),
     X IPBUF(10),MSG1(10),IPARM(5)
C 
C 
C 
C 
      EQUIVALENCE 
     X            (ITME,IHDR(1)), 
     X            (ITX32,IHDR(77)), 
     X            (ISUBC(1),IHDR(239)), 
     X            (LU2,IHDR(244)),
     X            (ISTR(1),IHDR(17)), 
     X            (LSAVEN,IHDR(245)), 
     X            (IBUF(1),IXBUF(16)),
     X            (LUSUB,IHDR(246)),
     X            (ITAPE,IHDR(247)) 
C 
C 
      DATA MSG1/2H  ,2H  ,2H  ,2H T,2HRA,2HCK,2HS ,2HSA,
     X   2HVE,2HD / 
C 
C**************************************************************************** 
C 
C GET PARAMETER AND CURRENT TIME
C 
C   CALLING SEQUENCE PARATER
C    ISTR- TITLE OR RU STRING 
C    N=1   INDICATES LSAVE
C    LOG   LOG LU RETURNED
C    IDLU  DISC LU
C    MTLU  MT LU
C    IVERFY =1 FOR VERFIFY NOT =1 NO VERIFY 
C 
C 
      CALL XGTPM(ISTR,1,LOG,IDLU,MTLU,IVRFY)
      CALL FTIME(ITME)
      ITAPE=1 
      IPARM=2H
C 
      ITTY=LOGLU(ISES)
C       MT LU   THE VALUE IS 23 
C 
C 
C GET SUBCHANNEL NO. FROM EQT4  FOR THE DISK
C 
C 
C/
      CALL EXEC(13,IDLU,IEQT5,IEQT4,ISTA3)
      LUSUB=IAND(IEQT4,3700B)/100B
C 
C 
C     UNBUFFER THE MAG TAPE , REMEMBER TO PUT IT BACK LATER 
C 
      IFLAG = 0 
      CALL XMTBU(MTLU,IFLAG)
C 
C 
      CALL EXEC(13,MTLU,IEQT5)
      IF(IAND(IEQT5,37000B)-11000B) 910,1000,910
1000  CONTINUE
C 
C 
      CALL EXEC(13,IDLU,IEQT5)
      IF (IAND(IEQT5,37400B)-15000B) 980,1010,980 
1010  CONTINUE
C 
C GO GET TRACK MAP TABLE ,FIRST THE ENTIRE TABLE AND THEN 
C THE SUBCHANNEL ENTRY (5 WORDS) FOR THIS LU
C 
C 
      CALL EXEC(1,IDLU+2200B,ITX32, 161,0,5)
      CALL EXEC(1,IDLU+2200B,ISUBC, 5,0,5)
C 
C 
      IF(ITX32(1).GT.0) CALL EXEC(2,LOG,17HINVALID TRACK MAP,-17) 
C 
C INDICATES LSAVE AND SET LU 2 OR LU 3 FLAG IF IDLU IS 2 OR 3 
C 
      LSAVEN=1
      IF(IDLU.EQ.2.OR.IDLU.EQ.3) LU2=1
C 
C 
C CHECK WRITE RING
C 
25    CALL EXEC(3,600B+MTLU)
      CALL ABREG(IA,IB) 
      IF(IAND(IA,4B).EQ.4) GO TO 920
C 
C WRITE MT HEADER 
C 
      CALL EXEC(2,MTLU,IHDR,247)
C 
C NOW SET UP SECTORS PER TRACK, NO. OF TRACKS AND TRACK SIZE
      MXSEC=ISUBC(1)
        MXTRK=ISUBC(4)
      ISIZE=MXSEC*64+1
C 
C FOR TRACK NO. ZERO TO LAST TRACK, READ ONE TRACK
C   SET UP TRACK NO. IN IBUF(1), AND WRITE IT ON MAG TAPE 
C   IF END OF TAPE CALL WREOT TO HANDLE IT
C  WHEN DONE WRITE END OF FILE MARK 
C 
C 
C 
C     LOCK THE PROGRAM IN CORE 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 CLEAR  END-OF-TAPE FLAG 
C 
      IEOT=0
      DO 100 LTRK=0,MXTRK-1 
C SAVE TRK #
      IBUF(1)=LTRK
      CALL RDATK(IDLU,LTRK,0,ISIZE-1,ISUBC,IXBUF,IBT,LOG) 
C 
C IF BAD TRACK SET IPARM TO -1 FOR 10 G RETURN
C 
      IF(IBT.EQ.1) IPARM(1)=2H-1
      CALL EXEC(2,MTLU,IBUF,ISIZE)
      CALL ABREG(IS1,LEN) 
      IF(LEN.EQ.0) GO TO 960
      IF(IAND(IS1,2).EQ.2) GO TO 970
      IF(IAND(IS1,40B).EQ.40B) IEOT=1 
      IF(IAND(IS1,40B).EQ.40B) CALL WREOT(ITTY,MTLU,IHDR,IBUF,ISIZE)
100   CONTINUE
C 
      ENDFILE MTLU
C 
C PRINT MESSAGE: XXX TRACKS SAVED 
C CALL PRTN TO RETURN -1 OF 0 IN 10G
C 
      CALL CNUMD(MXTRK,MSG1)
      CALL EXEC(2,LOG+200B,MSG1,-19)
C 
C 
C 
C 
C IF VERIFY, BACKSPACE FILE AND READ ONE TRACK, COMPARE DATA UNTIL
C  LAST TRACK 
C 
C 
      IF(IVRFY.NEQ.1) GO TO 777 
C 
C 
CCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCC
C 
C VERIFY
C 
CCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCC
C 
C CHECK EOF FLAG, IF SET ASK TO REMOUNT TAPE ONE
C 
C 
C 
      IF(IEOT.EQ.0) GO TO 199 
C 
C ASK USER TO RE-MOUNT TAPE 1 AND ENTER FILE #
C 
177   CALL EXEC(2,ITTY, 
     X  26HRE-MOUNT TAPE #1 FOR VERFY,-26)
      CALL EXEC(2,ITTY, 
     X  26HTHEN TYPE "GO" TO CONTINUE,-26)
      CALL EXEC(1,ITTY+400B,I,-2) 
      IF(I.NEQ.2HGO) GO TO 177
C 
C CHECK IF MT IS 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 INPUT AND CONVERT INTO BINARY 
C  THEN FORWARD SPACE N FILES 
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
      DO 220 I=1,NFILE
      CALL EXEC(3,MTLU+1300B) 
220   CONTINUE
C 
C SKIP THE BACK SPACE FILE
C 
      GO TO 250 
C 
C 
C 
199   DO 200 I=1,247
200   IHDR(I)=2H
C  BACKSPACE 1 FILE - BF AND BR 
C   THEN CHECK IF MT IS STILL BUSY BY DOING DYNAMIC STATUS
C 
C 
      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  VERIFYING
C 
250   CALL EXEC(2,ITTY,9HVERIFYING,-9)
C 
C READ HEADER FORM TAPE 
C 
      CALL EXEC(1,MTLU,IHDR,247)
C 
C PRINT HEADER
C 
      CALL EXEC(2,LOG+200B,IHDR,-75)  
C 
C SET UP SECTOR PER TRACK, TRACK SIZE 
C 
      MXSEC=ISUBC(1)
      ISIZE=MXSEC*64+1
      MXSEC=MXSEC-1 
      MXTRK=ISUBC(4)
      IERROR=0
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 SECTORS
C 
      DO 350 ISEC=0,MXSEC,4 
      CALL EXEC(1+100000B,IDLU,IVBUF,256,LTRK,ISEC) 
      GO TO 360 
340   CALL COMPR(IBUF(K),IVBUF,256,IER) 
      IF(IER.NEQ.0) IERFG=1 
      K=K+256 
350   CONTINUE
C 
D     WRITE(1,8000) LTRK
D8000 FORMAT("TRK ",I8) 
C 
C 
      IF(IERFG.EQ.0) GO TO 300
360   IERROR=1
      CALL CNUMD(LTRK,ITEMP)
      CALL EXEC(2,LOG,21HVERIFY DATA ERROR-TRK,-21) 
      CALL EXEC(2,LOG,ITEMP,-6) 
300   CONTINUE
C 
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 EXEC(22+100000B,0) 
      GO TO 779 
  778 CALL PRTN(IPARM)
  779 CALL XMTBU(MTLU,IFLAG)
      STOP 77 
910   CALL EXEC(2,LOG,12HINVALID MTLU,-12)
      STOP
920   CALL EXEC(2,LOG,18HWRITE RING MISSING,-18)
      GO TO 990 
930   CALL EXEC(2,LOG,15HINVALID DISK LU,-15) 
      GO TO 990 
960   CALL EXEC(2,LOG,14H MT XMIT ERROR,-14)
      GO TO 990 
970   CALL EXEC(2,LOG+200B,16H MT PARITY ERROR,-16) 
      GO TO 990 
980   CALL EXEC(2,LOG+200B,17H UNSUPPORTED DISC,-17)
990   CALL XMTBU(MTLU,IFLAG)
      STOP 66 
      END