       IDENTIFICATION DIVISION.
       PROGRAM-ID.        LBN_LOCATOR.
       ENVIRONMENT DIVISION.
       CONFIGURATION SECTION.
       SPECIAL-NAMES.
               SYMBOLIC CHARACTERS TWO-FIFTY-FIVE IS 256.
       INPUT-OUTPUT SECTION.
       FILE-CONTROL.
           SELECT INDEXF ASSIGN TO INDEXF
               FILE STATUS IS MSD-STATUS.
       DATA DIVISION.
       FILE SECTION.
000100 FD  INDEXF
               LABEL RECORDS ARE STANDARD
               RECORD CONTAINS 512 CHARACTERS.
000500 01  HOME-BLOCK-RECORD.
           02  HB-HOME-BLOCK-LBN        PIC S9(09) COMP.
           02  HB-ALT-HOM-BLOCK-LBN     PIC S9(09) COMP.
           02  HB-ALT-INDEXF-HEADER-LBN PIC S9(09) COMP.
           02  HB-STRUCT-1              PIC X(01).
           02  HB-STRUCT-2              PIC X(01).
           02  HB-CLUSTER               PIC S9(04) COMP.
           02  HB-HOME-BLOCK-VBN        PIC S9(04) COMP.
           02  HB-ALT-HOME-BLOCK-VBN    PIC S9(04) COMP.
           02  HB-ALT-INDEXF-HEADER-VBN PIC S9(04) COMP.
           02  HB-BITMAP-VBN            PIC S9(04) COMP.
           02  HB-BITMAP-LBN            PIC S9(09) COMP.
           02  HB-MAX-FILES             PIC S9(09) COMP.
           02  HB-INDEXF-BITMAP-SIZE    PIC S9(04) COMP.
           02  HB-NO-RESERVED-FILES     PIC S9(04) COMP.
           02  HB-DEVICE-TYPE           PIC S9(04) COMP.
           02  HB-RVN                   PIC S9(04) COMP.
           02  HB-NO-VOLS-IN-SET        PIC S9(04) COMP.
           02  HB-VOLUME-CHARS          PIC S9(04) COMP.
           02  HB-UIC-MEMBER            PIC S9(04) COMP.
           02  HB-UIC-GROUP             PIC S9(04) COMP.
           02  FILLER                   PIC X(412).
           02  HB-VOL-SET-NAME          PIC X(12).
           02  HB-VOLUME-NAME           PIC X(12).
           02  HB-OWNER-NAME            PIC X(12).
           02  HB-FORMAT                PIC X(12).
           02  FILLER                   PIC X(04).
000500 01  INDEXF-RECORD.
000600     02  IDXF-FIRST-WORD		PIC S9(04)    COMP.
000600     02  FILLER   		PIC X(78).
000700     02  IDXF-FILE-NAME-PART1     PIC X(20).
000600     02  FILLER   		PIC X(34).
000700     02  IDXF-FILE-NAME-PART2     PIC X(66).
           02  FILLER                   PIC X(310).
           02  IDXF-LAST-WORD           PIC S9(04)    COMP.
       WORKING-STORAGE SECTION.
           COPY EDCOMAND.
       01  IDXF-RETRIEVAL-POINTERS.
           02  IDXF-RP-WORD            PIC 9(04)    COMP
                                            OCCURS 206 TIMES.
       01  FILLER.
           02  MSD-STATUS              PIC X(02).
           02  FILE-NAME               PIC X(86).
           02  RECORD-COUNT            PIC 9(06).
           02  FIRST-DATA-RECORD       PIC 9(03).
           02  PRINT-PASS              PIC X(01).
           02  SUB                     PIC 9(03).
           02  SUBX                    PIC 9(03).
           02  SUBZ                    PIC 9(03).
           02  CHECKSUM-SUB            PIC 9(03).
           02  XLBN                    PIC X(09).
           02  LBN                     PIC 9(09).
           02  CALCULATING             PIC X(01).
           02  XCYLINDER               PIC X(04).
           02  NCYLINDER               PIC 9(04).
           02  XHEADS                  PIC X(04).
           02  NHEADS                  PIC 9(04).
           02  XSECTORS                PIC X(04).
           02  NSECTORS                PIC 9(04).
           02  XTRACK                  PIC X(04).
           02  NTRACK                  PIC 9(04).
           02  XSECTOR-TO-CONVERT      PIC X(04).
           02  NSECTOR-TO-CONVERT      PIC 9(04).
           02  FIRST-PRODUCT           PIC 9(09).
           02  SECOND-PRODUCT          PIC 9(09).
           02  DLBN                    PIC ZZZZZZZZ9.
           02  FORMAT-TYPE             PIC 9(04).
               88 NO-FORMAT                VALUE 0000.
               88 FORMAT-IS-TWO            VALUE 0010.
               88 FORMAT-IS-FOUR           VALUE 0100.
               88 FORMAT-IS-EIGHT          VALUE 1000.
               88 FORMAT-IS-TWELVE         VALUE 1100.
           02  FILLER REDEFINES FORMAT-TYPE.
               03  FORMAT-CHAR         PIC 9(01) OCCURS 4 TIMES.
           02  VALUE-CHECK             PIC 9(09).
           02  NUMBER-OF-BLOCKS        PIC 9(09).
           02  LOW-LBN                 PIC 9(09).
           02  HIGH-LBN                PIC 9(09).
           02  BINARY-CHECKSUM         PIC S9(09) COMP.
           02  CHECKSUM                PIC S9(09).
           02  REAL-BINARY-WORD        PIC 9(04) COMP.
************************************************************************
*********** I KNOW THIS ISN'T REALLY A WORD, BUT I'M CHEATING **********
************************************************************************
           02  BINARY-WORD             PIC 9(09) COMP.
           02  FILLER REDEFINES BINARY-WORD.
               03  BINARY-W-BYTE1      PIC X(01).
               03  BINARY-W-BYTE2      PIC X(01).
               03  FILLER              PIC X(02).
           02  FILLER REDEFINES BINARY-WORD.
               03  BINARY-W-LOW-WORD   PIC 9(04) COMP.
               03  BINARY-W-HIGH-WORD  PIC 9(04) COMP.
************************************************************************
           02  BINARY-LONGWORD         PIC 9(09) COMP.
           02  FILLER REDEFINES BINARY-LONGWORD.
               03  BINARY-LW-LOW-WORD  PIC 9(04) COMP.
               03  FILLER REDEFINES BINARY-LW-LOW-WORD.
                   04  BINARY-LW-BYTE1 PIC X(01).
                   04  BINARY-LW-BYTE2 PIC X(01).
               03  BINARY-LW-HIGH-WORD PIC 9(04) COMP.
               03  FILLER REDEFINES BINARY-LW-HIGH-WORD.
                   04  BINARY-LW-BYTE3 PIC X(01).
                   04  BINARY-LW-BYTE4 PIC X(01).

           02  POS                     PIC 9(09)  COMP.
           02  SRC                     PIC 9(09) COMP VALUE 0.
           02  EFN_FLAG_VALUE          PIC 9(09)  COMP.
           02  DISPLAY-FLAGS.
               03  DISPLAY_FLAG_VALUE  PIC 9(01) OCCURS 32 TIMES.
           02  REPLY                   PIC X(01).
           02  NUMBER-OF-BITS-TO-SET   PIC 9(04)  COMP.
           02  NUMBER-OF-BITS-TO-GET   PIC 9(04)  COMP VALUE 1.
           02  TBL-IND                 PIC S9(09)          COMP
                                   VALUE EXTERNAL LIB$K_CLI_GLOBAL_SYM.
           02  STAT                    PIC S9(09)          COMP.
           02  DISK-DEVICE             PIC X(26).
           02  VOLUME-FLAG             PIC X(01).
               88  VOLUME-SET              VALUE "Y".
               88  SINGLE-DISK             VALUE "N".
           02  CLR-ATT.
               03  FILLER              PIC S9(04) COMP VALUE 27.
               03  FILLER              PIC S9(04) COMP VALUE 91.
               03  FILLER              PIC S9(04) COMP VALUE 48.
               03  FILLER              PIC S9(04) COMP VALUE 109.
           02  WBOLD.
               03  FILLER              PIC S9(04) COMP VALUE 27.
               03  FILLER              PIC S9(04) COMP VALUE 91.
               03  FILLER              PIC S9(04) COMP VALUE 49.
               03  FILLER              PIC S9(04) COMP VALUE 109.
           02  WBLINK.
               03  FILLER              PIC S9(04) COMP VALUE 27.
               03  FILLER              PIC S9(04) COMP VALUE 91.
               03  FILLER              PIC S9(04) COMP VALUE 53.
               03  FILLER              PIC S9(04) COMP VALUE 109.
       01  DISPLAY-LINE.
           02  DLINE                   PIC X(75).
           02  FILLER REDEFINES DLINE.
               03  FILLER              PIC X(14).
               03  DFILE-NAME          PIC X(61).
           02  FILLER REDEFINES DLINE.
               03  FILLER              PIC X(20).
               03  DCOUNT-HDR          PIC X(10).
               03  DCOUNT              PIC ZZZZZZ9.
               03  FILLER              PIC X(08).
               03  DLBN-HDR            PIC X(08).
               03  DLBN-BASE           PIC ZZZZZZ9-.
               03  FILLER              PIC X(14).
       PROCEDURE DIVISION.
       DECLARATIVES.
       FIXA SECTION 00.
           USE AFTER STANDARD ERROR PROCEDURE ON I-O.
       FIX1.
           IF MSD-STATUS = 02 OR MSD-STATUS = 90 OR MSD-STATUS = 92
               NEXT SENTENCE
           ELSE
               DISPLAY " "
               DISPLAY "*****************************"
               DISPLAY "*                           *"
               DISPLAY "*     FILE I/O ERROR " MSD-STATUS "     *"
               DISPLAY "*                           *"
               DISPLAY "*****************************"
               DISPLAY " "
               STOP RUN.
       FIX-EXIT.
           EXIT.
       END DECLARATIVES.
       MAIN SECTION 00.
       GET-VOLUME-FLAG.
           MOVE " " TO XLBN.
           MOVE "N" TO CALCULATING.
       ASK-FOR-LBN.
           MOVE 0 TO LBN.
           IF XLBN = "CALC"
               NEXT SENTENCE
           ELSE
               DISPLAY " "
               DISPLAY WBOLD "ENTER LOGICAL BLOCK NUMBER. " CLR-ATT
                                                      WITH NO ADVANCING
               ACCEPT XLBN
               IF XLBN = " "
                   GO TO E-O-J.
           IF XLBN = "CALC"
               PERFORM CALCULATE-LBN-RTN THRU CALCULATE-LBN-RTN-EXIT
           ELSE
               MOVE XLBN TO ENTERED-NUMBER
               MOVE 00 TO EDIT-COMMAND
               PERFORM EDIT-RTN THRU EDIT-RTN-EXIT
               IF GOOD-BAD = "B"
                   DISPLAY " "
                   DISPLAY WBOLD WBLINK "***** INVALID LBN ENTRY *****"
                                                                 CLR-ATT
                   GO TO ASK-FOR-LBN
               ELSE
                   MOVE GOOD-NUMBER TO LBN.
           MOVE LBN TO DLBN.
       SEARCH-FOR-LBN.
           MOVE 0 TO RECORD-COUNT.
           MOVE 2 TO FIRST-DATA-RECORD.
           OPEN INPUT INDEXF ALLOWING ALL.
           DISPLAY " ".
           DISPLAY "Searching for LBN " WBOLD DLBN CLR-ATT 
                                      ".  This may take a while  . . .".
       READ-INDEXF.
           READ INDEXF AT END
               DISPLAY " " 
               DISPLAY WBOLD "***** COULD NOT FIND LBN SPECIFIED *****"
                                                                 CLR-ATT
               CLOSE INDEXF
               GO TO ASK-FOR-LBN.
           ADD 1 TO RECORD-COUNT.
           IF RECORD-COUNT < FIRST-DATA-RECORD
               GO TO READ-INDEXF.
           IF RECORD-COUNT = 2
               ADD HB-BITMAP-VBN HB-INDEXF-BITMAP-SIZE
                                               GIVING FIRST-DATA-RECORD
               GO TO READ-INDEXF.
           IF IDXF-LAST-WORD = 0
               GO TO READ-INDEXF.
           MOVE " " TO IDXF-RETRIEVAL-POINTERS.
           IF IDXF-FIRST-WORD = 25640 AND PRINT-PASS = "Y"
               CLOSE INDEXF
               MOVE "N" TO PRINT-PASS
               GO TO ASK-FOR-LBN.
           IF IDXF-FIRST-WORD = 25640
               MOVE 156 TO CHECKSUM-SUB
               MOVE INDEXF-RECORD (201:310) TO IDXF-RETRIEVAL-POINTERS
           ELSE
               IF PRINT-PASS = "N"
                   GO TO READ-INDEXF
               ELSE
                   IF IDXF-FIRST-WORD = 12840
                       MOVE 206 TO CHECKSUM-SUB
                       MOVE INDEXF-RECORD (101:410) TO
                                                 IDXF-RETRIEVAL-POINTERS
                   ELSE
************************************************************************
*************  IF YOU WANT TO SEE WHERE THAT FIRST WORD IS  ************
************************************************************************
      *                 DISPLAY " "
      *                 DISPLAY WBOLD WBLINK "***** UNKNOWN FIRST WORD 
      *-                                                 "*****" CLR-ATT
      *                 DISPLAY WBOLD WBLINK "***** RECORD COUNT = "
      *                                    RECORD-COUNT " *****" CLR-ATT
************************************************************************
                       GO TO READ-INDEXF.
           IF IDXF-RP-WORD (1) = 0
                   OR IDXF-RETRIEVAL-POINTERS (1:2) = TWO-FIFTY-FIVE
               GO TO READ-INDEXF.
           MOVE 0 TO SUB.
           IF CHECKSUM-SUB = 156
               MOVE "N" TO PRINT-PASS.
           PERFORM RETRIEVE-POINTER-RTN THRU RETRIEVE-POINTER-RTN-EXIT.
           IF PRINT-PASS = "Y"
               DISPLAY " "
               MOVE "               Checksum:" TO DLINE
               MOVE IDXF-LAST-WORD TO CHECKSUM
               MOVE CHECKSUM TO DLBN-BASE
               DISPLAY WBOLD DLINE CLR-ATT
               DISPLAY " ".
           GO TO READ-INDEXF.
       E-O-J.
           STOP RUN.

       CALCULATE-LBN-RTN.
           MOVE 0 TO FIRST-PRODUCT
                     SECOND-PRODUCT.
           IF CALCULATING = "Y"
               GO TO GET-SECTOR-TO-CONVERT.
        GET-NUMBER-OF-HEADS.
           MOVE " " TO XHEADS.
           MOVE 0 TO NHEADS.
           DISPLAY " ".
           DISPLAY WBOLD "ENTER NUMBER OF HEADS. " CLR-ATT
                                                      WITH NO ADVANCING.
           ACCEPT XHEADS.
           IF XHEADS = " "
               MOVE " " TO XLBN
               GO TO ASK-FOR-LBN.
           MOVE XHEADS TO ENTERED-NUMBER.
           MOVE 00 TO EDIT-COMMAND.
           PERFORM EDIT-RTN THRU EDIT-RTN-EXIT.
           IF GOOD-BAD = "B"
               DISPLAY " "
               DISPLAY WBOLD WBLINK "***** INVALID HEAD ENTRY *****"
                                                                 CLR-ATT
               GO TO GET-NUMBER-OF-HEADS.
           MOVE GOOD-NUMBER TO NHEADS.
        GET-NUMBER-OF-SECTORS.
           MOVE " " TO XSECTORS.
           MOVE 0 TO NSECTORS.
           DISPLAY " ".
           DISPLAY WBOLD "ENTER NUMBER OF SECTORS. " CLR-ATT
                                                      WITH NO ADVANCING.
           ACCEPT XSECTORS.
           IF XSECTORS = " "
               GO TO GET-NUMBER-OF-HEADS.
           MOVE XSECTORS TO ENTERED-NUMBER.
           MOVE 00 TO EDIT-COMMAND.
           PERFORM EDIT-RTN THRU EDIT-RTN-EXIT.
           IF GOOD-BAD = "B"
               DISPLAY " "
               DISPLAY WBOLD WBLINK "***** INVALID SECTOR ENTRY *****"
                                                                 CLR-ATT
               GO TO GET-NUMBER-OF-SECTORS.
           MOVE GOOD-NUMBER TO NSECTORS.
        GET-SECTOR-TO-CONVERT.
           MOVE "Y" TO CALCULATING.
           MOVE " " TO XSECTOR-TO-CONVERT.
           MOVE 0 TO NSECTOR-TO-CONVERT.
           DISPLAY " ".
           DISPLAY WBOLD "ENTER SECTOR TO CONVERT. " CLR-ATT 
                                                   WITH NO ADVANCING.
           ACCEPT XSECTOR-TO-CONVERT.
           IF XSECTOR-TO-CONVERT = " "
               MOVE " " TO XLBN
               MOVE "N" TO CALCULATING
               GO TO ASK-FOR-LBN.
           MOVE XSECTOR-TO-CONVERT TO ENTERED-NUMBER.
           MOVE 00 TO EDIT-COMMAND.
           PERFORM EDIT-RTN THRU EDIT-RTN-EXIT.
           IF GOOD-BAD = "B"
               DISPLAY " "
               DISPLAY WBOLD WBLINK "***** INVALID SECTOR ENTRY *****"
                                                                 CLR-ATT
               GO TO GET-SECTOR-TO-CONVERT.
           MOVE GOOD-NUMBER TO NSECTOR-TO-CONVERT.
        GET-TRACK.
           MOVE " " TO XTRACK.
           MOVE 0 TO NTRACK.
           DISPLAY " ".
           DISPLAY WBOLD "ENTER TRACK. " CLR-ATT WITH NO ADVANCING.
           ACCEPT XTRACK.
           IF XTRACK = " "
               GO TO GET-SECTOR-TO-CONVERT.
           MOVE XTRACK TO ENTERED-NUMBER.
           MOVE 00 TO EDIT-COMMAND.
           PERFORM EDIT-RTN THRU EDIT-RTN-EXIT.
           IF GOOD-BAD = "B"
               DISPLAY " "
               DISPLAY WBOLD WBLINK "***** INVALID TRACK ENTRY *****"
                                                                 CLR-ATT
               GO TO GET-TRACK.
           MOVE GOOD-NUMBER TO NTRACK.
        GET-CYLINDER.
           MOVE " " TO XCYLINDER.
           MOVE 0 TO NCYLINDER.
           DISPLAY " ".
           DISPLAY WBOLD "ENTER CYLINDER. " CLR-ATT WITH NO ADVANCING.
           ACCEPT XCYLINDER.
           IF XCYLINDER = " "
               GO TO GET-TRACK.
           MOVE XCYLINDER TO ENTERED-NUMBER.
           MOVE 00 TO EDIT-COMMAND.
           PERFORM EDIT-RTN THRU EDIT-RTN-EXIT.
           IF GOOD-BAD = "B"
               DISPLAY " "
               DISPLAY WBOLD WBLINK "***** INVALID CYLINDER ENTRY *****"
                                                                 CLR-ATT
               GO TO GET-CYLINDER.
           MOVE GOOD-NUMBER TO NCYLINDER.
        CALCULATE-LBN.
           COMPUTE LBN = ((NCYLINDER * NHEADS * NSECTORS)
                                  + (NTRACK * NSECTORS)
                                         + NSECTOR-TO-CONVERT).
       CALCULATE-LBN-RTN-EXIT.
           EXIT.
       RETRIEVE-POINTER-RTN.
           ADD 1 TO SUB.
           IF SUB > (CHECKSUM-SUB - 1)
               GO TO RETRIEVE-POINTER-RTN-EXIT.
           MOVE 0 TO FORMAT-TYPE.
           MOVE 0 TO BINARY-WORD.
           IF IDXF-RP-WORD (SUB) = 0
               GO TO RETRIEVE-POINTER-RTN-EXIT.
           MOVE IDXF-RP-WORD (SUB) TO BINARY-W-LOW-WORD.
           MOVE 4 TO SUBX.
           PERFORM VARYING POS FROM 12 BY 1 UNTIL POS > 15
               CALL "LIB$EXTZV" USING BY REFERENCE POS
                                                   NUMBER-OF-BITS-TO-GET
                                                   BINARY-WORD
                                GIVING EFN_FLAG_VALUE
               MOVE EFN_FLAG_VALUE TO FORMAT-CHAR (SUBX)
               SUBTRACT 1 FROM SUBX
           END-PERFORM.
      *     IF NO-FORMAT
      *         GO TO RETRIEVE-POINTER-RTN-EXIT.
           IF FORMAT-IS-TWELVE OR FORMAT-IS-TWO
               MOVE BINARY-WORD TO VALUE-CHECK
               IF VALUE-CHECK = 49152 OR VALUE-CHECK = 8192
                   IF FORMAT-IS-TWO AND PRINT-PASS = "Y"
                       DISPLAY "                    Placement control:  
      -                                                   "Specific RVN"
                       GO TO RETRIEVE-POINTER-RTN
                   END-IF
                   ADD 1 TO SUB
                   MOVE 0 TO BINARY-WORD
                   MOVE IDXF-RP-WORD (SUB) TO BINARY-W-LOW-WORD
                   GO TO ANY-FORMAT.
           IF FORMAT-IS-FOUR
               MOVE 12 TO POS
               MOVE 4 TO NUMBER-OF-BITS-TO-SET
           ELSE
               MOVE 15 TO POS
               MOVE 1 TO NUMBER-OF-BITS-TO-SET.
           CALL "LIB$INSV" USING BY REFERENCE SRC
                                              POS
                                              NUMBER-OF-BITS-TO-SET
                                              BINARY-WORD.
       ANY-FORMAT.
           ADD 1 TO SUB.
           MOVE 0 TO BINARY-LONGWORD.
           MOVE IDXF-RP-WORD (SUB) TO BINARY-LW-LOW-WORD.
           IF FORMAT-IS-FOUR
               MOVE BINARY-W-BYTE2 TO BINARY-LW-BYTE3
               MOVE 8 TO POS
               MOVE 4 TO NUMBER-OF-BITS-TO-SET
               CALL "LIB$INSV" USING BY REFERENCE SRC
                                                  POS
                                                  NUMBER-OF-BITS-TO-SET
                                                  BINARY-WORD
           ELSE
               ADD 1 TO SUB
               MOVE IDXF-RP-WORD (SUB) TO BINARY-LW-HIGH-WORD.
           MOVE 0 TO LOW-LBN
                     HIGH-LBN
                     NUMBER-OF-BLOCKS.
           MOVE BINARY-WORD TO REAL-BINARY-WORD.
           MOVE REAL-BINARY-WORD TO NUMBER-OF-BLOCKS.
           ADD 1 TO NUMBER-OF-BLOCKS.
           MOVE BINARY-LONGWORD TO LOW-LBN.
           ADD LOW-LBN NUMBER-OF-BLOCKS GIVING HIGH-LBN.
           IF PRINT-PASS = "N"
               IF LBN < LOW-LBN OR LBN > HIGH-LBN
                   GO TO RETRIEVE-POINTER-RTN
               ELSE
                   MOVE "Y" TO PRINT-PASS
                   DISPLAY " "
                   DISPLAY "RECORD-NUMBER = " RECORD-COUNT
                   MOVE IDXF-FILE-NAME-PART1 TO DLINE
                   IF IDXF-FILE-NAME-PART2 NOT = " "
                       MOVE IDXF-FILE-NAME-PART2 TO DLINE (21:55)
                   END-IF
                   DISPLAY " "
                   DISPLAY WBOLD DLINE CLR-ATT
                   DISPLAY " "
                   MOVE "               Retrieval pointers . . . " TO
                                                                   DLINE
                   DISPLAY WBOLD DLINE CLR-ATT
                   DISPLAY " "
                   MOVE 0 TO SUB
                   GO TO RETRIEVE-POINTER-RTN.
           MOVE " " TO DISPLAY-LINE.
                
           MOVE " " TO DLINE.
           MOVE "Count:" TO DCOUNT-HDR.
           MOVE NUMBER-OF-BLOCKS TO DCOUNT.
           MOVE "LBN:" TO DLBN-HDR.
           MOVE LOW-LBN TO DLBN-BASE.

           IF LBN < LOW-LBN OR LBN > HIGH-LBN
               DISPLAY DLINE
           ELSE
               DISPLAY WBOLD WBLINK DLINE CLR-ATT.
           GO TO RETRIEVE-POINTER-RTN.
       RETRIEVE-POINTER-RTN-EXIT.
           EXIT.
           COPY EDRUTINE.
