1
0
mirror of https://github.com/PDP-10/stacken.git synced 2026-04-20 00:43:22 +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

626 lines
13 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 SUPPORT ( !Utility support routines
IDENT = '003030',
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:
!
! Utility subroutines.
!
! ENVIRONMENT: ANY
!
! AUTHOR: ALAN D. PECKHAM , CREATION DATE: 18-OCT-78
!
! MODIFIED BY:
!
! Alan D. Peckham, 3-Jul-80 : VERSION 3
! 01 - Update for MCB V3.0
! 02 - Indicate whether CCB is active or incative in PUTCCB.
!--
!
! TABLE OF CONTENTS:
!
FORWARD ROUTINE
BITLS : NOVALUE, !Edit a list of bits that are on
!in a given value.
BYTLS : NOVALUE, !Get the symbol for a given byte as part of list.
BYTSM : NOVALUE, !Get the symbol for a given byte.
CCBBUF : novalue, !Display a CCB buffer.
CNV18, !Convert virtual address/bias to 18-bit address.
PHYAD, !Edit an 18 bit physical address.
PUTBUF : NOVALUE, !Display a given mapped buffer.
PUTCCB : NOVALUE; !Display the contents of a CCB.
!
! INCLUDE FILES:
!
library 'MDACOM'; !MDA common definitions.
library 'MCBLIB'; !MCB definitions
library 'CEXLIB'; !CEX definitions
!
! MACROS:
!
!
! EQUATED SYMBOLS:
!
$CEX_CCBDEF
$CEX_PDTDEF
!
! OWN STORAGE:
!
!
! EXTERNAL REFERENCES:
!
EXTERNAL ROUTINE
GETBYT, !Get a bytes from the dump image.
GETWRD, !Get a word from the dump image.
MAPAPR : NOVALUE, !Set up a mapping bias.
$CBOMG, !Convert binary to unsigned octal ASCII.
$CBTA; !General convert binary to ASCII.
EXTERNAL
FLAGS : BITVECTOR [M_MAX_BITS];
GLOBAL ROUTINE BITLS (BUF_PTR_ADR, PAT_PTR_ADR, PRM_LST_ADR_ADR) : NOVALUE =
!++
! FUNCTIONAL DESCRIPTION:
!
!
! The next parameters are:
! BIT_TABLE
! 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
LOCAL
BIT_TABLE : REF VECTOR,
VALUE;
BEGIN
BIND
PRM_LIST = (.PRM_LST_ADR_ADR) : REF VECTOR;
BIT_TABLE = .PRM_LIST [0];
VALUE = .PRM_LIST [1];
.PRM_LST_ADR_ADR = PRM_LIST [2]
END;
WHILE .BIT_TABLE [0] NEQ 0 DO
BEGIN
IF (.BIT_TABLE [2] AND .VALUE) NEQ 0
THEN
BEGIN
LOCAL
BIT_NAME_LEN,
BIT_NAME_PTR;
BIND
LAST_CHAR = BIT_NAME_LEN;
IF ((LAST_CHAR = CH$RCHAR (CH$PLUS (..BUF_PTR_ADR, -1))) NEQ %C'+' AND .LAST_CHAR NEQ %C' ')
THEN
CH$WCHAR_A (%C'+', .BUF_PTR_ADR);
BIT_NAME_PTR = CH$PLUS (.BIT_TABLE [3], -1);
BIT_NAME_LEN = CH$RCHAR_A (BIT_NAME_PTR);
.BUF_PTR_ADR = CH$MOVE (.BIT_NAME_LEN, .BIT_NAME_PTR, ..BUF_PTR_ADR);
END;
BIT_TABLE = BIT_TABLE [4]
END;
END; !OF BITLS
GLOBAL ROUTINE BYTLS (BUF_PTR_ADR, PAT_PTR_ADR, PRM_LST_ADR_ADR) : NOVALUE =
!++
! FUNCTIONAL DESCRIPTION:
!
!
!
!
! FORMAL PARAMETERS:
!
!
! IMPLICIT INPUTS:
!
! NONE
!
! IMPLICIT OUTPUTS:
!
! NONE
!
! ROUTINE VALUE:
!
! NONE
!
! SIDE EFFECTS
!
! NONE
!
!--
BEGIN
LOCAL
BYTE_TABLE : REF VECTOR,
VALUE;
BEGIN
BIND
PRM_LIST = (.PRM_LST_ADR_ADR) : REF VECTOR;
BYTE_TABLE = .PRM_LIST [0];
VALUE = .PRM_LIST [1];
.PRM_LST_ADR_ADR = PRM_LIST [2]
END;
WHILE .BYTE_TABLE [0] NEQ 0 DO
IF .BYTE_TABLE [2] EQL .VALUE
THEN
BEGIN
LOCAL
BYTES_NAME_LEN,
BYTES_NAME_PTR;
BIND
LAST_CHAR = BYTES_NAME_LEN;
IF ((LAST_CHAR = CH$RCHAR (CH$PLUS (..BUF_PTR_ADR, -1))) NEQ %C'+' AND .LAST_CHAR NEQ %C' ')
THEN
CH$WCHAR_A (%C'+', .BUF_PTR_ADR);
BYTES_NAME_PTR = CH$PLUS (.BYTE_TABLE [3], -1);
BYTES_NAME_LEN = CH$RCHAR_A (BYTES_NAME_PTR);
.BUF_PTR_ADR = CH$MOVE (.BYTES_NAME_LEN, .BYTES_NAME_PTR, ..BUF_PTR_ADR);
RETURN;
END
ELSE
BYTE_TABLE = BYTE_TABLE [4];
END; !OF BYTLS
GLOBAL ROUTINE BYTSM (BUF_PTR_ADR, PAT_PTR_ADR, PRM_LST_ADR_ADR) : NOVALUE =
!++
! FUNCTIONAL DESCRIPTION:
!
!
!
!
! FORMAL PARAMETERS:
!
!
! IMPLICIT INPUTS:
!
! NONE
!
! IMPLICIT OUTPUTS:
!
! NONE
!
! ROUTINE VALUE:
!
! NONE
!
! SIDE EFFECTS
!
! NONE
!
!--
BEGIN
LOCAL
BYTE_TABLE : REF VECTOR,
VALUE;
BEGIN
BIND
PRM_LIST = (.PRM_LST_ADR_ADR) : REF VECTOR;
BYTE_TABLE = .PRM_LIST [0];
VALUE = .PRM_LIST [1];
.PRM_LST_ADR_ADR = PRM_LIST [2]
END;
WHILE .BYTE_TABLE [0] NEQ 0 DO
IF .BYTE_TABLE [2] EQL .VALUE
THEN
BEGIN
LOCAL
BYTES_NAME_LEN,
BYTES_NAME_PTR;
BYTES_NAME_PTR = CH$PLUS (.BYTE_TABLE [3], -1);
BYTES_NAME_LEN = CH$RCHAR_A (BYTES_NAME_PTR);
.BUF_PTR_ADR = CH$MOVE (.BYTES_NAME_LEN, .BYTES_NAME_PTR, ..BUF_PTR_ADR);
RETURN;
END
ELSE
BYTE_TABLE = BYTE_TABLE [4];
CH$WCHAR_A (%C'(', .BUF_PTR_ADR);
$CBOMG (.BUF_PTR_ADR, .VALUE, 0);
CH$WCHAR_A (%C')', .BUF_PTR_ADR);
END; !OF BYTSM
ROUTINE CCBBUF (PATTERN_PTR, FORMATTER, ADR, BUF_MAX) : novalue =
!++
! FUNCTIONAL DESCRIPTION:
!
!
!
!
! FORMAL PARAMETERS:
!
! ASCII_TEXT !TEXT STRING FOR NEW SUB-TITLE
! TEXT_LENGTH !LENGTH OF SUB-TITLE STRING
!
! IMPLICIT INPUTS:
!
! NONE
!
! IMPLICIT OUTPUTS:
!
! NONE
!
! ROUTINE VALUE:
!
! NONE
!
! SIDE EFFECTS
!
! NONE
!
!--
BEGIN
BIND
BUF_BIAS = GETWRD (.ADR + FL$OFFSET (CCB$W_BIAS)),
BUF_ADR = GETWRD (.ADR + FL$OFFSET (CCB$A_ADDRESS)),
BUF_LNG = MIN (GETWRD (.ADR + FL$OFFSET (CCB$G_COUNT)), .BUF_MAX);
PUTLN (0, .PATTERN_PTR, BUF_BIAS, BUF_ADR, BUF_LNG);
IF .FLAGS [M_BUF]
THEN
BEGIN
EXTERNAL ROUTINE
ANYMSG;
IF .FLAGS [M_CEX_INTERPRET]
THEN
BEGIN
IF .FORMATTER NEQ 0
THEN
(.FORMATTER) (BUF_BIAS, BUF_ADR, BUF_LNG)
ELSE
ANYMSG (BUF_BIAS, BUF_ADR, BUF_LNG)
END
ELSE
PUTBUF (BUF_BIAS, BUF_ADR, BUF_LNG)
END;
END; !OF CCBBUF
GLOBAL ROUTINE CNV18 (PHYSICAL, VIRTUAL, BIAS) =
!++
! FUNCTIONAL DESCRIPTION:
!
!
! FORMAL PARAMETERS:
!
! NONE
!
! IMPLICIT INPUTS:
!
! NONE
!
! IMPLICIT OUTPUTS:
!
! NONE
!
! ROUTINE VALUE:
!
! NONE
!
! SIDE EFFECTS:
!
! NONE
!
!--
BEGIN
MAP
PHYSICAL : REF VECTOR [2];
PHYSICAL [1] = .VIRTUAL<0, 13> + .BIAS<0, 10>^6;
PHYSICAL [0] = .BIAS<10, 2>;
.PHYSICAL
END; !End of CNV18
GLOBAL ROUTINE PHYAD (BUF_PTR_ADR, PAT_PTR_ADR, PRM_LST_ADR_ADR) =
!++
! FUNCTIONAL DESCRIPTION:
!
!
! The next parameters are:
! BIT_LIST_ADR
! 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 = 3^11 + 1^9 + 8;
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, 9, 7, 0] + .VALUE [0, 0, 2, 0]^7, FLAG) + $CBTA (.BUF_PTR_ADR,
.VALUE [1,
0, 9, 0], FLAG)
END; !End of PHYAD
GLOBAL ROUTINE PUTBUF (BIAS, ADR, LNG) : NOVALUE =
!++
! FUNCTIONAL DESCRIPTION:
!
!
!
!
! FORMAL PARAMETERS:
!
! CCB_ADR !ADDRESS OF CCB TO DISPLAY
!
! IMPLICIT INPUTS:
!
! NONE
!
! IMPLICIT OUTPUTS:
!
! NONE
!
! ROUTINE VALUE:
!
! NONE
!
! SIDE EFFECTS
!
! NONE
!
!--
BEGIN
LOCAL
ADDRESS, !Current dump address.
BASE_ADR,
BYTES : CH$SEQUENCE (16, 8), !Dump buffer for bytes to display.
BYTES_LEFT, !Number of bytes left to process.
BYTES_PTR, !Pointer into BYTES.
COUNT; !Number of bytes for this line.
BIND
CHR_PTR = CH$PTR (BYTES,, 8); !Pointer to bytes string.
MAPAPR (6, .BIAS);
ADDRESS = .ADR;
BYTES_LEFT = .LNG;
WHILE (COUNT = MIN (.BYTES_LEFT, 16)) GTR 0 DO
BEGIN
BYTES_PTR = CHR_PTR;
BASE_ADR = .ADDRESS;
INCR ADDRESS FROM .BASE_ADR TO .BASE_ADR + .COUNT - 1 DO
CH$WCHAR_A (GETBYT (.ADDRESS), BYTES_PTR);
PUTLN (0, CH$ASCIZ (' %P %#B%83T*%2-%#E%100T*'), .BASE_ADR, .COUNT, CHR_PTR);
ADDRESS = .BASE_ADR + .COUNT;
BYTES_LEFT = .BYTES_LEFT - .COUNT;
END;
END; !OF PUTBUF
GLOBAL ROUTINE PUTCCB (SKIP, CCB_ADR, FORMATTER) : NOVALUE =
!++
! FUNCTIONAL DESCRIPTION:
!
!
!
!
! FORMAL PARAMETERS:
!
! CCB_ADR !ADDRESS OF CCB TO DISPLAY
!
! IMPLICIT INPUTS:
!
! NONE
!
! IMPLICIT OUTPUTS:
!
! NONE
!
! ROUTINE VALUE:
!
! NONE
!
! SIDE EFFECTS
!
! NONE
!
!--
BEGIN
LOCAL
FNC; !Temporary for function code.
LITERAL
CCBSZ = CCB$K_LENGTH^1;
BIND
BUF_ADR = GETWRD (.CCB_ADR + FL$OFFSET (CCB$A_ADDRESS)),
CCB_FNC = BYTE_LIST ((FC_AST, 'FC.AST'), (FC_XME, 'FC.XME'), (FC_RCE, 'FC.RCE'), (FC_KIL, 'FC.KIL'),
(FC_CTL, 'FC.CTL'), (FC_TIM, 'FC.TIM'), (FC_XCP, 'FC.XCP'), (FC_RCP, 'FC.RCP'),
(FC_KCP, 'FC.KCP'), (FC_CCP, 'FC.CCP')),
CCB_MOD_AST = BYTE_LIST (),
CCB_MOD_XME = BYTE_LIST (),
CCB_MOD_RCE = BYTE_LIST ((FM_DAT, 'FM.DAT'), (FM_RTN, 'FM.RTN')),
CCB_MOD_KIL = BYTE_LIST ((FM_KIL, 'FM.KIL'), (FM_CRA, 'FM.CRA'), (FM_XKL, 'FM.XKL')),
CCB_MOD_CTL = BYTE_LIST ((FM_STR, 'FM.STR'), (FM_STP, 'FM.STP'),
(FM_SET, 'FM.SET'), (FM_GET, 'FM.GET')),
CCB_MOD_TIM = BYTE_LIST ((FM_STM, 'FM.STM'), (FM_LTM, 'FM.LTM'), (FM_PWF, 'FM.PWF'),
(FM_PIN, 'FM.PIN')),
CCB_MOD_XCP = CCB_MOD_XME,
CCB_MOD_RCP = BYTE_LIST (),
CCB_MOD_KCP = CCB_MOD_KIL,
CCB_MOD_CCP = CCB_MOD_CTL,
CCB_MOD_FCN_BAD = BYTES_LIST (),
CCB_MOD = UPLIT (CCB_MOD_AST, CCB_MOD_XME, CCB_MOD_RCE, CCB_MOD_KIL,
CCB_MOD_CTL, CCB_MOD_TIM, CCB_MOD_XCP, CCB_MOD_RCP, CCB_MOD_KCP,
CCB_MOD_CCP, CCB_MOD_FCN_BAD) : VECTOR [11];
PUTLN (.SKIP, CH$ASCIZ (' ADDRESS: %P C.LNK: %P C.CHN: %P C.STK: %P'),
.CCB_ADR, GETWRD (.CCB_ADR + FL$OFFSET (CCB$A_LINK)),
GETWRD (.CCB_ADR + FL$OFFSET (CCB$A_CHAIN)),
GETWRD (.CCB_ADR + FL$OFFSET (CCB$A_STACK)));
PUTLN (0, (IF FL$SET (GETWRD (.CCB_ADR + %fieldexpand (CCB$V_ACTIVE, 0)^1), CCB$V_ACTIVE)
THEN CH$ASCIZ (' C.OWN: %R (%O) C.DST: %R (%O) C.SRC: %R (%O) ACTIVE')
ELSE CH$ASCIZ (' C.OWN: %R (%O) C.DST: %R (%O) C.SRC: %R (%O) INACTIVE')),
PROCESS_NAME (FNC = GETBYT (.CCB_ADR + FL$OFFSET (CCB$B_OWNER_PROCESS_INDEX))), .FNC,
PROCESS_NAME (FNC = GETBYT (GETWRD (.CCB_ADR + FL$OFFSET (CCB$A_DESTINATION_PROCESS))
+ FL$OFFSET (PDT$B_INDEX))), .FNC,
PROCESS_NAME (FNC = GETBYT (GETWRD (.CCB_ADR + FL$OFFSET (CCB$A_SOURCE_PROCESS))
+ FL$OFFSET (PDT$B_INDEX))), .FNC);
PUTLN (0, CH$ASCIZ (' C.FNC: %@ C.MOD: %@ C.PIX: %R (%O) C.LIX: %O C.STS: %P'),
BYTSM, CCB_FNC, (FNC = GETBYT (.CCB_ADR + FL$OFFSET (CCB$B_FUNCTION))),
BYTSM, .CCB_MOD [MINU ((IF .FNC THEN 20 ELSE .FNC), 20)^-1], GETBYT (.CCB_ADR
+ FL$OFFSET (CCB$B_MODIFIER)),
PROCESS_NAME (FNC = GETBYT (.CCB_ADR + FL$OFFSET (CCB$B_PROCESS_INDEX))), .FNC,
GETBYT (.CCB_ADR + FL$OFFSET (CCB$B_LINE_INDEX)),
GETWRD (.CCB_ADR + FL$OFFSET (CCB$G_STATUS)));
PUTLN (0, CH$ASCIZ (' C.PRM: %P %P %P %P %P'),
GETWRD (.CCB_ADR + FL$OFFSET (CCB$G_PARAMETER_1)),
GETWRD (.CCB_ADR + FL$OFFSET (CCB$G_PARAMETER_2)),
GETWRD (.CCB_ADR + FL$OFFSET (CCB$G_PARAMETER_3)),
GETWRD (.CCB_ADR + FL$OFFSET (CCB$G_PARAMETER_4)),
GETWRD (.CCB_ADR + FL$OFFSET (CCB$G_PARAMETER_5)));
IF ABS (BUF_ADR - .CCB_ADR) LSS CCBSZ
THEN
CCBBUF (CH$ASCIZ (' BUFFER POINTS INTO THE CCB: %+%P LENGTH: %O'),
.FORMATTER, .CCB_ADR, 20)
ELSE
CCBBUF (CH$ASCIZ (' BUFFER BIAS: %P ADDRESS: %P LENGTH: %O'),
.FORMATTER, .CCB_ADR, 1000)
END; !OF PUTCCB
END !End of module
ELUDOM