Google
 

Trailing-Edge - PDP-10 Archives - tops10_tools_bb-fp64b-sb - 10,7/mcbda/mdadcb.bli
There is 1 other file named mdadcb.bli in the archive. Click here to see a list.
MODULE DCB (					!Display RSX11S device tables
		IDENT = '003010',
		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:
!
!	Display the RSX device data base tables
!
! ENVIRONMENT: ANY
!
! AUTHOR: ALAN D. PECKHAM	, CREATION DATE: 7-FEB-79
!
! MODIFIED BY:
!
! 	Alan D. Peckham, 7-Jul-80 : VERSION 3
! 01	- Update to use RSXLIB for RSX structures
!--

!
! TABLE OF CONTENTS:
!

FORWARD ROUTINE
    DEV : NOVALUE,
    DMPDEV : NOVALUE,				!Display device name.
    DMPNAM : NOVALUE;				!Display task name.

!
! INCLUDE FILES:
!

LIBRARY 'MDACOM';				!MDA common definitions.

LIBRARY 'RSXLIB';				!RSX definitions

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

EXTERNAL ROUTINE
    BITLS : NOVALUE,				!
    GETBYT,					!
    GETWRD,					!
    VMADMP : NOVALUE,
    SBTTL : NOVALUE,				!
    SKIP : NOVALUE;

EXTERNAL
    FLAGS : BITVECTOR [M_MAX_BITS];

GLOBAL ROUTINE DEV : NOVALUE =

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

    BEGIN

    LOCAL
	ADR,
	CW1,
	DCB_ADDRESS,
	DCB_COUNT,
	SCB_ADDRESS,
	UCB_ADDRESS,
	UCB_COUNT,
	UCB_LENGTH,
	UNIT;

    SBTTL (CH$ASCIZ ('DEVICE INFORMATION'));

    IF NOT SYMBOL_TABLE ('RSX11S') THEN RETURN;

    DCB_COUNT = RSX_MAX_DCB;
    DCB_ADDRESS = SYMBOL ($DEVHD) - FL$OFFSET (D_LNK);

    WHILE (DCB_ADDRESS = GETWRD (.DCB_ADDRESS + FL$OFFSET (D_LNK))) NEQ 0 DO
	BEGIN

	IF (DCB_COUNT = .DCB_COUNT - 1) LSS 0
	THEN
	    EXITLOOP (PUTLN (1,
		    CH$ASCIZ (WARNING,
			'TOO MANY DEVICE CONTROL BLOCKS')));

	UCB_ADDRESS = GETWRD (.DCB_ADDRESS + FL$OFFSET (D_UCB));
	UCB_LENGTH = GETWRD (.DCB_ADDRESS + FL$OFFSET (D_UCBL));
	UCB_COUNT = RSX_MAX_UCB;

	INCR UNIT FROM GETBYT (.DCB_ADDRESS + FL$OFFSET (D_UNIT) + 0) TO GETBYT (.DCB_ADDRESS + FL$OFFSET (
			D_UNIT) + 1) DO
	    BEGIN

	    IF (UCB_COUNT = .UCB_COUNT - 1) LSS 0
	    THEN
		EXITLOOP (PUTLN (1,
			CH$ASCIZ (WARNING,
			    'TOO MANY UNITS ON DEVICE')));

	    SCB_ADDRESS = GETWRD (.UCB_ADDRESS + SYMBOL ('U.SCB'));
	    PUTLN (3, CH$ASCIZ ('  %@'), DMPDEV, .UCB_ADDRESS);
	    PUTLN (0, CH$ASCIZ ('  -----'));
	    PUTLN (1, CH$ASCIZ ('    UCB ADR  DCB ADR  SCB ADR  REDIRECT   ACP     ATT    OWNER   LOGIN UIC'))
	    ;
	    PUTLN (0, CH$ASCIZ ('    ------   ------   ------   --------   ---     ---    -----   ---------'))
	    ;
	    BEGIN

	    LOCAL
		ACP,
		REDIRECT;

	    IF (REDIRECT = GETWRD (.UCB_ADDRESS + FL$OFFSET (U_RED))) EQL .UCB_ADDRESS THEN REDIRECT = 0;

	    CW1 = GETWRD (.UCB_ADDRESS + FL$OFFSET (U_CW1));
	    ACP = (IF FL$SET (.CW1, DV_MNT) THEN GETWRD (.UCB_ADDRESS + FL$OFFSET (U_ACP)) ELSE 0);
	    PUTLN (0,
		(IF FL$SET (.CW1, DV_PSE) THEN
	CH$ASCIZ ('    %P   %P   %P   %@') ELSE
	(IF NOT BIT_SET (GETWRD (SYMBOL ($FMASK)), SYMBOL ('FE.MUP')) THEN
	CH$ASCIZ ('    %P   %P   %P   %@%43T%@%51T%@') ELSE
	(IF NOT FL$SET (.CW1, DV_TTY) THEN
	CH$ASCIZ ('    %P   %P   %P   %@%43T%@%51T%@') ELSE
	CH$ASCIZ ('    %P   %P   %P   %@%43T%@%51T%@%66T[%O,%O]')))),
	.UCB_ADDRESS, .DCB_ADDRESS, .SCB_ADDRESS, DMPDEV,
	.REDIRECT, DMPNAM, .ACP, DMPNAM,
		GETWRD (.UCB_ADDRESS + FL$OFFSET (U_ATT)), GETBYT (.UCB_ADDRESS + FL$OFFSET (U_LUIC) + 1),
		GETBYT (.UCB_ADDRESS + FL$OFFSET (U_LUIC) + 0))
	    END;
	    BEGIN

	    BIND
		LIST_STS = FIELDS_LIST ('US.BSY', 'US.MNT', 'US.FOR', 'US.MDM'),
		LIST_ST2 = FIELDS_LIST ('US.OFL', 'US.RED', 'US.PUB', 'US.UMD'),
		LIST_CTL = FIELDS_LIST ('UC.ALG', 'UC.NPR', 'UC.QUE', 'UC.PWF', 'UC.ATT', 'UC.KIL'),
		LIST_CW1 = FIELDS_LIST ('DV.MNT', 'DV.F11', 'DV.COM', 'DV.PSE', 'DV.SWL', 'DV.UMD', 'DV.MXD',
			'DV.SQD', 'DV.SDI', 'DV.DIR', 'DV.TTY', 'DV.CCL', 'DV.REC'),
		LIST_CW2 = FIELDS_LIST ('U2.DH1', 'U2.DJ1', 'U2.RMT', 'U2.NEC', 'U2.CRT', 'U2.ESC', 'U2.LOG',
			'U2.SLV', 'U2.DZ1', 'U2.HLD', 'U2.AT.', 'U2.PRV', 'U2.L3S', 'U2.VT5', 'U2.LWC');

	    PUTLN (1, CH$ASCIZ ('%4SSTATUS: %@%@'), BITLS, LIST_STS,
		GETBYT (.UCB_ADDRESS + FL$OFFSET (U_STS)), BITLS, LIST_ST2,
		GETBYT (.UCB_ADDRESS + FL$OFFSET (U_ST2)));
	    PUTLN (0, CH$ASCIZ ('%4SU.CTL: %@'), BITLS, LIST_CTL, GETBYT (.UCB_ADDRESS + FL$OFFSET (U_CTL)));
	    PUTLN (0, CH$ASCIZ ('%4SU.CW1: %@'), BITLS, LIST_CW1, .CW1);

	    IF FL$SET (.CW1, DV_TTY)
	    THEN
		PUTLN (0, CH$ASCIZ ('%4SU.CW2: %@'), BITLS, LIST_CW2,
		    GETWRD (.UCB_ADDRESS + FL$OFFSET (U_CW2)));

	    END;

	    IF .FLAGS [M_RSX_DUMP]
	    THEN
		BEGIN
		PUTLN (1, CH$ASCIZ ('	UNIT CONTROL BLOCK:'));
		SKIP (1);
		VMADMP (0, .UCB_ADDRESS, .UCB_ADDRESS + .UCB_LENGTH);
		PUTLN (1, CH$ASCIZ ('	DEVICE CONTROL BLOCK:'));
		SKIP (1);
		VMADMP (0, .DCB_ADDRESS, .DCB_ADDRESS + 15*2);

		IF NOT FL$SET (.CW1, DV_PSE)
		THEN
		    BEGIN
		    PUTLN (1, CH$ASCIZ ('	STATUS CONTROL BLOCK:'));
		    SKIP (1);
		    VMADMP (0, .SCB_ADDRESS - 6, .SCB_ADDRESS + SYMBOL ('S.MPR') + 9*2);
		    END;

		SKIP (1);
		END;

	    UCB_ADDRESS = .UCB_ADDRESS + .UCB_LENGTH
	    END

	END

    END;					!End of DEV

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;

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

!++
! FUNCTIONAL DESCRIPTION:
!
!
! The next parameters are:
!	TCB_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,
	TCB_ADDRESS;

    PRM_LST = ..PRM_LST_ADR_ADR;
    TCB_ADDRESS = .PRM_LST [0];
    .PRM_LST_ADR_ADR = PRM_LST [1];

    IF .TCB_ADDRESS NEQ 0
    THEN
	BEGIN

	EXTERNAL ROUTINE
	    $C5TA;

	$C5TA (.BUF_PTR_ADR, GETWRD (.TCB_ADDRESS + FL$OFFSET (T_NAM) + 0));
	$C5TA (.BUF_PTR_ADR, GETWRD (.TCB_ADDRESS + FL$OFFSET (T_NAM) + 2))
	END
    ELSE
	.BUF_PTR_ADR = CH$FILL (%C' ', 6, ..BUF_PTR_ADR);

    6
    END;					!End of DMPNAM
END						!End of module

ELUDOM