.TITLE IDXDUMP - Dump ODS-2 index file for analysis .IDENT /0.00/ ;++ ; Title: ; IDXDUMP - Dump ODS-2 index file for analysis ; ; Facility: ; System management utility. ; ; Abstract: ; IDXDUMP is a utility for dumping the index file (INDEXF.SYS) ; for an ODS-2 disk. It writes a record for each file header ; in the index. The information in each record is oriented ; toward analysis of fragmentation, file sizes, creation/revision ; dates, etc. The program prompts for the device name of the disk ; to be dumped. The index file for the specified disk is mapped ; as a private section. The records are written on SYS$OUTPUT (wherever ; it might be directed). The records consist of a fixed length portion ; followed by a variable length portion consisting of a quadword ; for each mapping pointer. Headers for deleted files are ignored. ; Extension headers on the same disk are processed correctly. No ; consideration is given to any complications introduced by volume ; sets. The file produced by IDXDUMP is suitable for analysis ; with DATATRIEVE. ; ; This program must be assembled with [SSG.SOURCE.SMAC]SMAC.MLB and ; SYS$LIBRARY:LIB.MLB. ; ; Environment: ; Native Mode. Must have read access to INDEXF.SYS on target disk. ; ; Author: ; Gary L. Grebus, Creation date: 22-Feb-1982 ; Battelle Columbus Labs ; ; Modified by: ; ;-- .PAGE .SBTTL Symbol definitions ; System symbols .LIBRARY \SYS$LIBRARY:LIB.MLB\ $HM2DEF ; ODS-2 Home block fields $FH2DEF ; ODS-2 file header fields $FI2DEF ; File header ID area fields $FATDEF ; File/record attributes fields $FM2DEF ; Mapping pointer definitions ; Local symbols $DEFINI REC ; Defintion of output file record $DEF REC_W_FID .BLKB 2*3 ; File ID $DEF REC_B_EXTCNT .BLKB 1 ; Flag that file has extension hdr $DEF REC_T_FILENAME .BLKB 20 ; File name $DEF REC_W_REVNO .BLKW 1 ; File revision count $DEF REC_Q_CREDAT .BLKQ 1 ; Creation date $DEF REC_Q_REVDAT .BLKQ 1 ; Revision date $DEF REC_Q_EXPDAT .BLKQ 1 ; Expiration date $DEF REC_Q_BAKDAT .BLKQ 1 ; Backup date $DEF REC_L_ALLOCSZ .BLKL 1 ; Nr of blocks allocated $DEF REC_L_USEDSZ .BLKL 1 ; Nr of blocks used $DEF REC_B_NRMAPS .BLKB 3 ; Number of map pointers $DEF REC_C_FIXSIZE ; Size of fixed portion $DEF REC_Q_MAP1 ; Offset to first map pointer $DEFEND REC REC_C_MAXMAPS = 127 ; Allow max of 127 map pointers REC_C_MAXREC = REC_C_FIXSIZE + <8*REC_C_MAXMAPS> ; Define max record size .PAGE .SBTTL Read/write data .PSECT RWDATA RD,WRT,NOEXE,NOSHR,LONG ; Read/write data ; RMS data for output record file OUT_FAB: $FAB FNM=,- FAC=PUT,ORG=SEQ,- FOP=,- ALQ=50,DEQ=50,- RAT=CR,RFM=VAR ; Output file FAB OUT_RAB: $RAB FAB=OUT_FAB,- ROP=WBH,- RBF=REC_BUFFER ; Output file RAB ; Data on INDEXF.SYS mapping HSPACE_START: .BLKL 1 ; Address of start of INDEXF map HSPACE_END: .BLKL 1 ; Address of last byte of INDEXF map FIRST_HEADER: .BLKL 1 ; Address of first file header in ; HSPACE NR_HEADERS: .BLKL 1 ; Number of headers in INDEXF ; Data for output records REC_LEN: .BLKL 1 ; Length of current output record REC_BUFFER: .BLKB REC_C_MAXREC ; Space for building record ; Junk for making the NRMAPS field be character data PIC999_STR: .ASCID /!3ZB/ ; FAO control to generate PIC 999. PIC999_DESC: .LONG 3 .ADDRESS REC_BUFFER+REC_B_NRMAPS ; Descriptor for NRMAPS field .PAGE .SBTTL IDXDUMP - Main program .PSECT CODE RD,NOWRT,EXE,SHR,LONG .ENTRY IDXDUMP,^M ; Register usage: ; R0-R2 - Scratch. ; Map the indexf.sys into our address space CALL MAP_INDEX HSPACE_START,HSPACE_END IF THEN RET ; Return with error status ENDIF ; Open the output file $CREATE FAB=OUT_FAB ; Open the output file IF THEN RET ; Return with error status ENDIF $CONNECT RAB=OUT_RAB ; Connect record stream IF THEN RET ENDIF ; Compute first header address and number of headers. ADDL3 HSPACE_START,#512,R1 ; Home block is second block of ; INDEXF. Get base address of it. CLRL R2 ; Clear register MULW3 #4,HM2$W_CLUSTER(R1),R2 ; 4*cluster size ADDW2 HM2$W_IBMAPSIZE(R1),R2 ; plus header bit map size ; gives offset to first header MULL2 #512,R2 ; *512 gives byte offset ADDL3 R2,HSPACE_START,- FIRST_HEADER ; Add offset to base to get ; address of first header SUBL3 FIRST_HEADER,HSPACE_END,- R2 ; Compute nr of bytes mapped after ; first header INCL R2 DIVL3 #512,R2,NR_HEADERS ; Convert bytes to blocks - ; one block/header ; Loop through the headers CLRL R2 ; R2 is which header to dump - zero ; relative WHILE DO CALL BUILD_RECORD - FIRST_HEADER, R2,- REC_BUFFER, REC_LEN ; Build record for next header IF THEN CVTLW REC_LEN,- OUT_RAB+RAB$W_RSZ ; Set record length in RAB $PUT RAB=OUT_RAB ; Write the record IF THEN RET ; Return with error status ENDIF ENDIF INCL R2 ; Do next header ENDWHILE ; All done. $CLOSE FAB=OUT_FAB ; Close output file RET .PAGE .SBTTL MAP_INDEX - Map INDEXF as private section ;++ ; Functional Description: ; This routine is called by the main program to query the user for ; the disk to be dumped, and to map the specified INDEXF.SYS as a ; private section. The starting and ending address of the section ; are returned. The section is mapped into the first available ; P0 region space. ; ; Calling Sequence: ; CALLS #2, MAP_INDEX ; ; Input Parameters: NONE ; ; Output Parameters: ; 4(AP) - Address of buffer to receive HSPACE start address ; 8(AP) - Address of buffer to receive HSPACE end address ; ; Implicit Inputs: NONE ; ; Implicit Outputs: NONE ; ; Procedures called: ; SYS$OPEN, SYS$CRMPSC, LIB$GET_INPUT ; ; Completion Status: ; Returns error status from any routine called. ; ; Side Effects: ; Opens INDEXF.SYS on specified disk with write access to flush ; cache. ; ;-- .PSECT RWDATA RD,WRT,NOEXE,NOSHR,LONG $SECDEF ; Section flag defintions DEV_NAM_SZ = 5 ; Size of disk device name .ALIGN LONG IDX_FAB: $FAB FNA=DEV_NAM_BUF,- FNS=DEV_NAM_SZ,- DNM=<[0,0]INDEXF.SYS>,- FAC=PUT,- SHR=,- FOP=UFO ; FAB for getting channel on INDEXF DEV_NAM_BUF: .BLKB DEV_NAM_SZ ; Space for device name DEV_DESC: .LONG DEV_NAM_SZ .ADDRESS DEV_NAM_BUF ; Descriptor for above DEV_PROMPT: .ASCID /Enter disk device name (ddxn:): / ; Data for mapping the section IN_ADR: .LONG ^X200 ; Input address - map to P0 space .LONG ^X200 OUT_ADR: .BLKL 2 ; Output address array .PSECT CODE RD,NOWRT,EXE,SHR,LONG .ENTRY MAP_INDEX,^M<> ; Register usage: ; R0-R1 - Scratch. CALL LIB$GET_INPUT DEV_DESC, DEV_PROMPT ; Ask user for disk name IF THEN RET ; Return with error status ENDIF $OPEN FAB=IDX_FAB ; Open the index file to get a ; channel IF THEN RET ; Return with error status ENDIF $CRMPSC_S - INADR=IN_ADR,- RETADR=OUT_ADR,- FLAGS=#,- CHAN=IDX_FAB+FAB$L_STV,- PFC=#64 ; Map the section IF THEN RET ; Return with error status ENDIF MOVL OUT_ADR,@4(AP) ; Return limits of mapping MOVL OUT_ADR+4,@8(AP) RET .PAGE .SBTTL BUILD_RECORD - Build an output record from a header ;++ ; Functional Description: ; This routine fills in an output record from the specified header. ; It processes the mapping pointers for the header and any extension ; headers. The total length of the record is returned. If the header ; does not represent a valid file, the returned length is zero. ; This could occur for a deleted file, or an extension header. ; ; Calling Sequence: ; CALLS #4, BUILD_RECORD ; ; Input Parameters: ; @4(AP) - Address where first header is mapped ; 8(AP) - Offset of header to dump ; 12(AP) - Address of buffer to receive record ; ; Output Parameters: ; 16(AP) - Address of buffer to receive record length ; ; Implicit Inputs: NONE ; ; Implicit Outputs: NONE ; ; Procedures called: ; EXTRACT_MAPS ; ; Completion Status: NONE ; ; Side Effects: NONE ; ;-- .PSECT CODE RD,NOWRT,EXE,SHR,LONG .ENTRY BUILD_RECORD,^M ; Register usage: ; R0-R5 - Scratch ; R6 - Address of header to dump ; R7 - Address of record buffer MULL3 8(AP),#512,R6 ; Get byte offset of header to dump ADDL2 @4(AP),R6 ; Compute header address MOVL 12(AP),R7 ; Get record buffer address CLRL @16(AP) ; Assume invalid header. Return zero. ENB_LONG ;; Enable long branch mode of macros IF AND - AND - THEN ; Header is neither deleted nor an extension. Generate a record for it. CLRB REC_B_EXTCNT(R7) ; Clear extension header count CLRB REC_B_NRMAPS(R7) ; Clear nr of map pointers MOVL FH2$W_FID(R6),- REC_W_FID(R7) ; Return file id MOVW FH2$W_FID+4(R6),- REC_W_FID+4(R7) ; Return fields from file/record attributes area MOVAL FH2$W_RECATTR(R6),R2 ; Get base of file/record attributes ; field MOVW FAT$W_HIBLKH(R2),- REC_L_ALLOCSZ+2(R7) ; Store most sig. word of file size MOVW FAT$W_HIBLKL(R2),- REC_L_ALLOCSZ(R7) ; and least significant word. MOVW FAT$W_EFBLKH(R2),- REC_L_USEDSZ+2(R7) ; Store most sig. word of eof block MOVW FAT$W_EFBLKL(R2),- REC_L_USEDSZ(R7) ; and least significant word. ; Return fields from IDENT area MOVZBL - FH2$B_IDOFFSET(R6),R2 ; Get word offset to IDENT area MULL2 #2,R2 ; Times 2 to get byte offset ADDL2 R6,R2 ; plus base addr gives IDENT area base MOVW FI2$W_REVISION(R2),- REC_W_REVNO(R7) ; Return revision number MOVQ FI2$Q_CREDATE(R2),- REC_Q_CREDAT(R7) ; Return creation date MOVQ FI2$Q_REVDATE(R2),- REC_Q_REVDAT(R7) ; Return revision date MOVQ FI2$Q_EXPDATE(R2),- REC_Q_EXPDAT(R7) ; Return expiration date MOVQ FI2$Q_BAKDATE(R2),- REC_Q_BAKDAT(R7) ; Return backup date MOVC3 #20,FI2$T_FILENAME(R2),- REC_T_FILENAME(R7) ; Return file name CALL EXTRACT_MAPS, - @4(AP), @8(AP), @12(AP) ; Process the map pointers in this ; and any extension headers. MOVZBL - REC_B_NRMAPS(R7),R2 ; Get number of map pointers used MULL2 #8,R2 ; Convert to bytes of map pointer info ADDL3 R2,#REC_C_FIXSIZE,- @16(AP) ; Return total record length ; Overwrite the NRMAPS field with its value as PIC 999. $FAO_S - CTRSTR=PIC999_STR,- OUTBUF=PIC999_DESC,- P1=REC_B_NRMAPS(R7) ; Encode NRMAPS ENDIF DSB_LONG ;; Disable long branch mode for macros RET .PAGE .SBTTL EXTRACT_MAPS - Extract all mapping info for a header ;++ ; Functional Description: ; This routine extracts all mapping information for a file header and ; any extensions it might have, and returns them in specified record ; buffer. The various ODS-2 map pointer formats are unpacked into ; a quadword lbn/length pair. The record field REC_B_NRMAPS is ; incremented each time a new mapping pointer is added to the record. ; The limit of REC_C_MAXMAPS is observed. This routine calls itself ; recursively to process the extension headers. REC_C_EXTCNT is ; incremented each time an extension header is processed. ; ; Calling Sequence: ; CALLS #3, EXTRACT_MAPS ; ; Input Parameters: ; @4(AP) - Address where first header is mapped ; 8(AP) - Offset of header to dump ; 12(AP) - Address of buffer to receive record ; ; Output Parameters: NONE ; ; Implicit Inputs: NONE ; ; Implicit Outputs: NONE ; ; Procedures called: ; EXTRACT_MAPS (recursive) ; ; Completion Status: NONE ; ; Side Effects: ; May call itself. ; ;-- .PSECT CODE RD,NOWRT,EXE,SHR,LONG .ENTRY EXTRACT_MAPS,^M ; Register usage: ; R0-R1 - Scratch ; R2 - Address of next map pointer in the header ; R3 - Address of byte beyond last map pointer ; R4 - Address of beginning of record buffer ; R5 - Address of next map slot in record ; R6 - Address of beginning of header MULL3 8(AP),#512,R6 ; Get byte offset of header to dump ADDL2 @4(AP),R6 ; Convert to header address MOVZBL FH2$B_MPOFFSET(R6),R0 ; Get word offset to map area MULL2 #2,R0 ; Convert to bytes ADDL3 R6,R0,R2 ; Get address of map area MOVZBL FH2$B_MAP_INUSE(R6),- R0 ; Get nr of map words in use MULL2 #2,R0 ; Convert to bytes ADDL3 R2,R0,R3 ; Compute address of byte beyond end ; of map area MOVL 12(AP),R4 ; Get address of record buffer MOVAL REC_Q_MAP1(R4),R5 ; Get address of next map slot in rec ; Loop processing all the map pointers WHILE DO ; Stop if record is full BREAK IF EXTZV #FM2$V_FORMAT,- #FM2$S_FORMAT,- FM2$W_WORD0(R2),R1 ; Get map pointer format IF THEN ; Ignore map pointers for placement info ADDL2 #FM2$C_LENGTH0,R2 ; Point to next map pointer ENDIF IF THEN ; Format 1 map pointer. EXTZV - #FM2$V_HIGHLBN,- #FM2$S_HIGHLBN,- FM2$W_WORD0(R2),R0 ; Get high order bits of LBN ASHL #16,R0,R0 ; Position the bits MOVW FM2$W_LOWLBN(R2),R0 ; Get low order part of LBN MOVL R0,(R5)+ ; Store LBN part of map MOVZBL FM2$B_COUNT1(R2),- (R5)+ ; Store count part of map INCB REC_B_NRMAPS(R4) ; Count the map pointer ADDL2 #FM2$C_LENGTH1,R2 ; Point to next map in header ENDIF IF THEN ; Format 2 map pointer. MOVL FM2$L_LBN2(R2),- (R5)+ ; Store LBN part of map EXTZV - #FM2$V_COUNT2,- #FM2$S_COUNT2,- FM2$W_WORD0(R2),(R5)+ ; Store count part of map INCB REC_B_NRMAPS(R4) ; Count the map pointer ADDL2 #FM2$C_LENGTH2,R2 ; Point to next map pointer ENDIF IF THEN ; Format 3 map pointer. MOVL FM2$L_LBN3(R2),(R5)+ ; Store LBN part of map MOVW FM2$W_LOWCOUNT(R2),- (R5)+ ; Store low order word of count EXTZV - #FM2$V_COUNT2,- #FM2$S_COUNT2,- FM2$W_WORD0(R2),R0 ; Get high order bits of count MOVW R0,(R5)+ ; Store high order part of count INCB REC_B_NRMAPS(R4) ; Count the map pointer ADDL2 #FM2$C_LENGTH3,R2 ; Point to next map ENDIF ENDWHILE ; Now process an extension header if present MOVZWL FH2$W_EX_FIDNUM(R6),R0 ; Get extension file number IF THEN ; A non-zero file number means there is an extension. INCB REC_B_EXTCNT(R4) ; Count the extension CALL EXTRACT_MAPS - @4(AP), R0, R4 ; Call ourself for the extension hdr ENDIF RET .END IDXDUMP