Google
 

Trailing-Edge - PDP-10 Archives - tops10_tools_bb-fp64b-sb - 10,7/mcbda/mdahdr.bli
There is 1 other file named mdahdr.bli in the archive. Click here to see a list.
MODULE HEADER (					!Display task headers
		IDENT = '003020',
		LANGUAGE (BLISS16, BLISS36)
		) =
BEGIN
!
!			  COPYRIGHT (c) 1977, 1978 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: MCBDA - MCB crash Dump Analyzer
!
! ABSTRACT:
!
!	This module contains the routines to display the RSX11 task headers
!
! ENVIRONMENT: ANY
!
! AUTHOR: ALAN D. PECKHAM	, CREATION DATE: 11-OCT-78
!
! MODIFIED BY:
!
! 	Alan D. Peckham, 7-Jul-80 : VERSION 3
! 01	- Update to use RSXLIB for RSX structures
! 02    - Display tasks IN memory, not OUT (TS.OUT).
!--

!
! TABLE OF CONTENTS:
!

FORWARD ROUTINE
    DMPDEV : NOVALUE,				!Insert device name in edit string.
    DMPVBN : NOVALUE,				!
    HDR : NOVALUE;				!

!
! INCLUDE FILES:
!

LIBRARY 'MDACOM';				!MDA common definitions.

LIBRARY 'RSXLIB';				!RSX definitions.

!
! MACROS:
!
!	None
!
! EQUATED SYMBOLS:
!
!	None
!
! OWN STORAGE:
!
!
! EXTERNAL REFERENCES:
!

EXTERNAL ROUTINE
    GETWRD,					!Get a word from the dump image.
    GETBYT,					!Get a byte from the dump image.
    VMADMP : NOVALUE,
    PUTWND : NOVALUE,				!Display the window blocks.
    SBTTL : NOVALUE,				!Set a listing file sub-title.
    SKIP : NOVALUE;				!Insert blank lines on listing.

EXTERNAL
    FLAGS : BITVECTOR [M_MAX_BITS];

GLOBAL ROUTINE HDR : NOVALUE =

!++
! FUNCTIONAL DESCRIPTION:
!
!
! FORMAL PARAMETERS:
!
!	NONE
!
! IMPLICIT INPUTS:
!
!	NONE
!
! IMPLICIT OUTPUTS:
!
!	NONE
!
! ROUTINE VALUE:
! COMPLETION CODES:
!
!	NONE
!
! SIDE EFFECTS:
!
!	NONE
!
!--

    BEGIN

    LOCAL
	ADR,
	TASK_COUNT,
	HEADER_COUNT,
	TCB_ADDRESS,
	HEADER_ADDRESS,
	HEADER_LENGTH;

    SBTTL (CH$ASCIZ ('TASK HEADERS'));

    IF NOT SYMBOL_TABLE ('RSX11S') THEN RETURN;

    TASK_COUNT = RSX_MAX_STD;
    HEADER_COUNT = RSX_MAX_ATL;
    TCB_ADDRESS = SYMBOL ($TSKHD) - FL$OFFSET (T_TCBL);

    WHILE GETWRD ((TCB_ADDRESS = GETWRD (.TCB_ADDRESS + FL$OFFSET (T_TCBL))) + FL$OFFSET (T_TCBL)) NEQ 0 DO
	BEGIN

	IF (TASK_COUNT = .TASK_COUNT - 1) LSS 0 THEN RETURN PUTLN (1, CH$ASCIZ (WARNING, 'TOO MANY TASKS'));

	IF not FL$SET (GETWRD (.TCB_ADDRESS + FL$OFFSET (T_STAT)), TS_OUT)
	THEN
	    BEGIN

	    IF (HEADER_COUNT = .HEADER_COUNT - 1) LSS 0
	    THEN
		RETURN PUTLN (1,
			CH$ASCIZ (WARNING,
			    'TOO MANY HEADERS'));

	    HEADER_ADDRESS = GETWRD (GETWRD (.TCB_ADDRESS + FL$OFFSET (T_PCB)) + SYMBOL ('P.HDR'));
	    PUTLN (3, CH$ASCIZ ('  %2R'), GETWRD (.TCB_ADDRESS + FL$OFFSET (T_NAM) + 0),
		GETWRD (.TCB_ADDRESS + FL$OFFSET (T_NAM) + 2));
	    PUTLN (0, CH$ASCIZ ('  ------'));
	    PUTLN (1, CH$ASCIZ ('%4SHEADER ADDRESS = %P%6STCB ADDRESS = %P'), .HEADER_ADDRESS, .TCB_ADDRESS);
	    ADR = GETWRD (.HEADER_ADDRESS + FL$OFFSET (H_GARD));
	    PUTLN (1, CH$ASCIZ ('%4SPS=%P%5SPC=%P'), GETWRD (.ADR - 16), GETWRD (.ADR - 14));
	    PUTLN (1, CH$ASCIZ ('%4SR0=%P  R1=%P  R2=%P  R3=%P  R4=%P  R5=%P  SP=%P'), GETWRD (.ADR - 12),
		GETWRD (.ADR - 10), GETWRD (.ADR - 8), GETWRD (.ADR - 6), GETWRD (.ADR - 4),
		GETWRD (.ADR - 2), GETWRD (.HEADER_ADDRESS + FL$OFFSET (H_CSP)));
	    PUTLN (1, CH$ASCIZ ('%4SINITIAL PS = %P   INITIAL PC = %P   INITIAL SP = %P'),
		GETWRD (.HEADER_ADDRESS + FL$OFFSET (H_IPS)), GETWRD (.HEADER_ADDRESS + FL$OFFSET (H_IPC)),
		GETWRD (.HEADER_ADDRESS + FL$OFFSET (H_ISP)));
	    PUTLN (1, CH$ASCIZ ('%4SHEADER SIZE = %D.   NO. OF WINDOWS = %D.   NO. OF LUNS = %D.'),
		(HEADER_LENGTH = GETWRD (.HEADER_ADDRESS + FL$OFFSET (H_HDLN))),
		GETWRD (GETWRD (.HEADER_ADDRESS + FL$OFFSET (H_WND))),
		GETWRD (.HEADER_ADDRESS + FL$OFFSET (H_NLUN)));
	    PUTLN (1, CH$ASCIZ ('%4SCURRENT UIC = [%O,%O]   DEFAULT UIC = [%O,%O]'),
		GETBYT (.HEADER_ADDRESS + FL$OFFSET (H_CUIC) + 1),
		GETBYT (.HEADER_ADDRESS + FL$OFFSET (H_CUIC) + 0),
		GETBYT (.HEADER_ADDRESS + FL$OFFSET (H_DUIC) + 1),
		GETBYT (.HEADER_ADDRESS + FL$OFFSET (H_DUIC) + 0));
	    PUTLN (1, CH$ASCIZ ('%4SH.WND = %P   H.GARD = %P   H.VEXT = %P   H.SPRI = %D.'),
		GETWRD (.HEADER_ADDRESS + FL$OFFSET (H_WND)), GETWRD (.HEADER_ADDRESS + FL$OFFSET (H_GARD)),
		GETWRD (.HEADER_ADDRESS + FL$OFFSET (H_VEXT)), GETBYT (.HEADER_ADDRESS + FL$OFFSET (H_SPRI)));
	    PUTLN (1, CH$ASCIZ ('%4SDSW = %P   H.FCS = %P  H.FORT = %P   H.OVLY = %P'),
		GETWRD (.HEADER_ADDRESS + FL$OFFSET (H_DSW)), GETWRD (.HEADER_ADDRESS + FL$OFFSET (H_FCS)),
		GETWRD (.HEADER_ADDRESS + FL$OFFSET (H_FORT)), GETWRD (.HEADER_ADDRESS + FL$OFFSET (H_OVLY)));

	    !+
	    ! Dump the luns if there are any
	    !-

	    BEGIN

	    LOCAL
		LUN_ADDRESS,
		LUN_NUMBER,
		NUM_LUNS,
		UCB_ADDRESS,
		WINDOW_ADDRESS;

	    BIND
		$POOL = SYMBOL ($POOL),
		$EXSIZ = GETWRD (SYMBOL ($EXSIZ));

	    IF (NUM_LUNS = GETWRD (.HEADER_ADDRESS + FL$OFFSET (H_NLUN))) NEQ 0
	    THEN
		BEGIN

		IF (.NUM_LUNS GTR RSX_MAX_LUN)
		THEN
		    BEGIN
		    PUTLN (1, CH$ASCIZ (WARNING, 'TOO MANY LUNS (%M.)'), .NUM_LUNS);
		    NUM_LUNS = 7
		    END;

		PUTLN (2, CH$ASCIZ ('%4SLOGICAL UNIT TABLE:'));
		PUTLN (1,
		    CH$ASCIZ (
			'%4S#  DEV  WINDOW   W.CTL    W.VBN    W.FCB   F.FNUM  F.FSEQ  F.STAT  NAC  NLCK'));
		PUTLN (0,
		    CH$ASCIZ (
			'%4S-  ---  ------   -----    -----    -----   ------  ------  ------  ---  ----'));
		LUN_ADDRESS = .HEADER_ADDRESS + FL$OFFSET (H_LUN);

		INCR LUN_NUMBER FROM 1 TO .NUM_LUNS DO
		    BEGIN
		    UCB_ADDRESS = GETWRD (.LUN_ADDRESS);
		    WINDOW_ADDRESS = GETWRD (.LUN_ADDRESS + 2);

		    IF (.WINDOW_ADDRESS GEQ $POOL) AND (.WINDOW_ADDRESS LSS $EXSIZ)
		    THEN
			BEGIN

			LITERAL
			    W_CTL = 0,		!Control word
			    W_VBN = 2,		!First VBN mapped by window
			    W_FCB = 6;		!Pointer to FCB

			LOCAL
			    CONTROL_WORD,
			    FCB_ADDRESS,
			    VBN : VECTOR [2];

			CONTROL_WORD = GETWRD (.WINDOW_ADDRESS + W_CTL);
			VBN [0] = GETBYT (.WINDOW_ADDRESS + W_VBN);
			VBN [1] = GETWRD (.WINDOW_ADDRESS + W_VBN + 2);
			FCB_ADDRESS = GETWRD (.WINDOW_ADDRESS + W_FCB);

			IF (.FCB_ADDRESS GEQ $POOL) AND (.FCB_ADDRESS LSS $EXSIZ)
			THEN
			    BEGIN

			    LITERAL
				F_FNUM = %O'2',
				F_FSEQ = %O'4',
				F_NACS = %O'32',
				F_NLCK = %O'33',
				F_STAT = %O'34';

			    PUTLN (0, CH$ASCIZ ('%4S%O%8T%@%13T%P   %P  %@  %P  %P  %P  %P   %D.%77T%D.'),
				.LUN_NUMBER, DMPDEV, .UCB_ADDRESS, .WINDOW_ADDRESS, .CONTROL_WORD, DMPVBN,
				VBN, .FCB_ADDRESS, GETWRD (.FCB_ADDRESS + F_FNUM),
				GETWRD (.FCB_ADDRESS + F_FSEQ), GETWRD (.FCB_ADDRESS + F_STAT),
				GETBYT (.FCB_ADDRESS + F_NACS), GETBYT (.FCB_ADDRESS + F_NLCK))
			    END
			ELSE
			    PUTLN (0, CH$ASCIZ ('%4S%O%8T%@%13T%P   %P  %@  %P'), .LUN_NUMBER, DMPDEV,
				.UCB_ADDRESS, .WINDOW_ADDRESS, .CONTROL_WORD, DMPVBN, VBN, .FCB_ADDRESS)

			END
		    ELSE
			PUTLN (0, CH$ASCIZ ('%4S%O%8T%@%13T%P'), .LUN_NUMBER, DMPDEV, .UCB_ADDRESS,
			    .WINDOW_ADDRESS);

		    LUN_ADDRESS = .LUN_ADDRESS + 4
		    END

		END

	    END;

	    !+
	    ! Dump the window blocks
	    !-

	    PUTWND (2, .HEADER_ADDRESS);

	    !+
	    ! Now dump the header uninterpreted
	    !-

	    IF .FLAGS [M_RSX_DUMP]
	    THEN
		BEGIN
		PUTLN (2, CH$ASCIZ ('%4SHEADER:'));
		SKIP (1);
		VMADMP (.HEADER_ADDRESS, .HEADER_ADDRESS, .HEADER_ADDRESS + MINU (.HEADER_LENGTH, 600));
		END;

	    END;

	END;

    END;					!End of HDR

ROUTINE DMPDEV (BUF_PTR_ADR, PAT_PTR_ADR, PRM_LST_ADR_ADR) : NOVALUE =

!++
! FUNCTIONAL DESCRIPTION:
!
!
! The next parameters are:
!	UCB_ADDRESS
!
! FORMAL PARAMETERS:
!
!	..BUF_PTR_ADR				!Pointer to output buffer.
!	..PAT_PTR_ADR				!Pointer to pattern string.
!	..PRM_LST_ADR_ADR			!Pointer to next parameter.
!
! IMPLICIT INPUTS:
!
!	NONE
!
! IMPLICIT OUTPUTS:
!
!	NONE
!
! ROUTINE VALUE:
!
!	NONE
!
! SIDE EFFECTS
!
!	NONE
!
!--

    BEGIN

    LOCAL
	PRM_LST : REF VECTOR,
	BUF_PTR_INI,
	UCB_ADDRESS;

    PRM_LST = ..PRM_LST_ADR_ADR;
    UCB_ADDRESS = .PRM_LST [0];
    .PRM_LST_ADR_ADR = PRM_LST [1];
    BUF_PTR_INI = ..BUF_PTR_ADR;

    IF .UCB_ADDRESS NEQ 0
    THEN
	BEGIN

	LOCAL
	    DCB_ADDRESS,
	    UNIT;

	EXTERNAL ROUTINE
	    $CBOMG;

	DCB_ADDRESS = GETWRD (.UCB_ADDRESS + FL$OFFSET (U_DCB));
	CH$WCHAR_A (GETBYT (.DCB_ADDRESS + FL$OFFSET (D_NAM) + 0), .BUF_PTR_ADR);
	CH$WCHAR_A (GETBYT (.DCB_ADDRESS + FL$OFFSET (D_NAM) + 1), .BUF_PTR_ADR);
	UNIT = ((.UCB_ADDRESS - GETWRD (.DCB_ADDRESS + FL$OFFSET (D_UCB)))/GETWRD (.DCB_ADDRESS + FL$OFFSET (
		D_UCBL))) + GETBYT (.DCB_ADDRESS + FL$OFFSET (D_UNIT));
	$CBOMG (.BUF_PTR_ADR, .UNIT, 0);
	END
    ELSE
	.BUF_PTR_ADR = CH$MOVE (4, CH$ASCIZ ('NONE'), ..BUF_PTR_ADR);

    CH$DIFF (..BUF_PTR_ADR, .BUF_PTR_INI)
    END;					!End of DMPDEV
ROUTINE DMPVBN (BUF_PTR_ADR, PAT_PTR_ADR, PRM_LST_ADR_ADR) : NOVALUE =

!++
! FUNCTIONAL DESCRIPTION:
!
!
! The next parameters are:
!	VALUE
!
! FORMAL PARAMETERS:
!
!	..BUF_PTR_ADR				!Pointer to output buffer.
!	..PAT_PTR_ADR				!Pointer to pattern string.
!	..PRM_LST_ADR_ADR			!Pointer to next parameter.
!
! IMPLICIT INPUTS:
!
!	NONE
!
! IMPLICIT OUTPUTS:
!
!	NONE
!
! ROUTINE VALUE:
!
!	NONE
!
! SIDE EFFECTS
!
!	NONE
!
!--

    BEGIN

    LITERAL
	FLAG = 4^11 + 1^9 + 8;

    EXTERNAL ROUTINE
	$CBTA;

    LOCAL
	PRM_LST : REF VECTOR,
	VALUE : REF BLOCK [2];

    PRM_LST = ..PRM_LST_ADR_ADR;
    VALUE = .PRM_LST [0];
    .PRM_LST_ADR_ADR = PRM_LST [1];
    $CBTA (.BUF_PTR_ADR, .VALUE [1, 12, 4, 0] + .VALUE [0, 0, 8, 0]^5, FLAG) + $CBTA (.BUF_PTR_ADR,
	.VALUE [1, 0, 12, 0], FLAG)
    END;					!End of DMPVBN
END						!End of module

ELUDOM