IDENTIFICATION DIVISION. PROGRAM-ID. DISK_FRAG. ENVIRONMENT DIVISION. CONFIGURATION SECTION. SPECIAL-NAMES. SYMBOLIC CHARACTERS ZEERO ONE TWO THREE FOUR SIX THIRTEEN FIFTEEN TWENTY-ONE TWENTY-SIX SIXTY-EIGHT SEVENTY-SIX EIGHTY TWO-FIFTY-FOUR TWO-FIFTY-FIVE ARE 1 2 3 4 5 7 14 16 22 27 69 77 81 255 256. INPUT-OUTPUT SECTION. FILE-CONTROL. SELECT PR ASSIGN TO PRT1. DATA DIVISION. FILE SECTION. 000100 FD PR LABEL RECORDS ARE OMITTED RECORD CONTAINS 72 CHARACTERS. 01 DATALINE. 02 PLINE PIC X(72). 02 FILLER REDEFINES PLINE. 03 FILLER PIC X(05). 03 DFILES PIC ZZZ,ZZZ,ZZ9. 03 DDASHES PIC X(20). 03 DCOMMENTS PIC X(36). WORKING-STORAGE SECTION. 01 WS_FAB. 05 WS_FAB_BID PIC X(01) VALUE THREE. 05 WS_FAB_BLN PIC X(01) VALUE EIGHTY. 05 WS_FAB_IFI PIC 9(04) COMP VALUE ZERO. 05 WS_FAB_FOP PIC 9(09) COMP VALUE ZERO. 05 WS_FAB_STS PIC 9(09) COMP VALUE ZERO. 05 WS_FAB_STV PIC 9(09) COMP VALUE ZERO. 05 WS_FAB_ALQ PIC 9(09) COMP VALUE ZERO. 05 WS_FAB_DEQ PIC 9(04) COMP VALUE ZERO. 05 WS_FAB_FAC PIC X(01) VALUE TWO. 05 WS_FAB_SHR PIC X(01). 05 WS_FAB_CTX PIC 9(09) COMP VALUE ZERO. 05 WS_FAB_RTY PIC X(01). 05 WS_FAB_ORG PIC X(01). 05 WS_FAB_RAT PIC X(01). 05 WS_FAB_RFM PIC X(01). 05 WS_FAB_JNL PIC 9(09) COMP. 05 WS_FAB_XAB POINTER VALUE REFERENCE WS_XAB. 05 WS_FAB_NAM PIC 9(09) COMP VALUE ZERO. 05 WS_FAB_FNA POINTER VALUE REFERENCE WS_FILE_SPEC. 05 WS_FAB_DNA PIC 9(09) COMP VALUE ZERO. 05 WS_FAB_FNS PIC X(01). 05 WS_FAB_DNS PIC X(01). 05 WS_FAB_MRS PIC 9(04). 05 WS_FAB_MRN PIC 9(09) COMP. 05 WS_FAB_BLS PIC 9(04) COMP. 05 WS_FAB_BKS PIC X(01). 05 WS_FAB_FSZ PIC X(01). 05 WS_FAB_DEV PIC 9(09) COMP. 05 WS_FAB_SDC PIC 9(09) COMP. 05 WS_FAB_GBC PIC 9(04) COMP. 05 WS_FAB_DSOMSK PIC X(01). 05 WS_FAB_FILLER PIC X(05). 01 WS_RAB. 05 WS_RAB_BID PIC X(01) VALUE ONE. 05 WS_RAB_BLN PIC X(01) VALUE SIXTY-EIGHT. 05 WS_RAB_ISI PIC 9(04) COMP VALUE ZERO. 05 WS_RAB_ROP PIC 9(09) COMP. 05 WS_RAB_STS PIC 9(09) COMP. 05 WS_RAB_STV PIC 9(09) COMP. 05 WS_RAB_RFA. 10 WS_RAB_RFA_BLOCK_NUMBER PIC 9(09) COMP. 10 WS_RAB_RFA_OFFSET_IN_BLOCK PIC 9(04) COMP. 05 FILLER PIC 9(02). 05 WS_RAB_CTX PIC 9(09) COMP. 05 FILLER PIC X(02). 05 WS_RAB_RAC PIC X(01). 05 WS_RAB_TMO PIC X(01). 05 WS_RAB_USZ PIC 9(04) COMP. 05 WS_RAB_RSZ PIC 9(04) COMP. 05 WS_RAB_UBF PIC 9(09) COMP. 05 WS_RAB_RBF PIC 9(09) COMP. 05 WS_RAB_RHB PIC 9(09) COMP. 05 WS_RAB_K. 10 WS_RAB_KBF POINTER VALUE REFERENCE WS_KEY_BUFFER. 10 WS_RAB_KSZ PIC X(01). 05 WS_RAB_P REDEFINES WS_RAB_K. 10 WS_RAB_PBF PIC 9(09) COMP. 10 WS_RAB_PSZ PIC X(01). 05 WS_RAB_KRF PIC X(01). 05 WS_RAB_MBF PIC X(01). 05 WS_RAB_MBC PIC X(01). 05 WS_RAB_B. 10 WS_RAB_BKT PIC 9(09) COMP. 05 WS_RAB_D REDEFINES WS_RAB_B. 10 WS_RAB_DCT PIC 9(09) COMP. 05 WS_RAB_FAB POINTER VALUE REFERENCE WS_FAB. 05 WS_RAB_XAB PIC 9(09) COMP VALUE 0. 01 WS_XAB. 02 WS_XAB_COD PIC X(01) VALUE TWENTY-ONE. 02 WS_XAB_BLN PIC X(01) VALUE SEVENTY-SIX. 02 FILLER PIC X(02). 02 WS_XAB_NXT PIC S9(09) COMP VALUE ZERO. 02 WS_XAB_IAN PIC X(01). 02 WS_XAB_LAN PIC X(01). 02 WS_XAB_DAN PIC X(01). 02 FILLER PIC X(07). 02 WS_XAB_FLG PIC X(01). 02 WS_XAB_DTP PIC X(01). 02 FILLER PIC X(01). 02 WS_XAB_NUL PIC X(01). 02 FILLER PIC X(01). 02 WS_XAB_REF PIC X(01). 02 FILLER PIC X(02). 02 WS_XAB_IFL PIC 9(04) COMP. 02 WS_XAB_DFL PIC 9(04) COMP. 02 WS_XAB_POS0 PIC 9(04) COMP. 02 WS_XAB_POS1 PIC 9(04) COMP. 02 WS_XAB_POS2 PIC 9(04) COMP. 02 WS_XAB_POS3 PIC 9(04) COMP. 02 WS_XAB_POS4 PIC 9(04) COMP. 02 WS_XAB_POS5 PIC 9(04) COMP. 02 WS_XAB_POS6 PIC 9(04) COMP. 02 WS_XAB_POS7 PIC 9(04) COMP. 02 WS_XAB_SIZ0 PIC X(01). 02 WS_XAB_SIZ1 PIC X(01). 02 WS_XAB_SIZ2 PIC X(01). 02 WS_XAB_SIZ3 PIC X(01). 02 WS_XAB_SIZ4 PIC X(01). 02 WS_XAB_SIZ5 PIC X(01). 02 WS_XAB_SIZ6 PIC X(01). 02 WS_XAB_SIZ7 PIC X(01). 02 FILLER PIC X(02). 02 WS_XAB_KNM POINTER VALUE REFERENCE WS_KEY_NAME. 02 FILLER PIC X(12). 02 WS_XAB_PROLOG PIC X(01). 02 WS_XAB_FILLER PIC X(03). 01 WS_KEY_NAME PIC X(32). 01 WS_KEY_BUFFER PIC X(255). 01 FILLER REDEFINES WS_KEY_BUFFER. 02 WS_REL_REC_NUMBER PIC 9(09) COMP. 02 FILLER PIC X(251). 01 WS_FILE_SPEC PIC X(255). 01 WS_FILE_SPEC_LENGTH PIC S9(09) COMP. 01 WS_STATUS PIC S9(09) COMP. 01 WS_DISPLAY_STATUS PIC 9(09). 01 WS_GET_BUFFER. 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(5092). 000500 01 INDEXF-RECORD REDEFINES WS_GET_BUFFER. 000600 02 IDXF-FIRST-WORD PIC S9(04) COMP. 000600 02 FILLER PIC X(12). 000600 02 IDXF-EXTENT PIC S9(04) COMP. 000600 02 FILLER PIC X(64). 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. 02 FILLER PIC X(5088). 01 WS_UBF_POINTER POINTER VALUE REFERENCE WS_GET_BUFFER. 01 STAT PIC S9(09) COMP. 01 FILLER. 02 FAB$C_IDX PIC S9(04) COMP VALUE 32. 02 FAB$C_REL PIC S9(04) COMP VALUE 16. 02 FAB$C_SEQ PIC S9(04) COMP VALUE 0. 02 LIB$_NOSUCHSYM PIC S9(09) COMP VALUE 001409892. 02 FILE-COUNT PIC 9(01) VALUE 0. 02 GET_FILE PIC X(01) VALUE "N". 02 FAB$V_SHRPUT PIC S9(04) COMP VALUE 1. 02 FAB$V_SHRGET PIC S9(04) COMP VALUE 2. 02 FAB$V_SHRDEL PIC S9(04) COMP VALUE 4. 02 FAB$V_SHRUPD PIC S9(04) COMP VALUE 8. 02 FAB$V_UPI PIC S9(04) COMP VALUE 64. 02 FAB$C_FIX PIC S9(04) COMP VALUE 1. 02 RECORD_FORMAT PIC 9(04). 88 FIX VALUE 1. 88 VAR VALUE 2. 02 RAB$V_KGE PIC S9(09) COMP VALUE 2097152. 02 RAB$V_NLK PIC S9(09) COMP VALUE 1048576. 02 RAB$V_RRL PIC S9(09) COMP VALUE 8. 02 BINARY-WORD PIC S9(04) COMP. 02 FILLER REDEFINES BINARY-WORD. 03 BINARY-VALUE PIC X(01). 03 BINARY-FILLER PIC X(01). 02 REAL-BINARY-WORD PIC 9(04) COMP. ************************************************************************ *********** I KNOW THIS ISN'T REALLY A WORD, BUT I'M CHEATING ********** ************************************************************************ 02 BINARY-WRD PIC 9(09) COMP. 02 FILLER REDEFINES BINARY-WRD. 03 BINARY-W-BYTE1 PIC X(01). 03 BINARY-W-BYTE2 PIC X(01). 03 FILLER PIC X(02). 02 FILLER REDEFINES BINARY-WRD. 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 ITMLST. 03 FILLER PIC S9(04) COMP VALUE 255. 03 FILLER PIC S9(04) COMP VALUE 2. 03 FILLER POINTER VALUE REFERENCE WS_FILE_SPEC. 03 FILLER POINTER VALUE REFERENCE WS_FILE_SPEC_LENGTH. 03 FILLER PIC S9(09) COMP VALUE 0. 02 WS_KEY_OF_REF PIC X(02). 02 KEY-OF-REFERENCE PIC 9(02). 02 WS_MAX_KEY PIC X(255). 02 WS_FIRST_X PIC X(08). 02 WS_FIRST_RECORD PIC 9(08). 02 WS_MAX_X PIC X(08). 02 WS_MAX_RECORD PIC 9(08). 02 KEY-POSITION PIC 9(04). 02 KEY-LENGTH PIC 9(04). 02 REPLY PIC X(31). 88 YEA VALUE "Y" "y". 88 NEA VALUE " " "N" "n". 01 DISPLAY_QUEUE PIC S9(09) COMP VALUE 6. 01 IOSB. 02 FILLER OCCURS 2 TIMES. 03 IOSB-LONGWORD PIC 9(09) COMP. 01 JBC$_NOMOREQUE PIC S9(09) COMP VALUE 295338. 01 QUE_ITMLST. 02 FILLER PIC S9(04) COMP VALUE 31. 02 FILLER PIC S9(04) COMP VALUE 77. 02 FILLER POINTER VALUE REFERENCE SEARCH_NAME. 02 FILLER POINTER VALUE REFERENCE SEARCH_NAME_LENGTH. 02 FILLER PIC S9(04) COMP VALUE 4. 02 FILLER PIC S9(04) COMP VALUE 76. 02 FILLER POINTER VALUE REFERENCE SEARCH_FLAGS. 02 FILLER POINTER VALUE REFERENCE SEARCH_FLAGS_LENGTH. 02 FILLER PIC S9(04) COMP VALUE 31. 02 FILLER PIC S9(04) COMP VALUE 31. 02 FILLER POINTER VALUE REFERENCE FORM_NAME. 02 FILLER POINTER VALUE REFERENCE FORM_NAME_LENGTH. 02 FILLER PIC S9(04) COMP VALUE 31. 02 FILLER PIC S9(04) COMP VALUE 70. 02 FILLER POINTER VALUE REFERENCE QUEUE_NAME. 02 FILLER POINTER VALUE REFERENCE QUEUE_NAME_LENGTH. 02 FILLER PIC S9(04) COMP VALUE 4. 02 FILLER PIC S9(04) COMP VALUE 71. 02 FILLER POINTER VALUE REFERENCE QUEUE_STATUS. 02 FILLER POINTER VALUE REFERENCE QUEUE_STATUS_LENGTH. 02 FILLER PIC S9(09) COMP VALUE 0. 01 SEARCH_NAME PIC X(31). 01 SEARCH_NAME_LENGTH PIC S9(09) COMP VALUE 0. 01 SEARCH_FLAGS PIC 9(09) COMP VALUE 0. 01 SEARCH_FLAGS_LENGTH PIC S9(09) COMP VALUE 0. 01 FORM_NAME PIC X(31). 01 FORM_NAME_LENGTH PIC S9(09) COMP. 01 QUEUE_NAME PIC X(31). 01 QUEUE_NAME_LENGTH PIC S9(09) COMP. 01 QUEUE_STATUS PIC 9(09) COMP. 01 QUEUE_STATUS_LENGTH PIC S9(09) COMP. 01 QTYPE PIC X(05) VALUE " ". 01 QUEUE_OK PIC X(03) VALUE " ". 01 TIMBUF PIC X(13). 01 TBL-IND PIC S9(09) COMP VALUE EXTERNAL LIB$K_CLI_GLOBAL_SYM. 01 IDXF-RETRIEVAL-POINTERS. 02 IDXF-RP-WORD PIC 9(04) COMP OCCURS 206 TIMES. 01 FILLER. 02 DISPLAY-EXTENT PIC ZZZZZ9. 02 DISPLAY-REL-REC-NUMBER PIC ZZZZZZZZ9. 02 MSD-STATUS PIC X(02). 02 DISPLAY-FILE-NAME PIC X(86). 02 RECORD-COUNT PIC 9(06). 02 SAVED-RECORD PIC 9(06). 02 EXTENT-RECORD PIC 9(09). 02 EXTENSION-FLAG PIC X(01). 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 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 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 DISK-DEVICE PIC X(26). 02 VOLUME-FLAG PIC X(01). 88 VOLUME-SET VALUE "Y". 88 SINGLE-DISK VALUE "N". 02 PREV-NAME PIC X(20). 02 DISPLAY-NAME PIC X(20). 02 VOLUME-SET-NAME PIC X(12). 02 VOLUME-NAME PIC X(12). 02 MAX-FILES PIC 9(09). 02 RECORDS-TO-SKIP PIC 9(03). 02 FRAGMENTS PIC 9(05). 02 UNRECOGNIZED-RECORDS PIC 9(06). 02 TOTAL-FILES PIC 9(09). 02 ONLY-ONE PIC 9(04). 02 LESS-THAN-10 PIC 9(04). 02 LESS-THAN-20 PIC 9(04). 02 LESS-THAN-30 PIC 9(04). 02 LESS-THAN-40 PIC 9(04). 02 LESS-THAN-50 PIC 9(04). 02 LESS-THAN-60 PIC 9(04). 02 LESS-THAN-70 PIC 9(04). 02 LESS-THAN-80 PIC 9(04). 02 LESS-THAN-90 PIC 9(04). 02 LESS-THAN-100 PIC 9(04). 02 100-OR-MORE PIC 9(04). PROCEDURE DIVISION. BEGIN. CALL "SYS$TRNLNM" USING BY VALUE 0 BY DESCRIPTOR "LNM$PROCESS_TABLE" BY DESCRIPTOR "INFILE" BY VALUE 0 BY REFERENCE ITMLST GIVING STAT. IF STAT IS FAILURE CALL "LIB$STOP" USING BY VALUE STAT. MOVE WS_FILE_SPEC_LENGTH TO BINARY-WORD. MOVE BINARY-VALUE TO WS_FAB_FNS. MOVE " " TO WS_KEY_OF_REF. OPEN-FILE. MOVE FAB$V_SHRGET TO BINARY-WORD. MOVE BINARY-VALUE TO WS_FAB_SHR. MOVE KEY-OF-REFERENCE TO BINARY-WORD. MOVE BINARY-VALUE TO WS_XAB_REF. ******************* O P E N I N G F I L E ******************* CALL "SYS$OPEN" USING BY REFERENCE WS_FAB GIVING WS_STATUS. IF WS_STATUS IS FAILURE MOVE WS_STATUS TO WS_DISPLAY_STATUS IF WS_DISPLAY_STATUS = 100188 DISPLAY " " DISPLAY "**** INVALID KEY OF REFERENCE ENTRY ****" GO TO E-O-J ELSE IF WS_DISPLAY_STATUS = 98954 DISPLAY " " DISPLAY "***** FILE CURRENTLY LOCKED BY ANOTHER - " USER *****" GO TO E-O-J END-IF IF WS_DISPLAY_STATUS = 98962 DISPLAY " " DISPLAY "***** FILE NOT FOUND *****" GO TO E-O-J END-IF IF WS_DISPLAY_STATUS = 100052 DISPLAY " " DISPLAY "***** FILENAME SYNTAX ERROR *****" GO TO E-O-J END-IF DISPLAY " OPEN STATUS = " WS_DISPLAY_STATUS CALL "LIB$STOP" USING BY VALUE WS_STATUS. ******************* C O N N E C T R A B ******************* MOVE FOUR TO WS_RAB_KSZ. CALL "SYS$CONNECT" USING BY REFERENCE WS_RAB GIVING WS_STATUS. IF WS_STATUS IS FAILURE MOVE WS_STATUS TO WS_DISPLAY_STATUS IF WS_DISPLAY_STATUS = 100188 DISPLAY " " DISPLAY "**** INVALID KEY OF REFERENCE ENTRY ****" GO TO E-O-J ELSE DISPLAY " OPEN STATUS = " WS_DISPLAY_STATUS CALL "LIB$STOP" USING BY VALUE WS_STATUS. OPEN OUTPUT PR. MOVE 0 TO MAX-FILES FRAGMENTS TOTAL-FILES RECORD-COUNT UNRECOGNIZED-RECORDS. MOVE 0 TO ONLY-ONE LESS-THAN-10 LESS-THAN-20 LESS-THAN-30 LESS-THAN-40 LESS-THAN-50 LESS-THAN-60 LESS-THAN-70 LESS-THAN-80 LESS-THAN-90 LESS-THAN-100 100-OR-MORE. MOVE " " TO PREV-NAME. START-INDEXF. MOVE WS_UBF_POINTER TO WS_RAB_UBF. MOVE 5600 TO WS_RAB_USZ. MOVE 00 TO BINARY-WORD. MOVE WS_FAB_RFM TO BINARY-VALUE. MOVE BINARY-WORD TO RECORD_FORMAT. MOVE ONE TO WS_RAB_RAC. PERFORM HOME-BLOCK-RTN THRU HOME-BLOCK-RTN-EXIT. ADD 1 RECORDS-TO-SKIP GIVING SAVED-RECORD. * DISPLAY SAVED-RECORD. MOVE "N" TO EXTENSION-FLAG. MOVE SAVED-RECORD TO WS_REL_REC_NUMBER. READ-REC. * MOVE WS_REL_REC_NUMBER TO DISPLAY-REL-REC-NUMBER. * DISPLAY " RELATIVE RECORD KEY = " DISPLAY-REL-REC-NUMBER. MOVE " " TO WS_GET_BUFFER. CALL "SYS$GET" USING BY REFERENCE WS_RAB GIVING WS_STATUS. MOVE WS_STATUS TO WS_DISPLAY_STATUS. IF WS_DISPLAY_STATUS = 98938 OR WS_DISPLAY_STATUS = 98994 IF FRAGMENTS NOT = 0 PERFORM FRAGMENT-RTN THRU FRAGMENT-RTN-EXIT END-IF GO TO SUMMARY-SECTION. IF WS_STATUS IS FAILURE DISPLAY "GET STATUS = " WS_DISPLAY_STATUS CALL "LIB$STOP" USING BY VALUE WS_STATUS. IF IDXF-LAST-WORD = 0 ADD 1 TO SAVED-RECORD MOVE SAVED-RECORD TO WS_REL_REC_NUMBER GO TO READ-REC. IF IDXF-FIRST-WORD = 25640 NEXT SENTENCE ELSE IF IDXF-FIRST-WORD = 12840 IF EXTENSION-FLAG = "N" ADD 1 TO SAVED-RECORD MOVE SAVED-RECORD TO WS_REL_REC_NUMBER GO TO READ-REC END-IF ELSE ADD 1 TO UNRECOGNIZED-RECORDS DISPLAY " " DISPLAY "***** UNKNOWN FIRST WORD *****" DISPLAY "***** RELATIVE RECORD COUNT = " SAVED-RECORD " *****" ADD 1 TO SAVED-RECORD MOVE SAVED-RECORD TO WS_REL_REC_NUMBER GO TO READ-REC. * DISPLAY IDXF-FILE-NAME-PART1. IF IDXF-FIRST-WORD = 25640 IF IDXF-FILE-NAME-PART1 = PREV-NAME MOVE IDXF-FILE-NAME-PART1 TO PREV-NAME ELSE MOVE PREV-NAME TO DISPLAY-NAME MOVE IDXF-FILE-NAME-PART1 TO PREV-NAME IF FRAGMENTS NOT = 0 PERFORM FRAGMENT-RTN THRU FRAGMENT-RTN-EXIT MOVE 0 TO FRAGMENTS END-IF MOVE 156 TO CHECKSUM-SUB MOVE INDEXF-RECORD (201:310) TO IDXF-RETRIEVAL-POINTERS ELSE IF IDXF-FIRST-WORD = 12840 MOVE 206 TO CHECKSUM-SUB MOVE INDEXF-RECORD (101:410) TO IDXF-RETRIEVAL-POINTERS. IF IDXF-RP-WORD (1) = 0 OR IDXF-RETRIEVAL-POINTERS (1:2) = TWO-FIFTY-FIVE ADD 1 TO SAVED-RECORD MOVE SAVED-RECORD TO WS_REL_REC_NUMBER GO TO READ-REC. MOVE 0 TO SUB. PERFORM RETRIEVE-POINTER-RTN THRU RETRIEVE-POINTER-RTN-EXIT. IF IDXF-EXTENT = 0 ADD 1 TO SAVED-RECORD * DISPLAY "GOING TO READ " SAVED-RECORD MOVE SAVED-RECORD TO WS_REL_REC_NUMBER MOVE "N" TO EXTENSION-FLAG GO TO READ-REC ELSE MOVE "Y" TO EXTENSION-FLAG MOVE IDXF-EXTENT TO EXTENT-RECORD ADD RECORDS-TO-SKIP EXTENT-RECORD GIVING EXTENT-RECORD MOVE EXTENT-RECORD TO WS_REL_REC_NUMBER * MOVE WS_REL_REC_NUMBER TO DISPLAY-EXTENT * DISPLAY "DISPLAY-EXTENT = " DISPLAY-EXTENT GO TO READ-REC. SUMMARY-SECTION. MOVE " " TO DATALINE. IF VOLUME-SET-NAME = " " MOVE VOLUME-NAME TO DATALINE (31:12) ELSE MOVE VOLUME-SET-NAME TO DATALINE (24:12) MOVE VOLUME-NAME TO DATALINE (37:12). WRITE DATALINE AFTER PAGE. MOVE " " TO DATALINE. MOVE MAX-FILES TO DFILES. MOVE " = MAXIMUM NUMBER OF FILES ON THIS DISK." TO DATALINE (17:40). WRITE DATALINE AFTER 2. MOVE " " TO DATALINE. WRITE DATALINE AFTER 1. MOVE ONLY-ONE TO DFILES. MOVE " - - - - - - - - - -" TO DDASHES. MOVE " CONTIGUIOUS FILES" TO DCOMMENTS. WRITE DATALINE AFTER 1. ADD ONLY-ONE TO TOTAL-FILES. MOVE " " TO DATALINE. MOVE LESS-THAN-10 TO DFILES. MOVE " - - - - - - - - - -" TO DDASHES. MOVE " FILES WITH 2 THRU 9 EXTENTS" TO DCOMMENTS. WRITE DATALINE AFTER 1. ADD LESS-THAN-10 TO TOTAL-FILES. MOVE " " TO DATALINE. MOVE LESS-THAN-20 TO DFILES. MOVE " - - - - - - - - - -" TO DDASHES. MOVE " FILES WITH 10 THRU 19 EXTENTS" TO DCOMMENTS. WRITE DATALINE AFTER 1. ADD LESS-THAN-20 TO TOTAL-FILES. MOVE " " TO DATALINE. MOVE LESS-THAN-30 TO DFILES. MOVE " - - - - - - - - - -" TO DDASHES. MOVE " FILES WITH 20 THRU 29 EXTENTS" TO DCOMMENTS. WRITE DATALINE AFTER 1. ADD LESS-THAN-30 TO TOTAL-FILES. MOVE " " TO DATALINE. MOVE LESS-THAN-40 TO DFILES. MOVE " - - - - - - - - - -" TO DDASHES. MOVE " FILES WITH 30 THRU 39 EXTENTS" TO DCOMMENTS. WRITE DATALINE AFTER 1. ADD LESS-THAN-40 TO TOTAL-FILES. MOVE " " TO DATALINE. MOVE LESS-THAN-50 TO DFILES. MOVE " - - - - - - - - - -" TO DDASHES. MOVE " FILES WITH 40 THRU 49 EXTENTS" TO DCOMMENTS. WRITE DATALINE AFTER 1. ADD LESS-THAN-50 TO TOTAL-FILES. MOVE " " TO DATALINE. MOVE LESS-THAN-60 TO DFILES. MOVE " - - - - - - - - - -" TO DDASHES. MOVE " FILES WITH 50 THRU 59 EXTENTS" TO DCOMMENTS. WRITE DATALINE AFTER 1. ADD LESS-THAN-60 TO TOTAL-FILES. MOVE " " TO DATALINE. MOVE LESS-THAN-70 TO DFILES. MOVE " - - - - - - - - - -" TO DDASHES. MOVE " FILES WITH 60 THRU 69 EXTENTS" TO DCOMMENTS. WRITE DATALINE AFTER 1. ADD LESS-THAN-70 TO TOTAL-FILES. MOVE " " TO DATALINE. MOVE LESS-THAN-80 TO DFILES. MOVE " - - - - - - - - - -" TO DDASHES. MOVE " FILES WITH 70 THRU 79 EXTENTS" TO DCOMMENTS. WRITE DATALINE AFTER 1. ADD LESS-THAN-80 TO TOTAL-FILES. MOVE " " TO DATALINE. MOVE LESS-THAN-90 TO DFILES. MOVE " - - - - - - - - - -" TO DDASHES. MOVE " FILES WITH 80 THRU 89 EXTENTS" TO DCOMMENTS. WRITE DATALINE AFTER 1. ADD LESS-THAN-90 TO TOTAL-FILES. MOVE " " TO DATALINE. MOVE LESS-THAN-100 TO DFILES. MOVE " - - - - - - - - - -" TO DDASHES. MOVE " FILES WITH 90 THRU 99 EXTENTS" TO DCOMMENTS. WRITE DATALINE AFTER 1. ADD LESS-THAN-100 TO TOTAL-FILES. MOVE " " TO DATALINE. MOVE 100-OR-MORE TO DFILES. MOVE " - - - - - - - - - -" TO DDASHES. MOVE " FILES WITH 100 OR MORE EXTENTS" TO DCOMMENTS. WRITE DATALINE AFTER 1. ADD 100-OR-MORE TO TOTAL-FILES. MOVE " " TO DATALINE. WRITE DATALINE AFTER 1. MOVE TOTAL-FILES TO DFILES. MOVE " - - - - - - - - - -" TO DDASHES. MOVE " TOTAL FILES ON THIS DISK" TO DCOMMENTS. WRITE DATALINE AFTER 1. IF UNRECOGNIZED-RECORDS = 0 GO TO E-O-J. MOVE " " TO DATALINE. WRITE DATALINE AFTER 1. MOVE UNRECOGNIZED-RECORDS TO DFILES. MOVE " - - - - - - - - - -" TO DDASHES. MOVE " UNRECOGNIZED RECORDS " TO DCOMMENTS. WRITE DATALINE AFTER 1. E-O-J. CALL "SYS$CLOSE" USING BY REFERENCE WS_FAB GIVING WS_STATUS. IF WS_STATUS IS FAILURE CALL "LIB$STOP" USING BY VALUE WS_STATUS. CLOSE PR. STOP RUN. HOME-BLOCK-RTN. MOVE 2 TO WS_REL_REC_NUMBER. MOVE " " TO WS_GET_BUFFER. CALL "SYS$GET" USING BY REFERENCE WS_RAB GIVING WS_STATUS. MOVE WS_STATUS TO WS_DISPLAY_STATUS. IF WS_DISPLAY_STATUS = 98938 OR WS_DISPLAY_STATUS = 98994 DISPLAY "**** AT END ON HOME BLOCK READ ****" GO TO E-O-J. IF WS_STATUS IS FAILURE DISPLAY "GET STATUS = " WS_DISPLAY_STATUS CALL "LIB$STOP" USING BY VALUE WS_STATUS. MOVE HB-MAX-FILES TO MAX-FILES MOVE HB-VOL-SET-NAME TO VOLUME-SET-NAME MOVE HB-VOLUME-NAME TO VOLUME-NAME. MOVE 0 TO RECORDS-TO-SKIP. ADD HB-BITMAP-VBN HB-INDEXF-BITMAP-SIZE GIVING RECORDS-TO-SKIP. SUBTRACT 1 FROM RECORDS-TO-SKIP. * DISPLAY " ". * DISPLAY "RECORDS TO SKIP = " RECORDS-TO-SKIP. * DISPLAY " ". HOME-BLOCK-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-WRD. 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-WRD 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-WRD TO VALUE-CHECK IF VALUE-CHECK = 49152 OR VALUE-CHECK = 8192 GO TO RETRIEVE-POINTER-RTN. 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-WRD. 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-WRD 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-WRD 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. ADD 1 TO FRAGMENTS. GO TO RETRIEVE-POINTER-RTN. RETRIEVE-POINTER-RTN-EXIT. EXIT. FRAGMENT-RTN. IF FRAGMENTS = 1 ADD 1 TO ONLY-ONE. IF FRAGMENTS > 1 AND FRAGMENTS < 10 * DISPLAY DISPLAY-NAME " HAS 1 TO 9 FRAGMENTS." ADD 1 TO LESS-THAN-10. IF FRAGMENTS > 9 AND FRAGMENTS < 20 DISPLAY DISPLAY-NAME " HAS 10 TO 19 FRAGMENTS." ADD 1 TO LESS-THAN-20. IF FRAGMENTS > 19 AND FRAGMENTS < 30 DISPLAY DISPLAY-NAME " HAS 20 TO 29 FRAGMENTS." ADD 1 TO LESS-THAN-30. IF FRAGMENTS > 29 AND FRAGMENTS < 40 DISPLAY DISPLAY-NAME " HAS 30 TO 39 FRAGMENTS." ADD 1 TO LESS-THAN-40. IF FRAGMENTS > 39 AND FRAGMENTS < 50 DISPLAY DISPLAY-NAME " HAS 40 TO 49 FRAGMENTS." ADD 1 TO LESS-THAN-50. IF FRAGMENTS > 49 AND FRAGMENTS < 60 DISPLAY DISPLAY-NAME " HAS 50 TO 59 FRAGMENTS." ADD 1 TO LESS-THAN-60. IF FRAGMENTS > 59 AND FRAGMENTS < 70 DISPLAY DISPLAY-NAME " HAS 60 TO 69 FRAGMENTS." ADD 1 TO LESS-THAN-70. IF FRAGMENTS > 69 AND FRAGMENTS < 80 DISPLAY DISPLAY-NAME " HAS 70 TO 79 FRAGMENTS." ADD 1 TO LESS-THAN-80. IF FRAGMENTS > 79 AND FRAGMENTS < 90 DISPLAY DISPLAY-NAME " HAS 80 TO 89 FRAGMENTS." ADD 1 TO LESS-THAN-90. IF FRAGMENTS > 89 AND FRAGMENTS < 100 DISPLAY DISPLAY-NAME " HAS 90 TO 99 FRAGMENTS" ADD 1 TO LESS-THAN-100. IF FRAGMENTS > 99 DISPLAY DISPLAY-NAME " HAS 100 OR MORE FRAGMENTS." ADD 1 TO 100-OR-MORE. FRAGMENT-RTN-EXIT. EXIT.