Google
 

Trailing-Edge - PDP-10 Archives - cuspbinsrc_2of2_bb-fp63b-sb - 10,7/rms10/rmssrc/rmsdmp.b36
There are 6 other files named rmsdmp.b36 in the archive. Click here to see a list.
MODULE DEBG =


BEGIN

GLOBAL BIND	DEBGV = 1^24 + 0^18 + 1;	!EDIT DATE: 16-DEC-76


%([

FUNCTION:	THIS MODULE CONTAINS ALL ROUTINES WHICH SUPPORT
		AND PROCESS THE DEBUGGING FACILITIES WITHIN RMS-20.
AUTHOR:	S. BLOUNT

THIS SOFTWARE IS FURNISHED UNDER A LICENSE AND MAY ONLY BE USED
  OR COPIED IN ACCORDANCE WITH THE TERMS OF SUCH LICENSE.

!COPYRIGHT (C) 1977, 1979 BY DIGITAL EQUIPMENT CORPORATION



**********	TABLE OF CONTENTS	**************




	ROUTINE			FUNCTION
	=======			========

	$DEBUG			PROCESS $DEBUG VERB

	DUMPRST			DUMP AN RST BLOCK

	DUMPIDB			DUMP AN INDEX DESCRIPTOR BLOCKS

	DUMPKDB			DUMP A KEY DESCRIPTOR

	DUMPRD			DUMP A RECORD DESCRIPTOR

	DUMPHEADER		DUMP A BUCKET HEADER



REVISION HISTORY:

EDIT	WHO		DATE		PURPOSE
====	===		====		=======

1	SEB		16-DEC-76	TAKE OUT KDB FIELD DBSZ

*************************************************
*						*
*		NEW REVISION HISTORY		*
*						*
*************************************************

PRODUCT	MODULE	 SPR
 EDIT	 EDIT	 QAR		DESCRIPTION
======	======	=====		===========


	***** END OF REVISION HISTORY *****




])%




	%([ EXTERNAL DECLARATIONS ])%

EXTERNAL
    ROUTIN,			! EXTERNAL DECLARATIONS
    CRASH;			! IN CASE OF A NOUT FAILURE

%([ ERROR MESSAGES REFERENCED WITHIN THIS MODULE ])%

EXTERNAL
    MSGCANTGETHERE;		! BAD LOGIC FLOW


REQUIRE 'RMSREQ';
EXTDECLARATIONS;




! $DEBUG
! ======

! THIS ROUTINE PROCESSES THE $DEBUG MACRO FOR USING THE
!	DEBUGGING FACILITIES
!	THE FORMAT OF THIS MACRO IS AS FOLLOWS:
!
!		$DEBUG	VALUE-1 ! VALUE-2 ! ...
!
!	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		DUMP OUT ALL INTERNAL RMS-20 BLOCKS
!		DB$IO		TRACE I/O PAGE FAULTS (BUFFER FAULTS)

! INPUT:
!	BITVALUE =	VALUE TO SET FOR DEBUGGING

! OUTPUT:
!	<NONE>


GLOBAL ROUTINE %NAME('$DEBUG') ( BITVALUE ):NOVALUE =
BEGIN

	ARGUMENT (BITVALUE,BASEADD);		! INPUT ARGUMENT

	BUGFLG = .BITVALUE;			! SET DEBUGGING FLAGS

	%IF DBUG %THEN
	USEREXIT;				! EXIT HERE IF DEBUGGING COMPILED
	%FI

	TYPE ( %STRING('[%RMS-20 NOT BUILT WITH DEBUGGING FEATURES...$DEBUG IGNORED]'));
	USEREXIT;

END; %( OF $DEBUG )%



! DUMP
! ====

! THIS ROUTINE IS USED FOR DEBUGGING ONLY. IT
! PRINTS OUT THE CONTENTS OF A BLOCK IN CORE

!INPUT:
!	BLKSIZ =	LENGTH OF BLOCK TO DUMP
!	BLOCK2 =	ADDRESS TO START DUMPING (PASSED AS VALUE)
!
! OUTPUT:
!	<NO STATUS RETURNED>


 GLOBAL ROUTINE DUMP ( BLKSIZ, BLOCK2 ):NOVALUE =
 BEGIN

%IF DBUG %THEN
 
 	ARGUMENT (BLKSIZ,VALUE);
 	ARGUMENT (BLOCK2,BASEADD);
 
 
 LOCAL
    BLOCK;					! NEED TEMPORARY LOCAL

	BLOCK = .BLOCK2;			! GET ADDRESS OF BLOCK
	
	%([ LOOP OVER THE ENTIRE BLOCK ])%

	INCR J FROM 1 TO .BLKSIZ
	DO
		BEGIN
		TXTOUT (RM$OCT, .BLOCK);		!PUT OUT <TAB>OCT NUMBER
		INC ( BLOCK, 1);			! BUMP POINTER
	END %( OF INCR 1 TO BLKSIZ )%
%ELSE	RETURN;
%FI

 END; %( OF DUMP ROUTINE )%



! DUMPRST
! =======

! THIS ROUTINE PRINTS OUT A FORMATTED COPY OF THE
! RECORD STATUS TABLE FOR USE IN DEBUGGING

! INPUT:
!	<NONE>

! OUTPUT:
!	<NONE>


	%([ MACRO TO PRINT OUT A FIELD ])%

MACRO	RSTFIELD (FIELDNAME) =
	TXTOUT (RM$RSF, $STRADD(FIELDNAME), .RST[FIELDNAME] ); %;

 GLOBAL ROUTINE DUMPRST: NOVALUE  =
 BEGIN

%IF DBUG %THEN
 
 LOCAL
    TEMP;
	BUGOUT ('** DUMP OF RST **');

	%([ PRINT OUT EACH FIELD ])%

	RSTFIELD (BLOCKTYPE);
	RSTFIELD (BLOCKLENGTH);
	RSTFIELD (BLOCKLENGTH);
	RSTFIELD (BLINK);
	RSTFIELD (FLINK);
	RSTFIELD (RSTRSZ);
	RSTFIELD (RSTRSZW);
	RSTFIELD (RSTDATARFA);
	RSTFIELD (RSTFLAGS);
	RSTFIELD (RSTPAGPTR);
	RSTFIELD (RSTLASTOPER);
	RSTFIELD (RSTNRP);
	TYPE	('');				!BLANK LINE
	ENDDEBUG;
	RETURN
%ELSE	RETURN;
%FI

 END;



! DUMPIDB
! =======

! ROUTINE TO DUMP OUT THE CONTENTS OF AN INDEXDESCRIPTOR BLOCK

! INPUT:
!	IDBPTR	=>	INDEX DESCRIPTOR BLOCK

! OUTPUT:
!	<NONE>

! ROUTINES CALLED:
!	DUMP

	%([ MACRO USED HERE ])%

	MACRO	IDBFIELD(FIELDNAME)=
		BEGIN
		TYPE ('	FIELDNAME: ');
		TEMP = .IDBPTR [ FIELDNAME ];
		CALLDUMP ( PCI ( 1 ), LCI ( TEMP ) );
		END %;


 GLOBAL ROUTINE DUMPIDB ( IDBPTR ):NOVALUE =
 BEGIN

%IF INDX AND DBUG %THEN
 	ARGUMENT	(IDBPTR,BASEADD);
 
 MAP
    IDBPTR:	POINTER;
 LOCAL
    TEMP;
 
 


	IDBFIELD ( BLOCKTYPE );
	IDBFIELD ( BLOCKLENGTH );
	IDBFIELD ( IDBROOT );
	IDBFIELD ( IDBLEVELS );
	IDBFIELD ( IDBNXT );
 ENDDEBUG;

	RETURN
%ELSE	RETURN;
%FI

END;%( OF DUMPIDB)%


! DUMPKDB
! =======

! ROUTINE TO DUMP A KEY DESCRIPTOR BLOCK

! INPUT:
!	KDBPTR	=>	ADDRESS OF KEY DESCRIPTOR BLOCK

! OUTPUT:
!	<NONE>

	%([ MACRO USED HERE ])%

	MACRO	KDBFIELD(FIELDNAME)=
		BEGIN
		TYPE ('	FIELDNAME: ');
		TEMP = .KDBPTR [ FIELDNAME ];
		CALLDUMP ( PCI ( 1 ), LCI ( TEMP ) );
		END %;

 GLOBAL ROUTINE DUMPKDB ( KDBPTR ): NOVALUE =

BEGIN

%IF INDX AND DBUG %THEN
 
 	ARGUMENT	(KDBPTR,BASEADD);
 LOCAL
    TEMP;
 MAP
    KDBPTR:	POINTER;
 

	KDBFIELD ( BLOCKTYPE );
	KDBFIELD ( BLOCKLENGTH );
	KDBFIELD ( KDBROOT );
	KDBFIELD ( KDBHSZ );
	KDBFIELD ( KDBKSZ );
	KDBFIELD ( KDBKSZW );
	KDBFIELD ( KDBDTP );
	KDBFIELD ( KDBREF );
	KDBFIELD ( KDBIDBADDR );
	KDBFIELD ( KDBFLAGS );
	KDBFIELD ( KDBNXT );
	KDBFIELD ( KDBIFLOFFSET );
	KDBFIELD ( KDBDFLOFFSET );
	KDBFIELD ( KDBIAN );
	KDBFIELD ( KDBDAN );
	KDBFIELD ( KDBKBSZ );
	KDBFIELD ( KDBLEVELS );
	KDBFIELD ( KDBMINRSZ );
	KDBFIELD ( KDBIBKZ );
	KDBFIELD ( KDBDBKZ );
 ENDDEBUG;

	%([ NOTE THAT THE KEY POSITION AND SIZE FIELDS ARE NOT 
	   PRINTED OUT ])%

	RETURN
%ELSE	RETURN;
%FI

END; %(OF DUMPKDB)%



! DUMPRD
! =======

! ROUTINE TO DUMP A RECORD DESCRIPTOR PACKET

! INPUT:
!	RDPTR	=>	ADDRESS OF RECORD DESCRIPTOR PACKET

! OUTPUT:
!	<NONE>

	%([ MACRO USED HERE ])%

	MACRO	RDFIELD(FIELDNAME)=
		BEGIN
		TYPE ('	FIELDNAME: ');
		TEMP = .RDPTR [ FIELDNAME ];
		CALLDUMP ( PCI ( 1 ), LCI ( TEMP ) );
		END %;

 GLOBAL ROUTINE DUMPRD ( RDPTR ):NOVALUE =
 BEGIN

%IF INDX AND DBUG %THEN
 
 	ARGUMENT	(RDPTR,BASEADD);
 LOCAL
    TEMP;
 MAP
    RDPTR:	POINTER;
 

	RDFIELD ( RDFLAGS );
	RDFIELD ( RDSTATUS );
	RDFIELD ( RDUSERSIZE );
	RDFIELD ( RDCOUNT );
	RDFIELD ( RDLASTLEVEL );
	RDFIELD ( RDLEVEL );
	RDFIELD ( RDUSERPTR );
	RDFIELD ( RDRFA );
	RDFIELD ( RDRECPTR );
	RDFIELD ( RDLASTRECPTR );
	RDFIELD ( RDRRV );
	RDFIELD ( RDLENGTH );
 
	RETURN
%ELSE	RETURN;
%FI

END; %(OF DUMPKDB)%



! DUMPHEADER
! ==========

! ROUTINE TO DUMP THE HEADER OF AN INDEXED FILE BUCKET

! INPUT:
!	BKTPTR		ADDRESS OF BUCKET IN CORE

! OUTPUT:
!	<NONE>

! ROUTINES CALLED:
!	DUMP

	%([ MACRO USED IN THIS ROUTINE ])%

	MACRO	HDRFIELD ( FIELDNAME )=
		BEGIN
		DUMMY = .BKTPTR [ FIELDNAME ];
		PRINTVALUE ( '	FIELDNAME: ', DUMMY );
		END %;

GLOBAL ROUTINE DUMPHEADER ( BKTPTR ): NOVALUE =
BEGIN 

%IF INDX AND DBUG %THEN

  	ARGUMENT	(BKTPTR,BASEADD);
  MAP
    BKTPTR:	POINTER;
  LOCAL
    DUMMY;
	BEGINDEBUG ( DBLOCAL )
	HDRFIELD ( BHFLAGS );
	HDRFIELD ( BHLEVEL );
	HDRFIELD ( BHBTYPE );
	HDRFIELD ( BHNEXTBYTE );
	HDRFIELD ( BHTHISAREA );
	HDRFIELD ( BHNEXTBKT );
	HDRFIELD ( BHLASTID );
	HDRFIELD ( BHNEXTID );
 	ENDDEBUG;
	RETURN
%ELSE	RETURN;
%FI

END; %(OF DUMPHEADER)%

END
ELUDOM