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.