1
0
mirror of https://github.com/PDP-10/stacken.git synced 2026-03-08 03:29:27 +00:00
Files
Lars Brinkhoff 6e18f5ebef Extract files from tape images.
Some tapes could not be extracted.
2021-01-29 10:47:33 +01:00

366 lines
8.2 KiB
Plaintext
Raw Permalink Blame History

This file contains invisible Unicode characters
This file contains invisible Unicode characters that are indistinguishable to humans but may be processed differently by a computer. If you think that this is intentional, you can safely ignore this warning. Use the Escape button to reveal them.
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