FTN4,L
      PROGRAM INSTL() 
     $,  92070-16090  REV. 1941  790911 
C     NAME:   INSTL 
C     SOURCE: 92070-18090 
C     RELOC:  92070-16090 
C     PGMR:   WWL 
C 
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 
      IMPLICIT INTEGER (A-Z)
      INTEGER OBUF(512) 
      COMMON /BOOTX/OBUF
      INTEGER DCB(144),BUF(128) 
      INTEGER DVP(8),SNAM(10),SYNAM(10),BOTNAM(10),TEMP(10) 
      DATA A/40400B/,BOTNAM/2HBO,2HOT,2HEX/ 
C 
C 
C 
      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, BOOT FILE, AND LU.") 
      CALL REIO (1,LOG+400B,BUF,-80)
      CALL ABREG (IA,IB)
      IF (IB .EQ. 0) GO TO 20 
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
      BOTNAM(I)=TEMP(I) 
   50 CONTINUE
C 
   55 CALL NAMR (TEMP,BUF,IB,IV)
      IF (TEMP(1) .EQ. 0) GO TO 20
      LU=TEMP(1)
C 
C     FIRST OPEN SNAP FILE & FIND LU TABLE
C 
      CALL OPEN (DCB,IER,SNAM,0,SNAM(5),SNAM(6))
      IF (IER .GE. 0) GO TO 100 
   60 WRITE(LOG,70)IER,(SNAM(I),I=1,3)
   70 FORMAT(" FMGR",I6," ON ",3A2) 
      GO TO 900 
  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 100 
      IF (BUF(3) .NE. 2HUT) GO TO 100 
      IF (IAND(BUF(4),177400B) .NE. A) GO TO 100
C 
C     FOUND THE LU TABLE SYMBOL 
C 
      SLUT=BUF(6) 
      REC=(SLUT/128)+1
      OFSET=MOD(SLUT,128)+1 
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,0,SYNAM(5),SYNAM(6)) 
      IF (IER .GE. 0) GO TO 150 
  120 WRITE(LOG,70)IER,(SYNAM(I),I=1,3) 
      GO TO 900 
C 
  150 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
      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 
      OBUF(7)=DVP(1)
      OBUF(8)=DVP(2)
      OBUF(9)=DVP(3)
      OBUF(10)=DVP(4) 
      OBUF(11)=DVP(5) 
      OBUF(12)=DVP(6) 
      OBUF(13)=DVP(7) 
      OBUF(14)=DVP(8) 
C 
C     NOW OPEN BOOT FILE. IF NOT THERE, CREATE IT.
C 
      CALL OPEN (DCB,IER,BOTNAM,0,BOTNAM(5),BOTNAM(6))
      IF (IER .EQ. -6) GO TO 450
      IF (IER .GE. 0) GO TO 500 
  400 WRITE(LOG,70)IER,(BOTNAM(I),I=1,3)
      GO TO 900 
C 
  450 CALL CREAT (DCB,IER,BOTNAM,4,1,BOTNAM(5),BOTNAM(6)) 
      IF (IER .LT. 0) GO TO 400 
      GO TO 550 
C 
  500 IF (IER .EQ. 1) GO TO 520 
      WRITE(LOG,510)
  510 FORMAT(" BOOT FILE NOT TYPE 1.")
      GO TO 900 
C 
  520 CALL LOCF (DCB,IER,REC1,IRB,I,SIZE) 
      IF (SIZE .GE. 8) GO TO 550
      WRITE(LOG,530)
  530 FORMAT(" FILE NOT >= 4 BLOCKS.")
      GO TO 900 
C 
  550 CALL WRITF (DCB,IER,OBUF,512) 
      IF (IER .NE. 0) GO TO 400 
      WRITE(LOG,590)(BOTNAM(I),I=1,3) 
  590 FORMAT(" INSTL END. ",3A2," IS YOUR BOOT EXTENSION FILE."/
     $" WARNING: BOOT FILE MUST BE AT CYL 0, SECTOR 0.")
C 
  900 CALL CLOSE (DCB)
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 
      END$
                                                                                                                                        