FTN4,Q,C,T
      PROGRAM INSTL() 
     $, 92071-16090 REV.2041 780728 
C     NAME:   INSTL 
C     SOURCE: 92071-18090 
C     RELOC:  92071-16090 
C     PGMR:   WWL,DLM 
C 
C 
C  **************************************************************** 
C  * (C) COPYRIGHT HEWLETT-PACKARD COMPANY 1980.  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 
      IMPLICIT INTEGER (A-Z)
      INTEGER OBUF(128) 
      INTEGER DCB(144),BUF(128),WRDCB(144)
      INTEGER DVP(8),SNAM(10),SYNAM(10),BOTNAM(10),TEMP(10) 
      INTEGER DEST(10),PROGNM(3)
      LOGICAL SAME,TIME1,LGLFL,UPDATE 
      DATA DEST/2HBO,2HOT,2HEX,0,-32767,0/
C 
C 
C 
      CALL PNAME(PROGNM)
      CALL GETST (BUF,-80,IB) 
      LOG=LOGLU(ISES) 
      IF (IB .GT. 0) GO TO 40 
   20 WRITE(LOG,30) 
   30 FORMAT(" ENTER SNAP FILE, SYSTEM FILE, DESTINATION FILE, LU," 
     $" AND SOURCE FILE ")
      CALL REIO (1,LOG+400B,BUF,-80)
      CALL ABREG (IA,IB)
      IF (IB .EQ. 0) GO TO 900
C 
   40 IV=1
      CALL NAMR (SNAM,BUF,IB,IV)
      CALL NAMR (SYNAM,BUF,IB,IV) 
      CALL NAMR (TEMP,BUF,IB,IV)
      IF (TEMP(1) .EQ. 0) GO TO 55
      DO 50 I=1,10
      DEST(I)=TEMP(I) 
   50 CONTINUE
C 
   55 CALL NAMR (TEMP,BUF,IB,IV)
      IF ((IAND(TEMP(4),3)).NE.1) GOTO 189
      IF (TEMP(1).EQ.0) GOTO 189
      LU=IABS(TEMP(1))
      IF ((DEST(6).EQ.0).AND.(SYNAM(1).EQ.0).AND.(SNAM(1).EQ.0))
     $ DEST(6)=0-LU 
C GET THE SOURCE FILE 
      SAME=.FALSE.
      CALL NAMR(BOTNAM,BUF,IB,IV) 
      IF (BOTNAM(1).NE.0) GOTO 57 
      SAME=.TRUE. 
      DO 56 I=1,10
   56 BOTNAM(I)=DEST(I) 
C 
   57 SYSTEM=OPSYS(I) 
      IF(.NOT.(((SYNAM(1).EQ.0).AND.(SNAM(1).EQ.0)) .AND. 
     $((SYSTEM.EQ.-31).OR.(SYSTEM.EQ.-29)))) GOTO 59
C 
C GET THE PARAMTERS VIA AN EXEC CALL
C 
      CALL EXEC(100015B,10000B+LU,STAT1,STAT2,DVP,8)
      GOTO 189
 1000 TYPE=(IAND(STAT1,37400B)/256) 
      IF((TYPE .LT. 30B) .OR. (TYPE .GT. 37B)) GOTO 189 
      GOTO 399
C 
C     FIRST OPEN SNAP FILE & FIND LU TABLE
C 
   59 CALL OPEN (DCB,IER,SNAM,0,SNAM(5),SNAM(6))
      IF (IER .GE. 0) GO TO 95
   60 WRITE(LOG,70)IER,(SNAM(I),I=1,3)
   70 FORMAT(" FMGR",I6," ON ",3A2) 
      GO TO 900 
C 
C NOW OPEN SNAP FILE AND GET CHECKSUMS
C 
   95 IF(IER .NE. 3) GOTO 77
      IF(READF(DCB,IER,BUF,128,LEN).LT.0) GOTO 60 
      IF(LEN .EQ. 20) GOTO 96 
   77 WRITE(LOG,78) 
   78 FORMAT(" ILLEGAL SNAP "/) 
      GOTO 900
   96 CKSM=BUF(9) 
      SCCK=BUF(10)
C 
      DO 106 J=1,4,1
  100 CALL READF (DCB,IER,BUF,128,LEN)
      IF (IER .NE. 0) GO TO 60
      IF (LEN .LT. 0) GO TO 60
      IF(BUF(2) .NE. 2H$L) GO TO 103
      IF(BUF(3) .NE. 2HUT) GO TO 103
      IF(BUF(4) .NE. 2HA ) GO TO 102
      SLUT=BUF(6) 
      GOTO 106
C 
  102 IF(BUF(4) .NE. 2H# ) GOTO 103 
      SLUTN=BUF(6)
      GOTO 106
C 
 103  IF(BUF(2) .NE. 2H$C) GOTO 105 
      IF(BUF(3) .NE. 2HKS) GOTO 105 
      IF(BUF(4) .NE. 2HM ) GOTO 105 
      SCKSM=BUF(6)
      GOTO 106
C 
 105  IF(BUF(2) .NE. 2H$S ) GOTO 100
      IF(BUF(3) .NE. 2HCC ) GOTO 100
      IF(BUF(4) .NE. 2HK  ) GOTO 100
      SSCCK=BUF(6)
 106  CONTINUE
C 
C     NOW CLOSE THE SNAP FILE, OPEN THE SYSTEM FILE, AND
C       FIND THE DVT FOR THIS LU
C 
      CALL CLOSE (DCB)
      CALL OPEN (DCB,IER,SYNAM,4B,SYNAM(5),SYNAM(6))
      IF (IER .GE. 0) GO TO 125 
  120 WRITE(LOG,70)IER,(SYNAM(I),I=1,3) 
      GO TO 900 
C 
  125 CALL DSKAD(REC,OFSET,SCKSM) 
      IF(READF(DCB,IER,BUF,128,LEN,REC).LT.0) GOTO 120
      IF(BUF(OFSET).NE.CKSM) GOTO 140 
C 
  130 CALL DSKAD(REC,OFSET,SSCCK) 
      IF(READF(DCB,IER,BUF,128,LEN,REC).LT.0) GOTO 120
      IF(BUF(OFSET).EQ.SCCK) GOTO 150 
C 
  140 WRITE(LOG,71) 
   71 FORMAT("  SYSTEM NOT FOR THIS SNAPSHOT"/) 
      GOTO 900
C 
  150 CALL DSKAD(REC,OFSET,SLUTN) 
      IF(READF(DCB,IER,BUF,128,LEN,REC).LT.0) GOTO 120
      IF(LU .GT. BUF(OFSET)) GOTO 189 
C 
      CALL DSKAD(REC,OFSET,SLUT)
      CALL READF (DCB,IER,BUF,128,LEN,REC)
      IF (IER .NE. 0) GO TO 120 
      DVTA=BUF(OFSET)+LU
      REC=DVTA/128+1
      OFSET=MOD(DVTA,128) 
C 
      CALL READF (DCB,IER,BUF,128,LEN,REC)
      IF (IER .NE. 0) GO TO 120 
      CALL FDVT (BUF,OFSET,REC1,OFST1,6)
      CALL FDVT (BUF,OFSET,REC2,OFST2,23) 
      CALL READF (DCB,IER,BUF,128,LEN,REC1) 
      IF (IER .NE. 0) GO TO 120 
      TYPE=IAND(BUF(OFST1),37400B)/256
      IF ((TYPE .GE. 30B) .AND. (TYPE .LE. 37B)) GO TO 200
  189 WRITE(LOG,190)LU
  190 FORMAT(" LU",I4," IS NOT A DISC LU.") 
      GO TO 900 
C 
  200 N=1 
  300 CALL READF (DCB,IER,BUF,128,LEN,REC2) 
      IF (IER .NE. 0) GO TO 120 
      DO 320 I=N,8
      IF (OFST2 .GT. 128) GO TO 330 
      DVP(I)=BUF(OFST2) 
      OFST2=OFST2+1 
  320 CONTINUE
      GO TO 350 
C 
C     GO HERE IF SOME OF THE PARMS ARE IN NEXT RECORD 
C 
  330 N=I 
      REC2=REC2+1 
      OFST2=1 
      GO TO 300 
C 
C     GOT'EM ALL. NOW CLOSE SYSTEM FILE.
C 
  350 CALL CLOSE (DCB)
C 
C 
C     NOW OPEN BOOT FILE. 
C 
  399 CALL OPEN (DCB,IER,BOTNAM,0,BOTNAM(5),BOTNAM(6))
      IF (IER .GE. 0) GO TO 500 
  400 WRITE(LOG,80)IER,(BOTNAM(I),I=1,3)
      GO TO 900 
   80 FORMAT(" FMGR ",I6," ON BOOT SOURCE ",3A2)
C 
C 
  500 IF (IER .EQ. 1) GO TO 515 
      WRITE(LOG,510)
  510 FORMAT(" BOOT SOURCE FILE NOT TYPE 1. ")
      GO TO 900 
  515 IF(LOCF(DCB,IER,REC,IRB,IOFF,SIZE).LT.0) GOTO 400 
      IF (SIZE.GE.512) GOTO 518 
  517 WRITE(LOG,85) 
   85 FORMAT(" ILLEGAL SOURCE FILE ") 
      GOTO 900
C 
  518 IF(READF(DCB,IER,OBUF,128,IL,256).LT.0) GOTO 521
      LGLFL=OBUF(128).EQ.46062B 
      IF(READF(DCB,IER,OBUF,128,IL,1).LT.0)GOTO 521 
      IF(OBUF(3).NE.124003B) GOTO 517 
C 
      TIME1=.TRUE.
      DO 519 I=101B,111B,1
  519 IF(OBUF(I).NE.0) TIME1=.FALSE.
      IF((.NOT.(LGLFL)).AND.(.NOT.(TIME1))) GOTO 517
C 
C NOW OPEN DESTINATION FILE. IF NOT THERE, CREATE IT
C 
  520 IF(OPEN(WRDCB,IER,DEST,0,DEST(5),DEST(6)).EQ.-6) GOTO 526 
      IF (IER.GE.0) GOTO 523
  521 WRITE(LOG,90)IER,(DEST(I),I=1,3)
   90 FORMAT(" FMGR ",I6," ON BOOT DESTINATION FILE ",3A2)
      GOTO 900
C 
  523 IF(IER.EQ.1) GOTO 524 
      WRITE(LOG,92) 
      GOTO 900
   92 FORMAT(" DESTINATION FILE NOT TYPE 1 ") 
C 
  524 IF(LOCF(WRDCB,IER,REC,IRB,IOFF,SIZE).LT.0)GOTO 521
      IF(SIZE.GE.512)GOTO 530 
      WRITE(LOG,93) 
   93 FORMAT(" DESTINATION FILE NOT => 256 BLKS ")
      GOTO 900
C 
  526 IF(CREAT(WRDCB,IER,DEST,256,1,DEST(5),DEST(6)).LT.0)
     $GOTO 521
C 
C WRITE THE DRIVER PARAMETERS INTO THE FILE 
  530 OBUF(1)=0 
      OBUF(2)=0 
      OBUF(101B)=DVP(1) 
      OBUF(102B)=DVP(2) 
      OBUF(103B)=DVP(3) 
      OBUF(104B)=DVP(4) 
      OBUF(105B)=DVP(5) 
      OBUF(106B)=DVP(6) 
      OBUF(107B)=DVP(7) 
      OBUF(110B)=DVP(8) 
      OBUF(111B)=TYPE 
C 
  550 CALL WRITF (WRDCB,IER,OBUF,128,1) 
      IF (IER .NE. 0) GO TO 521 
C IS IT THE SAME FILE. IF SO, DON'T DO ANY MORE, BUT FIRST
C CHECK THAT THIS IS THE FIRST TIME 
      IF(SAME) I=256
      IF(SAME) GOTO 559 
C 
C CONTINUE FOR THE REST OF THE FILE 
C 
      DO 570 I=2,256,1
  559 IF(READF(DCB,IER,OBUF,128,IL,I).LT.0)GOTO 400 
      UPDATE=TIME1.AND.(I.EQ.256) 
      IF(UPDATE)OBUF(128)=46062B
      IF(UPDATE) CALL WRITF(DCB,IER,OBUF,128,I) 
      IF(UPDATE.AND.(IER.LT.0)) GOTO 400
      IF(WRITF(WRDCB,IER,OBUF,128,I).LT.0)GOTO 521
  570 CONTINUE
C 
      WRITE(LOG,590)(PROGNM(J),J=1,3),(DEST(I),I=1,3) 
  590 FORMAT(" ",3A2," END. ",3A2," IS YOUR BOOT EXTENSION FILE."/
     $" WARNING: BOOT FILE MUST BE AT CYL 0, SECTOR 0.")
C 
  900 CALL CLOSE (DCB)
      CALL CLOSE (WRDCB)
C 
      END 
C 
      SUBROUTINE FDVT (BUF,OFSET,REC,OFST1,NTRY)
      INTEGER BUF(128),REC,OFSET,OFST1,DVTA 
C 
      DVTA=BUF(OFSET) 
      REC=DVTA/128+1
      OFST1=MOD(DVTA,128)+NTRY
   10 IF (OFST1 .LE. 128) RETURN
      REC=REC+1 
      OFST1=OFST1-128 
      GO TO 10
      END 
      SUBROUTINE DSKAD(BLK,OFSET,PARM)
      INTEGER BLK,OFSET,PARM
      BLK=(PARM/128)+1
      OFSET=MOD(PARM,128)+1 
      RETURN  
      END 
      END$