MODULE DUMP$HEADER ( IDENT='V04-000', ADDRESSING_MODE(EXTERNAL=GENERAL, NONEXTERNAL=LONG_RELATIVE) ) = BEGIN ! ! !**************************************************************************** !* * !* COPYRIGHT (c) 1978, 1980, 1982, 1984 BY * !* DIGITAL EQUIPMENT CORPORATION, MAYNARD, MASSACHUSETTS. * !* ALL RIGHTS RESERVED. * !* * !* THIS SOFTWARE IS FURNISHED UNDER A LICENSE AND MAY BE USED AND COPIED * !* ONLY IN ACCORDANCE WITH THE TERMS OF SUCH LICENSE AND WITH THE * !* INCLUSION OF THE ABOVE COPYRIGHT NOTICE. THIS SOFTWARE OR ANY OTHER * !* COPIES THEREOF MAY NOT BE PROVIDED OR OTHERWISE MADE AVAILABLE TO ANY * !* OTHER PERSON. NO TITLE TO AND OWNERSHIP OF THE SOFTWARE IS HEREBY * !* TRANSFERRED. * !* * !* THE INFORMATION IN THIS SOFTWARE IS SUBJECT TO CHANGE WITHOUT NOTICE * !* AND SHOULD NOT BE CONSTRUED AS A COMMITMENT BY DIGITAL EQUIPMENT * !* CORPORATION. * !* * !* DIGITAL ASSUMES NO RESPONSIBILITY FOR THE USE OR RELIABILITY OF ITS * !* SOFTWARE ON EQUIPMENT WHICH IS NOT SUPPLIED BY DIGITAL. * !* * !* * !**************************************************************************** ! ! !++ ! ! FACILITY: File dump utility ! ! ABSTRACT: ! This module contains the routines that dump file headers. ! ! ENVIRONMENT: ! VAX native, user mode. ! !-- ! ! ! AUTHOR: Martin L. Jack CREATION DATE: 16-Aug-1981 ! ! MODIFIED BY: ! ! V03-006 LMP0176 L. Mark Pilant, 6-Dec-1983 9:52 ! Use the correct display width in the call to $FORMAT_ACL. ! Also, fix a bug in the code that displays the file name ! extension. ! ! V03-005 LMP0128 L. Mark Pilant, 13-Jul-1983 11:56 ! Track changes made to $FH2DEF and friends. ! ! V03-004 LMP0100 L. Mark Pilant, 14-Apr-1983 8:47 ! Convert to the new system service $FORMAT_ACL. ! ! V03-003 ACG0325 Andrew C. Goldstein, 4-Apr-1983 17:38 ! Fix file header area length check ! ! V03-002 LMP0050 L. Mark Pilant, 8-Oct-1982 12:50 ! Add the ability to dump the ACL if it exists. ! ! V03-001 MLJ0090 Martin L. Jack, 6-May-1982 7:52 ! Avoid clobbering checksum word for blocks that are not file ! headers. ! ! V03-003 MLJ0080 Martin L. Jack, 17-Feb-1982 16:04 ! Add FAT$W_GBC. ! ! V03-002 MLJ0045 Martin L. Jack, 12-Sep-1981 17:00 ! Allow file header dump for tape. ! ! V03-001 MLJ0041 Martin L. Jack, 3-Sep-1981 21:33 ! Add FCH$V_ERASE. ! !-- LIBRARY 'SYS$LIBRARY:LIB.L32'; REQUIRE 'SRC$:DUMPRE'; FORWARD ROUTINE DUMP$HEADER: NOVALUE, ! Dump header(s) for current input file CHECK_HEADER, ! Validate file header DUMP$FAO_: NOVALUE, ! Format information into line DUMP$EOL: NOVALUE, ! Write line buffer DUMP$PUT_FAO_: NOVALUE, ! Format information and write buffer FORMAT_BIT_STRING: NOVALUE, ! Format a bit string FORMAT_CODED_VALUE: NOVALUE, ! Format a coded value FORMAT_DATE_VALUE: NOVALUE, ! Format a standard system date FORMAT_ODS1_DATE_VALUE: NOVALUE, ! Format an ODS-1 date FORMAT_PROTECTION: NOVALUE, ! Format a protection value FORMAT_RMS_ATTRIBUTES: NOVALUE, ! Format RMS attributes area DUMP$ONE_HEADER; ! Dump block as a header, if valid EXTERNAL ROUTINE CHECKSUM, ! Compute file header checksum MAKE_STRING, ! Convert ODS-1 filename to ASCII DUMP$BLANK_LINE:NOVALUE, ! Write blank line DUMP$DUMP_BUFFER: NOVALUE, ! Dump one buffer DUMP$NEW_PAGE: NOVALUE, ! Force page break DUMP$OUTPUT_GETMSG: NOVALUE, ! Write gotten message DUMP$PUT_LINE: NOVALUE; ! Write line EXTERNAL DUMP$GL_FLAGS: BBLOCK, ! General flags DUMP$GL_IDESC: BBLOCK, ! Descriptor for input filename DUMP$GL_INAM: REF BBLOCK, ! Input NAM block DUMP$GL_OUTDESC:BBLOCK, ! Descriptor for output buffer DUMP$GL_WIDTH; ! Width of output medium EXTERNAL LITERAL DUMP$_HEADER, DUMP$_READHEADER; OWN LINE_DESC: VECTOR[2]; MACRO DUMP$PUT_FAO(A)= DUMP$PUT_FAO_(UPLIT BYTE (%ASCIC A) %IF NOT %NULL(%REMAINING) %THEN , %FI %REMAINING) %, DUMP$FAO(A)= DUMP$FAO_(UPLIT BYTE (%ASCIC A) %IF NOT %NULL(%REMAINING) %THEN , %FI %REMAINING) %; GLOBAL ROUTINE DUMP$HEADER: NOVALUE= !++ ! ! FUNCTIONAL DESCRIPTION: ! This routine dumps the file header(s) for the current input file. ! ! INPUT PARAMETERS: ! NONE ! ! IMPLICIT INPUTS: ! NONE ! ! OUTPUT PARAMETERS: ! NONE ! ! IMPLICIT OUTPUTS: ! NONE ! ! ROUTINE VALUE: ! NONE ! ! SIDE EFFECTS: ! NONE ! !-- BEGIN LOCAL NAM: REF BBLOCK, ! Pointer to input file NAM block DESC: VECTOR[2], ! Utility descriptor HEADER_DESC: VECTOR[2], ! Header block descriptor CHANNEL: WORD, ! Channel assigned to input device FIB: BBLOCK[10], ! FIB ATR_DESC: BBLOCK[12], ! ACP attributes list HEADER: BBLOCK[512] ! File header VOLATILE, STATUS, ! Status variable IOSB: VECTOR[4,WORD]; ! I/O status block ! Get a descriptor for the device name and assign a channel to the device. ! NAM = .DUMP$GL_INAM; DESC[0] = .NAM[NAM$B_DEV]; DESC[1] = .NAM[NAM$L_DEV]; STATUS = $ASSIGN(DEVNAM=DESC, CHAN=CHANNEL); IF NOT .STATUS THEN BEGIN SIGNAL(DUMP$_READHEADER, 1, DUMP$GL_IDESC, .STATUS); RETURN; END; ! Initialize to read the primary file header. ! DESC[0] = 10; DESC[1] = FIB; FIB[FIB$L_ACCTL] = 0; FIB[FIB$W_FID_NUM] = .NAM[NAM$W_FID_NUM]; FIB[FIB$W_FID_SEQ] = .NAM[NAM$W_FID_SEQ]; FIB[FIB$W_FID_RVN] = .NAM[NAM$W_FID_RVN]; ATR_DESC[ATR$W_SIZE] = ATR$S_HEADER; ATR_DESC[ATR$W_TYPE] = ATR$C_HEADER; ATR_DESC[ATR$L_ADDR] = HEADER; ATR_DESC[8,0,32,0] = 0; ! Loop until there are no more headers to be dumped. ! WHILE TRUE DO BEGIN ! Read the file header. ! STATUS = $QIOW( FUNC=IO$_ACCESS, CHAN=.CHANNEL, IOSB=IOSB, P1=DESC, P5=ATR_DESC); IF .STATUS THEN STATUS = .IOSB[0]; IF NOT .STATUS THEN BEGIN SIGNAL(DUMP$_READHEADER, 1, DUMP$GL_IDESC, .STATUS); EXITLOOP; END; ! Dump the file header that was just read. ! IF .DUMP$GL_FLAGS[DUMP$V_FORMATTED] THEN BEGIN DUMP$NEW_PAGE(); DUMP$OUTPUT_GETMSG(DUMP$_HEADER, %B'0001'); DUMP$BLANK_LINE(); DUMP$ONE_HEADER(HEADER); END ELSE BEGIN HEADER_DESC[0] = 512; HEADER_DESC[1] = HEADER; DUMP$DUMP_BUFFER(HEADER_DESC, SS$_NORMAL, TRUE); END; ! Get the file ID of the next extension header, if any. ! IF .HEADER[FH2$B_STRUCLEV] EQL 2 THEN BEGIN FIB[FIB$W_FID_NUM] = .HEADER[FH2$W_EX_FIDNUM]; FIB[FIB$W_FID_SEQ] = .HEADER[FH2$W_EX_FIDSEQ]; FIB[FIB$B_FID_NMX] = .HEADER[FH2$B_EX_FIDNMX]; IF .HEADER[FH2$B_EX_FIDRVN] NEQ 0 THEN FIB[FIB$B_FID_RVN] = .HEADER[FH2$B_EX_FIDRVN]; END ELSE BEGIN LOCAL MAP_AREA: REF BBLOCK; MAP_AREA = HEADER + .HEADER[FH1$B_MPOFFSET]*2; FIB[FIB$W_FID_NUM] = .MAP_AREA[FM1$W_EX_FILNUM]; FIB[FIB$W_FID_SEQ] = .MAP_AREA[FM1$W_EX_FILSEQ]; END; ! If no more extension headers, we are done. ! IF .FIB[FIB$W_FID_NUM] EQL 0 THEN EXITLOOP; END; ! All done. Deassign the channel and return. ! $DASSGN(CHAN=.CHANNEL); END; ROUTINE CHECK_HEADER(HEADER)= !++ ! ! FUNCTIONAL DESCRIPTION: ! This routine validates a block as a file header. ! ! INPUT PARAMETERS: ! HEADER - Pointer to block. ! ! IMPLICIT INPUTS: ! NONE ! ! OUTPUT PARAMETERS: ! NONE ! ! IMPLICIT OUTPUTS: ! NONE ! ! ROUTINE VALUE: ! 0 if the block is not a valid header ! 1 if the block is a valid ODS-1 header ! 2 if the block is a valid ODS-2 header ! ! SIDE EFFECTS: ! NONE ! !-- BEGIN MAP HEADER: REF BBLOCK; ! Pointer to file header LOCAL SAVE_CHECK; ! Save checksum word ! Ensure that the checksum is correct. ! SAVE_CHECK = .HEADER[FH2$W_CHECKSUM]; IF NOT CHECKSUM(.HEADER) THEN BEGIN HEADER[FH2$W_CHECKSUM] = .SAVE_CHECK; RETURN 0; END; ! Basic validity test for an ODS-2 header. ! IF .HEADER[FH2$B_STRUCLEV] EQL 2 THEN BEGIN IF .HEADER[FH2$B_IDOFFSET] LSSU $BYTEOFFSET (FH2$L_HIGHWATER)/2 OR .HEADER[FH2$B_MPOFFSET] LSSU .HEADER[FH2$B_IDOFFSET] OR .HEADER[FH2$B_ACOFFSET] LSSU .HEADER[FH2$B_MPOFFSET] OR .HEADER[FH2$B_RSOFFSET] LSSU .HEADER[FH2$B_ACOFFSET] OR .HEADER[FH2$B_MAP_INUSE] GTRU .HEADER[FH2$B_ACOFFSET] - .HEADER[FH2$B_MPOFFSET] THEN RETURN 0 ELSE RETURN 2; END; ! Basic validity test for an ODS-1 header. ! IF .HEADER[FH2$B_STRUCLEV] EQL 1 THEN BEGIN LOCAL MAP_AREA: REF BBLOCK; ! Pointer to map area ! Check the area offsets, the extension RVN, and the retrieval pointer ! data for consistency. ! IF .HEADER[FH1$B_IDOFFSET] NEQ FH1$C_LENGTH / 2 THEN RETURN 0; MAP_AREA = .HEADER + .HEADER[FH1$B_MPOFFSET]*2; IF .MAP_AREA[FM1$B_EX_RVN] NEQ 0 OR .MAP_AREA[FM1$B_COUNTSIZE] NEQ 1 OR .MAP_AREA[FM1$B_LBNSIZE] NEQ 3 OR .MAP_AREA[FM1$B_INUSE] GTRU .MAP_AREA[FM1$B_AVAIL] OR .MAP_AREA[FM1$B_AVAIL] GTRU 255 - (.MAP_AREA + FM1$C_POINTERS - .HEADER) / 2 THEN RETURN 0 ELSE RETURN 1; END; RETURN 0; END; ROUTINE DUMP$FAO_(CTRL,PARAM): NOVALUE= !++ ! ! FUNCTIONAL DESCRIPTION: ! This routine interfaces to FAO to format information into the line. ! ! INPUT PARAMETERS: ! CTRL - ASCIC control string ! PARAM... - Parameters required by the control string (if any) ! ! IMPLICIT INPUTS: ! NONE ! ! OUTPUT PARAMETERS: ! NONE ! ! IMPLICIT OUTPUTS: ! Information formatted into the line buffer. ! ! ROUTINE VALUE: ! NONE ! ! SIDE EFFECTS: ! NONE ! !-- BEGIN MAP CTRL: REF VECTOR[,BYTE]; ! ASCIC control string LOCAL OUTLEN: WORD, ! $FAO resultant length DESC: VECTOR[2]; ! Control string descriptor DESC[0] = .CTRL[0]; DESC[1] = CTRL[1]; $FAOL(CTRSTR=DESC, OUTLEN=OUTLEN, OUTBUF=LINE_DESC, PRMLST=PARAM); LINE_DESC[0] = .LINE_DESC[0] - .OUTLEN; LINE_DESC[1] = .LINE_DESC[1] + .OUTLEN; END; ROUTINE DUMP$EOL: NOVALUE= !++ ! ! FUNCTIONAL DESCRIPTION: ! This routine writes the contents of the line buffer and reinitializes ! for a new line. ! ! INPUT PARAMETERS: ! NONE ! ! IMPLICIT INPUTS: ! LINE_DESC - Descriptor for line. ! ! OUTPUT PARAMETERS: ! NONE ! ! IMPLICIT OUTPUTS: ! NONE ! ! ROUTINE VALUE: ! NONE ! ! SIDE EFFECTS: ! NONE ! !-- BEGIN LINE_DESC[0] = .DUMP$GL_WIDTH - .LINE_DESC[0]; LINE_DESC[1] = .DUMP$GL_OUTDESC[DSC$A_POINTER]; DUMP$PUT_LINE(LINE_DESC); LINE_DESC[0] = .DUMP$GL_WIDTH; END; ROUTINE DUMP$PUT_FAO_(FAO,PARAM): NOVALUE= !++ ! ! FUNCTIONAL DESCRIPTION: ! This routine combines the actions of DUMP$FAO_ and DUMP$EOL. ! ! INPUT PARAMETERS: ! As for DUMP$FAO_. ! ! IMPLICIT INPUTS: ! NONE ! ! OUTPUT PARAMETERS: ! NONE ! ! IMPLICIT OUTPUTS: ! NONE ! ! ROUTINE VALUE: ! NONE ! ! SIDE EFFECTS: ! NONE ! !-- BEGIN BUILTIN CALLG, AP; CALLG(.AP, DUMP$FAO_); DUMP$EOL(); END; ROUTINE FORMAT_BIT_STRING(VALUE,CODES): NOVALUE= !++ ! ! FUNCTIONAL DESCRIPTION: ! This routine formats a bit mask. ! ! INPUT PARAMETERS: ! VALUE - The bit mask value. ! CODES - Pointer to a PLIT of ASCIC bit names. ! ! IMPLICIT INPUTS: ! NONE ! ! OUTPUT PARAMETERS: ! NONE ! ! IMPLICIT OUTPUTS: ! NONE ! ! ROUTINE VALUE: ! NONE ! ! SIDE EFFECTS: ! The listing is produced. ! !-- BEGIN MAP CODES: REF VECTOR; ! Value names LOCAL INIT_USED, ! Initial used space on line V; ! Local copy of value INIT_USED = .DUMP$GL_WIDTH - .LINE_DESC[0]; V = .VALUE; IF .V EQL 0 THEN DUMP$FAO('') ELSE INCR N FROM 0 TO 31 DO BEGIN IF .V THEN BEGIN IF (IF .N GEQU .CODES[-1] THEN TRUE ELSE .CODES[.N] EQL 0) THEN BEGIN IF .LINE_DESC[0] LSSU 8 THEN BEGIN DUMP$EOL(); DUMP$FAO('!#* ', .INIT_USED); END; DUMP$FAO('Bit !UL', .N); END ELSE BEGIN IF .LINE_DESC[0] LSSU 2 + .VECTOR[.CODES[.N], 0; ,BYTE] THEN BEGIN DUMP$EOL(); DUMP$FAO('!#* ', .INIT_USED); END; DUMP$FAO('!AC', .CODES[.N]); END; V = .V<1,31>; IF .V EQL 0 THEN EXITLOOP; DUMP$FAO(', '); END ELSE V = .V<1,31>; END; DUMP$EOL(); END; ROUTINE FORMAT_CODED_VALUE(VALUE,CODES): NOVALUE= !++ ! ! FUNCTIONAL DESCRIPTION: ! This routine formats a coded integer value. ! ! INPUT PARAMETERS: ! VALUE - The coded value. ! CODES - Pointer to a PLIT of ASCIC value names. ! ! IMPLICIT INPUTS: ! NONE ! ! OUTPUT PARAMETERS: ! NONE ! ! IMPLICIT OUTPUTS: ! NONE ! ! ROUTINE VALUE: ! NONE ! ! SIDE EFFECTS: ! The listing is produced. ! !-- BEGIN MAP CODES: REF VECTOR; ! Value names IF .VALUE GEQU .CODES[-1] THEN DUMP$PUT_FAO('!UL', .VALUE) ELSE DUMP$PUT_FAO('!AC', .CODES[.VALUE]); END; ROUTINE FORMAT_DATE_VALUE(VALUE): NOVALUE= !++ ! ! FUNCTIONAL DESCRIPTION: ! This routine formats a standard system date. ! ! INPUT PARAMETERS: ! VALUE - Pointer to the system date. ! ! IMPLICIT INPUTS: ! NONE ! ! OUTPUT PARAMETERS: ! NONE ! ! IMPLICIT OUTPUTS: ! NONE ! ! ROUTINE VALUE: ! NONE ! ! SIDE EFFECTS: ! The listing is produced. ! !-- BEGIN MAP VALUE: REF VECTOR; ! Pointer to date IF .VALUE[0] EQL 0 THEN DUMP$PUT_FAO('') ELSE DUMP$PUT_FAO('!%D', .VALUE); END; ROUTINE FORMAT_ODS1_DATE_VALUE(VALUE): NOVALUE= !++ ! ! FUNCTIONAL DESCRIPTION: ! This routine formats an ODS-1 date. ! ! INPUT PARAMETERS: ! VALUE - Pointer to the ODS-1 date. ! ! IMPLICIT INPUTS: ! NONE ! ! OUTPUT PARAMETERS: ! NONE ! ! IMPLICIT OUTPUTS: ! NONE ! ! ROUTINE VALUE: ! NONE ! ! SIDE EFFECTS: ! The listing is produced. ! !-- BEGIN MAP VALUE: REF VECTOR[,BYTE]; ! Pointer to date IF .VALUE[0] EQL 0 THEN DUMP$FAO('') ELSE BEGIN DUMP$FAO('!AF-!AF-19!AF', 2, VALUE[0], 3, VALUE[2], 2, VALUE[5]); IF .VALUE[7] NEQ 0 THEN DUMP$FAO(' !AF:!AF:!AF', 2, VALUE[7], 2, VALUE[9], 2, VALUE[11]); END; DUMP$EOL(); END; ROUTINE FORMAT_PROTECTION(PROT,CODES): NOVALUE= !++ ! ! FUNCTIONAL DESCRIPTION: ! This routine formats a protection value. ! ! INPUT PARAMETERS: ! PROT - A protection value. ! CODES - The four letter codes, e.g. 'RWED'. ! ! IMPLICIT INPUTS: ! NONE ! ! OUTPUT PARAMETERS: ! NONE ! ! IMPLICIT OUTPUTS: ! NONE ! ! ROUTINE VALUE: ! NONE ! ! SIDE EFFECTS: ! The listing is produced. ! !-- BEGIN MAP PROT: BITVECTOR[16], ! Protection value CODES: VECTOR[,BYTE]; ! Letter codes BIND WHO = UPLIT ( UPLIT BYTE (%ASCIC 'S:'), UPLIT BYTE (%ASCIC ', O:'), UPLIT BYTE (%ASCIC ', G:'), UPLIT BYTE (%ASCIC ', W:')) : VECTOR; INCR I FROM 0 TO 3 DO BEGIN DUMP$FAO('!AC', .WHO[.I]); INCR J FROM 0 TO 3 DO BEGIN IF NOT .PROT[.I*4+.J] THEN DUMP$FAO('!AD', 1, CODES[.J]); END; END; DUMP$EOL(); END; ROUTINE FORMAT_RMS_ATTRIBUTES(FAT): NOVALUE= !++ ! ! FUNCTIONAL DESCRIPTION: ! This routine formats the RMS attributes. ! ! INPUT PARAMETERS: ! FAT - Pointer to attributes area. ! ! IMPLICIT INPUTS: ! NONE ! ! OUTPUT PARAMETERS: ! NONE ! ! IMPLICIT OUTPUTS: ! NONE ! ! ROUTINE VALUE: ! NONE ! ! SIDE EFFECTS: ! NONE ! !-- BEGIN MAP FAT: REF BBLOCK; ! Pointer to RMS attributes area BUILTIN ROT; BIND RTYPE_CODES = PLIT( UPLIT BYTE (%ASCIC 'Undefined'), UPLIT BYTE (%ASCIC 'Fixed'), UPLIT BYTE (%ASCIC 'Variable'), UPLIT BYTE (%ASCIC 'Variable with fixed control'), UPLIT BYTE (%ASCIC 'RMS-11 stream'), UPLIT BYTE (%ASCIC 'LF-terminated stream'), UPLIT BYTE (%ASCIC 'CR-terminated stream')), FILEORG_CODES = PLIT( UPLIT BYTE (%ASCIC 'Sequential'), UPLIT BYTE (%ASCIC 'Relative'), UPLIT BYTE (%ASCIC 'Indexed'), UPLIT BYTE (%ASCIC 'Direct')), RATTRIB_CODES = PLIT( UPLIT BYTE (%ASCIC 'FORTRAN carriage control'), UPLIT BYTE (%ASCIC 'Implied carriage control'), UPLIT BYTE (%ASCIC 'Print carriage control'), UPLIT BYTE (%ASCIC 'Non-spanned')); DUMP$PUT_LINE($DESCRIPTOR(' VAX-11 RMS attributes')); DUMP$FAO('!8* Record type:!22* '); FORMAT_CODED_VALUE(.FAT[FAT$V_RTYPE], RTYPE_CODES); DUMP$FAO('!8* File organization:!16* '); FORMAT_CODED_VALUE(.FAT[FAT$V_FILEORG], FILEORG_CODES); DUMP$FAO('!8* Record attributes:!16* '); FORMAT_BIT_STRING(.FAT[FAT$B_RATTRIB], RATTRIB_CODES); DUMP$PUT_FAO('!8* Record size:!22* !UL', .FAT[FAT$W_RSIZE]); DUMP$PUT_FAO('!8* Highest block:!20* !UL', ROT(.FAT[FAT$L_HIBLK], 16)); DUMP$PUT_FAO('!8* End of file block:!16* !UL', ROT(.FAT[FAT$L_EFBLK], 16)); DUMP$PUT_FAO('!8* End of file byte:!17* !UL', .FAT[FAT$W_FFBYTE]); DUMP$PUT_FAO('!8* Bucket size:!22* !UL', .FAT[FAT$B_BKTSIZE]); DUMP$PUT_FAO('!8* Fixed control area size:!10* !UL', .FAT[FAT$B_VFCSIZE]); DUMP$PUT_FAO('!8* Maximum record size:!14* !UL', .FAT[FAT$W_MAXREC]); DUMP$PUT_FAO('!8* Default extension size:!11* !UL', .FAT[FAT$W_DEFEXT]); DUMP$PUT_FAO('!8* Global buffer count:!14* !UL', .FAT[FAT$W_GBC]); DUMP$PUT_FAO('!8* Directory version limit:!10* !UL', .FAT[FAT$W_VERSIONS]); END; GLOBAL ROUTINE DUMP$ONE_HEADER(HEADER)= !++ ! ! FUNCTIONAL DESCRIPTION: ! This routine dumps one block as a file header if it is valid. ! ! INPUT PARAMETERS: ! HEADER - Pointer to block. ! ! IMPLICIT INPUTS: ! NONE ! ! OUTPUT PARAMETERS: ! NONE ! ! IMPLICIT OUTPUTS: ! NONE ! ! ROUTINE VALUE: ! True if the block was a valid file header and was dumped, ! otherwise false. ! ! SIDE EFFECTS: ! NONE ! !-- BEGIN MAP HEADER: REF BBLOCK; ! Pointer to file header LOCAL STRUCLEV, ! Structure level IDENT_AREA: REF BBLOCK, ! Pointer to ident area IDENT_LENGTH, ! Length of ident area MAP_AREA: REF BBLOCK, ! Pointer to map area MAP_LENGTH, ! Length of map area ACE_POINTER : REF BBLOCK, ! Pointer to current ACE ACE_BINDESC : BBLOCK [8], ! Descriptor to binary ACE ACE_TXTDESC : BBLOCK [8], ! Descriptor to converted ACE ACE_TEXT : BBLOCK [512]; ! Storage for converted ACE BIND FCH_CODES = PLIT( 0, UPLIT BYTE (%ASCIC 'No backup'), UPLIT BYTE (%ASCIC 'Write-back cache'), UPLIT BYTE (%ASCIC 'Read check'), UPLIT BYTE (%ASCIC 'Write check'), UPLIT BYTE (%ASCIC 'Contiguous best try'), UPLIT BYTE (%ASCIC 'Deaccess locked'), UPLIT BYTE (%ASCIC 'Contiguous'), 0, 0, 0, UPLIT BYTE (%ASCIC 'Corrupted Access Control List'), UPLIT BYTE (%ASCIC 'Spool file'), UPLIT BYTE (%ASCIC 'Directory'), UPLIT BYTE (%ASCIC 'Suspected bad blocks'), UPLIT BYTE (%ASCIC 'Marked for delete'), UPLIT BYTE (%ASCIC 'Space not charged'), UPLIT BYTE (%ASCIC 'Erase on delete')), FJN_CODES = PLIT( UPLIT BYTE (%ASCIC 'Accessible only in recovery unit'), UPLIT BYTE (%ASCIC 'Enable recovery unit journal'), UPLIT BYTE (%ASCIC 'Before image journal'), UPLIT BYTE (%ASCIC 'After image journal'), UPLIT BYTE (%ASCIC 'Audit trail journal')), PLACEMENT_CODES = PLIT( UPLIT BYTE (%ASCIC 'Exact'), UPLIT BYTE (%ASCIC 'Cylinder boundary'), 0, 0, 0, 0, 0, 0, 0, 0, 0, 0, UPLIT BYTE (%ASCIC 'Specific LBN'), UPLIT BYTE (%ASCIC 'Specific RVN')); BUILTIN ROT; ! Validate the header. ! STRUCLEV = CHECK_HEADER(.HEADER); IF .STRUCLEV EQL 0 THEN RETURN 0; ! Initialize. ! LINE_DESC[0] = .DUMP$GL_WIDTH; LINE_DESC[1] = .DUMP$GL_OUTDESC[DSC$A_POINTER]; IDENT_AREA = .HEADER + .HEADER[FH2$B_IDOFFSET]*2; MAP_AREA = .HEADER + .HEADER[FH2$B_MPOFFSET]*2; IDENT_LENGTH = .MAP_AREA - .IDENT_AREA; MAP_LENGTH = HEADER[FH2$W_CHECKSUM] - .MAP_AREA; ! If the header is valid, dump it in the proper format. ! DUMP$PUT_LINE($DESCRIPTOR('Header area')); DUMP$PUT_FAO(' Identification area offset:!11* !UL', .HEADER[FH2$B_IDOFFSET]); DUMP$PUT_FAO(' Map area offset:!22* !UL', .HEADER[FH2$B_MPOFFSET]); IF .STRUCLEV EQL 2 THEN BEGIN LOCAL P: REF BBLOCK; DUMP$PUT_FAO(' Access control area offset:!11* !UL', .HEADER[FH2$B_ACOFFSET]); DUMP$PUT_FAO(' Reserved area offset:!17* !UL', .HEADER[FH2$B_RSOFFSET]); DUMP$PUT_FAO(' Extension segment number:!13* !UL', .HEADER[FH2$W_SEG_NUM]); DUMP$PUT_FAO(' Structure level and version:!10* !UL, !UL', .HEADER[FH2$B_STRUCLEV], .HEADER[FH2$B_STRUCVER]); DUMP$PUT_FAO(' File identification:!18* (!UL,!UL,!UL)', .HEADER[FH2$W_FID_NUM] + .HEADER[FH2$B_FID_NMX]^16, .HEADER[FH2$W_FID_SEQ], .HEADER[FH2$B_FID_RVN]); DUMP$PUT_FAO(' Extension file identification:!8* (!UL,!UL,!UL)', .HEADER[FH2$W_EX_FIDNUM] + .HEADER[FH2$B_EX_FIDNMX]^16, .HEADER[FH2$W_EX_FIDSEQ], .HEADER[FH2$B_EX_FIDRVN]); FORMAT_RMS_ATTRIBUTES(HEADER[FH2$W_RECATTR]); DUMP$FAO(' File characteristics:!17* '); FORMAT_BIT_STRING(.HEADER[FH2$L_FILECHAR], FCH_CODES); %( DUMP$FAO(' Record protection:!20* '); FORMAT_PROTECTION(.HEADER[FH2$W_RECPROT], 'RWCD'); )% DUMP$PUT_FAO(' Map area words in use:!16* !UL', .HEADER[FH2$B_MAP_INUSE]); DUMP$PUT_FAO(' Access mode:!26* !UL', .HEADER[FH2$B_ACC_MODE]); DUMP$PUT_FAO(' File owner UIC:!23* !%I', .HEADER[FH2$L_FILEOWNER]); DUMP$FAO(' File protection:!22* '); FORMAT_PROTECTION(.HEADER[FH2$W_FILEPROT], 'RWED'); DUMP$PUT_FAO(' Back link file identification:!8* (!UL,!UL,!UL)', .HEADER[FH2$W_BK_FIDNUM] + .HEADER[FH2$B_BK_FIDNMX]^16, .HEADER[FH2$W_BK_FIDSEQ], .HEADER[FH2$B_BK_FIDRVN]); DUMP$FAO(' Journal control flags:!16* '); FORMAT_BIT_STRING(.HEADER[FH2$B_JOURNAL], FJN_CODES); DUMP$PUT_FAO(' Highest block written:!16* !UL', (IF .HEADER[FH2$L_HIGHWATER] GTR 0 THEN .HEADER[FH2$L_HIGHWATER] - 1 ELSE 0)); DUMP$BLANK_LINE(); DUMP$PUT_LINE($DESCRIPTOR('Identification area')); IF .IDENT_LENGTH GEQU $BYTEOFFSET(FI2$W_REVISION) THEN IF .HEADER[FH2$B_MPOFFSET] - .HEADER[FH2$B_IDOFFSET] GEQU ($BYTEOFFSET (FI2$T_FILENAMEXT) + FI2$S_FILENAMEXT) / 2 THEN DUMP$PUT_FAO(' File name:!28* !AF!AF', FI2$S_FILENAME, IDENT_AREA[FI2$T_FILENAME], FI2$S_FILENAMEXT, IDENT_AREA[FI2$T_FILENAMEXT]) ELSE DUMP$PUT_FAO(' File name:!28* !AF', FI2$S_FILENAME, IDENT_AREA[FI2$T_FILENAME]); IF .IDENT_LENGTH GEQU $BYTEOFFSET(FI2$Q_CREDATE) THEN DUMP$PUT_FAO(' Revision number:!22* !UL', .IDENT_AREA[FI2$W_REVISION]); IF .IDENT_LENGTH GEQU $BYTEOFFSET(FI2$Q_REVDATE) THEN BEGIN DUMP$FAO(' Creation date:!24* '); FORMAT_DATE_VALUE(IDENT_AREA[FI2$Q_CREDATE]); END; IF .IDENT_LENGTH GEQU $BYTEOFFSET(FI2$Q_EXPDATE) THEN BEGIN DUMP$FAO(' Revision date:!24* '); FORMAT_DATE_VALUE(IDENT_AREA[FI2$Q_REVDATE]); END; IF .IDENT_LENGTH GEQU $BYTEOFFSET(FI2$Q_BAKDATE) THEN BEGIN DUMP$FAO(' Expiration date:!22* '); FORMAT_DATE_VALUE(IDENT_AREA[FI2$Q_EXPDATE]); END; IF .IDENT_LENGTH GEQU FI2$C_LENGTH THEN BEGIN DUMP$FAO(' Backup date:!26* '); FORMAT_DATE_VALUE(IDENT_AREA[FI2$Q_BAKDATE]); END; DUMP$BLANK_LINE(); DUMP$PUT_LINE($DESCRIPTOR('Map area')); DUMP$PUT_LINE($DESCRIPTOR(' Retrieval pointers')); P = .MAP_AREA; UNTIL .P GEQA .MAP_AREA + .HEADER[FH2$B_MAP_INUSE]*2 DO BEGIN IF .P[FM2$V_FORMAT] EQL FM2$C_PLACEMENT THEN BEGIN DUMP$FAO('!8* Placement control: '); FORMAT_BIT_STRING(.P[0,0,14,0], PLACEMENT_CODES); P = .P + 2; END ELSE BEGIN LOCAL COUNT, LBN; CASE .P[FM2$V_FORMAT] FROM FM2$C_FORMAT1 TO FM2$C_FORMAT3 OF SET [FM2$C_FORMAT1]: BEGIN COUNT = .P[FM2$B_COUNT1]; LBN = .P[FM2$W_LOWLBN]; LBN<16,16> = .P[FM2$V_HIGHLBN]; P = .P + 4; END; [FM2$C_FORMAT2]: BEGIN COUNT = .P[FM2$V_COUNT2]; LBN = .P[FM2$L_LBN2]; P = .P + 6; END; [FM2$C_FORMAT3]: BEGIN COUNT = ROT(..P, 16) AND (1^30-1); LBN = .P[FM2$L_LBN3]; P = .P + 8; END; TES; DUMP$PUT_FAO('!8* Count: !10UL!8* LBN: !10UL', .COUNT + 1, .LBN); END; END; IF .HEADER[FH2$B_ACOFFSET] NEQ .HEADER[FH2$B_RSOFFSET] THEN BEGIN DUMP$BLANK_LINE (); DUMP$PUT_LINE ($DESCRIPTOR ('Access Control List')); ACE_POINTER = .HEADER + .HEADER[FH2$B_ACOFFSET]*2; CH$FILL (0, 8, ACE_BINDESC); CH$FILL (0, 8, ACE_TXTDESC); UNTIL .ACE_POINTER[ACE$B_SIZE] EQL 0 OR .ACE_POINTER GEQA .HEADER + .HEADER[FH2$B_RSOFFSET]*2 DO BEGIN ACE_BINDESC[DSC$W_LENGTH] = .ACE_POINTER[ACE$B_SIZE]; ACE_BINDESC[DSC$A_POINTER] = .ACE_POINTER; ACE_TXTDESC[DSC$W_LENGTH] = 512; ACE_TXTDESC[DSC$A_POINTER] = ACE_TEXT; $FORMAT_ACL (ACLENT = ACE_BINDESC, ACLLEN = ACE_TXTDESC[DSC$W_LENGTH], ACLSTR = ACE_TXTDESC, WIDTH = %REF (80), TRMDSC = $DESCRIPTOR (%CHAR (13), %CHAR (10)), INDENT = %REF (4)); DUMP$PUT_LINE (ACE_TXTDESC); ACE_POINTER = .ACE_POINTER + .ACE_POINTER[ACE$B_SIZE]; END; END; IF .HEADER[FH2$B_RSOFFSET] NEQ $BYTEOFFSET (FH2$W_CHECKSUM) / 2 THEN BEGIN DUMP$BLANK_LINE (); DUMP$PUT_LINE ($DESCRIPTOR ('User reserved area')); P = .HEADER + .HEADER[FH2$B_RSOFFSET]*2; DO BEGIN CASE HEADER[FH2$W_CHECKSUM] - .P FROM 1 TO 3 OF SET [1]: BEGIN DUMP$PUT_FAO (' !XB "!AF"', .P[0, 0, 8, 0], 1, .P); P = .P + 1; END; [2]: BEGIN DUMP$PUT_FAO (' !XW "!AF"', .P[0, 0, 16, 0], 2, .P); P = .P + 2; END; [3]: BEGIN DUMP$PUT_FAO (' !6XL "!AF"', .P[0, 0, 24, 0], 3, .P); P = .P + 3; END; [OUTRANGE]: BEGIN DUMP$PUT_FAO (' !XL "!AF"', .P[0, 0, 32, 0], 4, .P); P = .P + 4; END; TES END UNTIL .P GEQA HEADER[FH2$W_CHECKSUM]; END; END ELSE BEGIN LOCAL P: REF BBLOCK, FILE_NAME: VECTOR[20,BYTE], FILE_LENGTH; DUMP$PUT_FAO(' File identification:!18* (!UL,!UL)', .HEADER[FH1$W_FID_NUM], .HEADER[FH1$W_FID_SEQ]); DUMP$PUT_FAO(' Structure level and version:!10* !UL, !UL', .HEADER[FH2$B_STRUCLEV], .HEADER[FH2$B_STRUCVER]); DUMP$PUT_FAO(' File owner UIC:!23* !%I', .HEADER[FH1$B_UICGROUP]^16 OR .HEADER[FH1$B_UICMEMBER]); DUMP$FAO(' File protection:!22* '); FORMAT_PROTECTION(.HEADER[FH1$W_FILEPROT], 'RWED'); DUMP$FAO(' File characteristics:!17* '); FORMAT_BIT_STRING(.HEADER[FH1$W_FILECHAR], FCH_CODES); FORMAT_RMS_ATTRIBUTES(HEADER[FH1$W_RECATTR]); DUMP$BLANK_LINE(); DUMP$PUT_LINE($DESCRIPTOR('Identification area')); FILE_LENGTH = MAKE_STRING( IDENT_AREA[FI1$W_FILENAME] - $BYTEOFFSET(NMB$W_NAME), FILE_NAME); DUMP$PUT_FAO(' File name:!28* !AF', .FILE_LENGTH, FILE_NAME); DUMP$PUT_FAO(' Revision number:!22* !UL', .IDENT_AREA[FI1$W_REVISION]); DUMP$FAO(' Revision date:!24* '); FORMAT_ODS1_DATE_VALUE(IDENT_AREA[FI1$T_REVDATE]); DUMP$FAO(' Creation date:!24* '); FORMAT_ODS1_DATE_VALUE(IDENT_AREA[FI1$T_CREDATE]); DUMP$FAO(' Expiration date:!22* '); FORMAT_ODS1_DATE_VALUE(IDENT_AREA[FI1$T_EXPDATE]); DUMP$BLANK_LINE(); DUMP$PUT_LINE($DESCRIPTOR('Map area')); DUMP$PUT_FAO(' Extension segment number:!13* !UL', .MAP_AREA[FM1$B_EX_SEGNUM]); DUMP$PUT_FAO(' Extension file identification:!8* (!UL,!UL,!UL)', .MAP_AREA[FM1$W_EX_FILNUM], .MAP_AREA[FM1$W_EX_FILSEQ], .MAP_AREA[FM1$B_EX_RVN]); DUMP$PUT_FAO(' Retrieval pointer count size:!9* !UL', .MAP_AREA[FM1$B_COUNTSIZE]); DUMP$PUT_FAO(' Retrieval pointer LBN size:!11* !UL', .MAP_AREA[FM1$B_LBNSIZE]); DUMP$PUT_FAO(' Map area words in use:!16* !UL', .MAP_AREA[FM1$B_INUSE]); DUMP$PUT_FAO(' Map area words available:!13* !UL', .MAP_AREA[FM1$B_AVAIL]); DUMP$PUT_LINE($DESCRIPTOR(' Retrieval pointers')); P = .MAP_AREA + FM1$C_POINTERS; UNTIL .P GEQA .MAP_AREA + FM1$C_POINTERS + .MAP_AREA[FM1$B_INUSE]*2 DO BEGIN DUMP$PUT_FAO('!8* Count: !10UL!8* LBN: !10UL', .P[FM1$B_COUNT] + 1, .P[FM1$W_LOWLBN] + .P[FM1$B_HIGHLBN]^16); P = .P + 4; END; END; DUMP$BLANK_LINE(); DUMP$PUT_FAO('Checksum:!33* !UL', .HEADER[FH2$W_CHECKSUM]); RETURN 1; END; END ELUDOM