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