Trailing-Edge
-
PDP-10 Archives
-
BB-JF18A-BM
-
sources/rms/rmsdmp.b36
There are 6 other files named rmsdmp.b36 in the archive. Click here to see a list.
%TITLE 'D E B G -- $DEBUG and debugging code'
!<BLF/REQUIRE 'RMSBLF.REQ'>
MODULE debg (IDENT = '3.0'
) =
BEGIN
!
! COPYRIGHT (C) DIGITAL EQUIPMENT CORPORATION 1984, 1986.
! 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 THAT IS NOT SUPPLIED BY DIGITAL.
!
!
! COPYRIGHT (c) 1984 BY
! DIGITAL EQUIPMENT CORPORATION, MAYNARD, MASS.
!
! 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: RMS
!
! ABSTRACT:
!
! DEBG contains all routines which support and
! process the debugging facilities of RMS-20.
!
! ENVIRONMENT: User mode, compiled with debugging enabled
!
! AUTHOR: Ron Lusk , CREATION DATE: 17-Mar-83
!
! MODIFIED BY:
!
! , : VERSION
! 01 -
!--
!
! TABLE OF CONTENTS
!
!
! $DEBUG - process $DEBUG verb
! DUMP -
! DUMPRST - dump a Record Status Table
! DUMPIDB - dump an Index Descriptor Block
! DUMPKDB - dump a Key Descriptor Block
! DUMPRD - dump a Record Descriptor
! DUMPHEADER - dump a Bucket Header
!
!
! INCLUDE FILES:
!
REQUIRE 'rmsreq';
!
! MACROS:
!
! None.
!
! EQUATED SYMBOLS:
!
GLOBAL BIND
debgv = 2^24 + 0^18 + 400; ! Module version
!
! OWN STORAGE:
!
! None.
!
! EXTERNAL REFERENCES:
!
EXTERNAL
D$gTrace;
EXTERNAL ROUTINE
NoValRet;
%SBTTL '$DEBUG -- $DEBUG processor'
GLOBAL ROUTINE $debug (bitvalue, dummyarg) : NOVALUE =
!++
! FUNCTIONAL DESCRIPTION:
!
! $DEBUG processes the $DEBUG macro for using the
! RMS-20 debugging facilities. The format of this
! macro is as follows:
!
! $DEBUG (value-1 [ OR value-n ... ]); in BLISS
!
! or
!
! $DEBUG value-1 [ ! value-n ... ] in MACRO
!
! Values are:
! DB$TRC - Trace entry to each routine
! DB$ERR - Trace user errors
! DB$RTR - Trace routine execution
! DB$LOC - Print out local variables
! DB$ENQ - Print out ENQ blocks
! DB$BLK - Print out all internal RMS-20 blocks
! DB$IO - Trace I/O page faults (buffer faults)
!
!
! FORMAL PARAMETERS
!
! BITVALUE - Value to set for debugging
!
! IMPLICIT INPUTS
!
! ?
!
! ROUTINE VALUE:
!
! NONE.
!
! SIDE EFFECTS:
!
! ?
!
!--
BEGIN
bugflg = .bitvalue; ! Set debugging flags
IF (.bugflg AND dbg$m_dap_trace) NEQ 0
THEN D$Gtrace = -1
ELSE D$Gtrace = 0;
NoValRet ();
END; ! End of $DEBUG
%SBTTL 'DUMP -- Dump a block of data'
GLOBAL ROUTINE dump (blksiz, blkaddr) : NOVALUE =
!++
! FUNCTIONAL DESCRIPTION:
!
! This routine is used for debugging only. It
! prints out the contents of a block in core.
!
! FORMAL PARAMETERS
!
! BLKSIZ - length of block to dump
! BLKADDR - address to start dumping (passed as value)
!
! IMPLICIT INPUTS
!
! ?
!
! ROUTINE VALUE:
!
! None.
!
! SIDE EFFECTS:
!
! ?
!
!--
BEGIN
%IF dbug
%THEN
LOCAL
datablock; ! Need temporary local
datablock = .blkaddr; ! Get address of block
!
! Loop over the entire block.
!
INCR j FROM 1 TO .blksiz DO
BEGIN
txtout (mf$oct, .datablock); ! Put out <TAB>octal number
datablock = .datablock + 1; ! Bump pointer
END
%ELSE
RETURN;
%FI
END; ! End of DUMP
%SBTTL 'DUMPRST -- Dump Record Status Table'
GLOBAL ROUTINE dumprst : NOVALUE =
!++
! FUNCTIONAL DESCRIPTION:
!
! DUMPRST prints out a formatted copy of the
! Record Status Table for use in debugging.
!
! FORMAL PARAMETERS
!
! None.
!
! IMPLICIT INPUTS
!
! The Record Status Table pointed to by RST.
!
! ROUTINE VALUE:
!
! NONE.
!
! SIDE EFFECTS:
!
! None.
!
!--
BEGIN
%IF dbug
%THEN
bugout ('** Dump of RST **');%([ PRINT OUT EACH FIELD ])%
txtout (mf$rsf, $stradd ('BLOCKTYPE'), .rst [blocktype]);
txtout (mf$rsf, $stradd ('BLOCKLENGTH'), .rst [blocklength]);
txtout (mf$rsf, $stradd ('BLINK'), .rst [blink]);
txtout (mf$rsf, $stradd ('FLINK'), .rst [flink]);
txtout (mf$rsf, $stradd ('RSTRSZ'), .rst [rstrsz]);
txtout (mf$rsf, $stradd ('RSTRSZW'), .rst [rstrszw]);
txtout (mf$rsf, $stradd ('RSTDATARFA'), .rst [rstdatarfa]);
txtout (mf$rsf, $stradd ('RSTFLAGS'), .rst [rstflags]);
txtout (mf$rsf, $stradd ('RSTPAGPTR'), .rst [rstpagptr]);
txtout (mf$rsf, $stradd ('RSTLASTOPER'), .rst [rstlastoper]);
txtout (mf$rsf, $stradd ('RSTNRP'), .rst [rstnrp]);
type (''); ! Blank line
RETURN
%ELSE
RETURN;
%FI
END; ! End of DUMPRST
%SBTTL 'DUMPIDB -- Dump Index Descriptor Block'
GLOBAL ROUTINE dumpidb (idbptr : REF BLOCK) : NOVALUE =
!++
! FUNCTIONAL DESCRIPTION:
!
! DUMPIDB dumps out the contents of an Index
! Descriptor Block pointed to by IDBPTR.
!
! FORMAL PARAMETERS
!
! IDBPTR - Pointer to Index Descriptor Block
!
! IMPLICIT INPUTS
!
! None.
!
! ROUTINE VALUE:
!
! None.
!
! SIDE EFFECTS:
!
! None.
!
!--
BEGIN
%IF dbug
%THEN
txtout (mf$rsf, $stradd ('BLOCKTYPE'), .idbptr [blocktype]);
txtout (mf$rsf, $stradd ('BLOCKLENGTH'), .idbptr [blocklength]);
txtout (mf$rsf, $stradd ('IDBROOT'), .idbptr [idbroot]);
txtout (mf$rsf, $stradd ('IDBLEVELS'), .idbptr [idblevels]);
txtout (mf$rsf, $stradd ('IDBNXT'), .idbptr [idbnxt]);
RETURN
%ELSE
RETURN;
%FI
END; ! End of DUMPIDB
%SBTTL 'DUMPKDB -- Dump Key Descriptor Block'
GLOBAL ROUTINE dumpkdb (kdbptr : REF BLOCK) : NOVALUE =
!++
! FUNCTIONAL DESCRIPTION:
!
! DUMPKDB dumps a Key Descriptor Block pointed to by
! KDBPTR.
!
! FORMAL PARAMETERS
!
! KDBPTR - pointer to a Key Descriptor Block
!
! IMPLICIT INPUTS
!
! None.
!
! ROUTINE VALUE:
!
! None.
!
! SIDE EFFECTS:
!
! None.
!
!--
BEGIN
%IF dbug
%THEN
txtout (mf$rsf, $stradd ('BLOCKTYPE'), .kdbptr [blocktype]);
txtout (mf$rsf, $stradd ('BLOCKLENGTH'), .kdbptr [blocklength]);
txtout (mf$rsf, $stradd ('KDBROOT'), .kdbptr [kdbroot]);
txtout (mf$rsf, $stradd ('KDBHSZ'), .kdbptr [kdbhsz]);
txtout (mf$rsf, $stradd ('KDBKSZ'), .kdbptr [kdbksz]);
txtout (mf$rsf, $stradd ('KDBKSZW'), .kdbptr [kdbkszw]);
txtout (mf$rsf, $stradd ('KDBDTP'), .kdbptr [kdbdtp]);
txtout (mf$rsf, $stradd ('KDBREF'), .kdbptr [kdbref]);
txtout (mf$rsf, $stradd ('KDBIDBADDR'), .kdbptr [kdbidbaddr]);
txtout (mf$rsf, $stradd ('KDBFLAGS'), .kdbptr [kdbflags]);
txtout (mf$rsf, $stradd ('KDBNXT'), .kdbptr [kdbnxt]);
txtout (mf$rsf, $stradd ('KDBIFLOFFSET'), .kdbptr [kdbifloffset]);
txtout (mf$rsf, $stradd ('KDBDFLOFFSET'), .kdbptr [kdbdfloffset]);
txtout (mf$rsf, $stradd ('KDBIAN'), .kdbptr [kdbian]);
txtout (mf$rsf, $stradd ('KDBDAN'), .kdbptr [kdbdan]);
txtout (mf$rsf, $stradd ('KDBKBSZ'), .kdbptr [kdbkbsz]);
txtout (mf$rsf, $stradd ('KDBLEVELS'), .kdbptr [kdblevels]);
txtout (mf$rsf, $stradd ('KDBMINRSZ'), .kdbptr [kdbminrsz]);
txtout (mf$rsf, $stradd ('KDBIBKZ'), .kdbptr [kdbibkz]);
txtout (mf$rsf, $stradd ('KDBDBKZ'), .kdbptr [kdbdbkz]);
!
! Note that the key position and size fields
! are not printed out.
!
RETURN;
%ELSE
RETURN;
%FI
END; ! End of DUMPKDB
%SBTTL 'DUMPRD -- Dump a record descriptor'
GLOBAL ROUTINE dumprd (rdptr : REF BLOCK) : NOVALUE =
!++
! FUNCTIONAL DESCRIPTION:
!
! DUMPRD dumps out the contents of a Record Descriptor
! packet pointed to by RDPTR.
!
! FORMAL PARAMETERS
!
! RDPTR - pointer to Record Descriptor packet
!
! IMPLICIT INPUTS
!
! None.
!
! ROUTINE VALUE:
!
! None.
!
! SIDE EFFECTS:
!
! None.
!
!--
BEGIN
%IF dbug
%THEN
txtout (mf$rsf, $stradd ('RDFLAGS'), .rdptr [rdflags]);
txtout (mf$rsf, $stradd ('RDSTATUS'), .rdptr [rdstatus]);
txtout (mf$rsf, $stradd ('RDUSERSIZE'), .rdptr [rdusersize]);
txtout (mf$rsf, $stradd ('RDCOUNT'), .rdptr [rdcount]);
txtout (mf$rsf, $stradd ('RDLASTLEVEL'), .rdptr [rdlastlevel]);
txtout (mf$rsf, $stradd ('RDLEVEL'), .rdptr [rdlevel]);
txtout (mf$rsf, $stradd ('RDUSERPTR'), .rdptr [rduserptr]);
txtout (mf$rsf, $stradd ('RDRFA'), .rdptr [rdrfa]);
txtout (mf$rsf, $stradd ('RDRECPTR'), .rdptr [rdrecptr]);
txtout (mf$rsf, $stradd ('RDLASTRECPTR'), .rdptr [rdlastrecptr]);
txtout (mf$rsf, $stradd ('RDRRV'), .rdptr [rdrrv]);
txtout (mf$rsf, $stradd ('RDLENGTH'), .rdptr [rdlength]);
RETURN
%ELSE
RETURN;
%FI
END; ! End of DUMPRD
%SBTTL 'DUMPHEADER - dump bucket header'
GLOBAL ROUTINE dumpheader (bktptr : REF BLOCK) : NOVALUE =
!++
! FUNCTIONAL DESCRIPTION:
!
! DUMPHEADER dumps the header of an indexed file
! bucket pointed to by BKTPTR.
!
! FORMAL PARAMETERS
!
! BKTPTR - Pointer to bucket header
!
! IMPLICIT INPUTS
!
! None.
!
! ROUTINE VALUE:
!
! None.
!
! SIDE EFFECTS:
!
! None.
!
!--
BEGIN
%IF dbug
%THEN
txtout (mf$rsf, $stradd ('BHFLAGS'), .bktptr [bhflags]);
txtout (mf$rsf, $stradd ('BHLEVEL'), .bktptr [bhlevel]);
txtout (mf$rsf, $stradd ('BHBTYPE'), .bktptr [bhbtype]);
txtout (mf$rsf, $stradd ('BHNEXTBYTE'), .bktptr [bhnextbyte]);
txtout (mf$rsf, $stradd ('BHTHISAREA'), .bktptr [bhthisarea]);
txtout (mf$rsf, $stradd ('BHNEXTBKT'), .bktptr [bhnextbkt]);
txtout (mf$rsf, $stradd ('BHLASTID'), .bktptr [bhlastid]);
txtout (mf$rsf, $stradd ('BHNEXTID'), .bktptr [bhnextid]);
RETURN
%ELSE
RETURN;
%FI
END; ! End of DUMPHEADER
END ! End of Module DEBG
ELUDOM