mirror of
https://github.com/PDP-10/stacken.git
synced 2026-05-04 07:19:10 +00:00
717 lines
14 KiB
Plaintext
717 lines
14 KiB
Plaintext
|
||
MODULE TCB ( !Display RSX11 task information.
|
||
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:
|
||
!
|
||
! This module contains the routines to display Task Control Block (TCB)
|
||
! information.
|
||
!
|
||
! ENVIRONMENT: ANY
|
||
!
|
||
! AUTHOR: ALAN D. PECKHAM , CREATION DATE: 12-SEP-78
|
||
!
|
||
! MODIFIED BY:
|
||
!
|
||
! Alan D. Peckham, 10-Jul-80: VERSION 3
|
||
! 01 - Update RSX symbol references.
|
||
!--
|
||
|
||
!
|
||
! TABLE OF CONTENTS:
|
||
!
|
||
|
||
FORWARD ROUTINE
|
||
ATL : NOVALUE, !
|
||
STD : NOVALUE, !
|
||
FXD : NOVALUE, !
|
||
DMPTCB : NOVALUE, !
|
||
DMPRCQ : NOVALUE, !
|
||
DMPMCR : NOVALUE, !
|
||
DMPAST : NOVALUE, !
|
||
DMPRRQ : NOVALUE, !
|
||
DMPLBN : NOVALUE, !
|
||
DMPDEV : NOVALUE; !
|
||
|
||
!
|
||
! INCLUDE FILES:
|
||
!
|
||
|
||
LIBRARY 'MDACOM'; !MDA common definitions.
|
||
|
||
LIBRARY 'RSXLIB'; !RSX definitions.
|
||
|
||
!
|
||
! MACROS:
|
||
!
|
||
!
|
||
! EQUATED SYMBOLS:
|
||
!
|
||
|
||
literal
|
||
R_LGTH = 18*2, !18 wordsin a receive block.
|
||
R_LNTH = 18*2, !18 words in receive by reference.
|
||
M_LGTH = 80, !80 bytes in MCR buffer.
|
||
ATL_FLAG = 0,
|
||
STD_FLAG = 1,
|
||
FIX_FLAG = 2;
|
||
|
||
field
|
||
PRESTP =
|
||
[%fieldexpand (T2_STP, 0), %fieldexpand (T2_STP, 1) + 1, %fieldexpand (T2_STP, 2),
|
||
%fieldexpand (T2_STP,
|
||
3)], !Pre-AST status bits.
|
||
PRESPN =
|
||
[%fieldexpand (T2_SPN, 0), %fieldexpand (T2_SPN, 1) + 1, %fieldexpand (T2_SPN, 2),
|
||
%fieldexpand (T2_SPN,
|
||
3)],
|
||
PREWFR =
|
||
[%fieldexpand (T2_WFR, 0), %fieldexpand (T2_WFR, 1) + 1, %fieldexpand (T2_WFR, 2),
|
||
%fieldexpand (T2_WFR,
|
||
3)];
|
||
|
||
!
|
||
! OWN STORAGE:
|
||
!
|
||
|
||
OWN
|
||
DISPLAY_FLAGS,
|
||
MCRFLG;
|
||
|
||
BIND
|
||
DISPLAY_FLAG = DISPLAY_FLAGS : BITVECTOR [3];
|
||
|
||
!
|
||
! EXTERNAL REFERENCES:
|
||
!
|
||
|
||
EXTERNAL ROUTINE
|
||
GETWRD,
|
||
GETBYT,
|
||
SBTTL : NOVALUE,
|
||
SKIP : NOVALUE,
|
||
BITLS : NOVALUE,
|
||
VMADMP : NOVALUE,
|
||
$CBTA;
|
||
|
||
EXTERNAL
|
||
FLAGS : BITVECTOR [M_MAX_BITS];
|
||
|
||
GLOBAL ROUTINE ATL : NOVALUE =
|
||
|
||
!++
|
||
! FUNCTIONAL DESCRIPTION:
|
||
!
|
||
!
|
||
! FORMAL PARAMETERS:
|
||
!
|
||
! NONE
|
||
!
|
||
! IMPLICIT INPUTS:
|
||
!
|
||
! NONE
|
||
!
|
||
! IMPLICIT OUTPUTS:
|
||
!
|
||
! NONE
|
||
!
|
||
! ROUTINE VALUE:
|
||
!
|
||
! NONE
|
||
!
|
||
! SIDE EFFECTS:
|
||
!
|
||
! NONE
|
||
!
|
||
!--
|
||
|
||
BEGIN
|
||
DISPLAY_FLAGS = 0;
|
||
DISPLAY_FLAG [ATL_FLAG] = 1;
|
||
SBTTL (CH$ASCIZ ('ACTIVE TASKS'));
|
||
DMPTCB (RSX_MAX_ATL);
|
||
END; !End of ATL
|
||
|
||
GLOBAL ROUTINE STD : NOVALUE =
|
||
|
||
!++
|
||
! FUNCTIONAL DESCRIPTION:
|
||
!
|
||
!
|
||
! FORMAL PARAMETERS:
|
||
!
|
||
! NONE
|
||
!
|
||
! IMPLICIT INPUTS:
|
||
!
|
||
! NONE
|
||
!
|
||
! IMPLICIT OUTPUTS:
|
||
!
|
||
! NONE
|
||
!
|
||
! ROUTINE VALUE:
|
||
!
|
||
! NONE
|
||
!
|
||
! SIDE EFFECTS:
|
||
!
|
||
! NONE
|
||
!
|
||
!--
|
||
|
||
BEGIN
|
||
DISPLAY_FLAGS = 0;
|
||
DISPLAY_FLAG [STD_FLAG] = 1;
|
||
SBTTL (CH$ASCIZ ('SYSTEM TASK DIRECTORY'));
|
||
DMPTCB (RSX_MAX_STD);
|
||
END; !End of STD
|
||
|
||
GLOBAL ROUTINE FXD : NOVALUE =
|
||
|
||
!++
|
||
! FUNCTIONAL DESCRIPTION:
|
||
!
|
||
!
|
||
! FORMAL PARAMETERS:
|
||
!
|
||
! NONE
|
||
!
|
||
! IMPLICIT INPUTS:
|
||
!
|
||
! NONE
|
||
!
|
||
! IMPLICIT OUTPUTS:
|
||
!
|
||
! NONE
|
||
!
|
||
! ROUTINE VALUE:
|
||
!
|
||
! NONE
|
||
!
|
||
! SIDE EFFECTS:
|
||
!
|
||
! NONE
|
||
!
|
||
!--
|
||
|
||
BEGIN
|
||
DISPLAY_FLAGS = 0;
|
||
DISPLAY_FLAG [FIX_FLAG] = 1;
|
||
SBTTL (CH$ASCIZ ('FIXED TASKS'));
|
||
DMPTCB (RSX_MAX_FXD);
|
||
END; !End of FIX
|
||
|
||
ROUTINE DMPTCB (RSX_MAX_TCBS) : NOVALUE =
|
||
|
||
!++
|
||
! FUNCTIONAL DESCRIPTION:
|
||
!
|
||
!
|
||
! FORMAL PARAMETERS:
|
||
!
|
||
! NONE
|
||
!
|
||
! IMPLICIT INPUTS:
|
||
!
|
||
! NONE
|
||
!
|
||
! IMPLICIT OUTPUTS:
|
||
!
|
||
! NONE
|
||
!
|
||
! ROUTINE VALUE:
|
||
!
|
||
! NONE
|
||
!
|
||
! SIDE EFFECTS:
|
||
!
|
||
! NONE
|
||
!
|
||
!--
|
||
|
||
BEGIN
|
||
|
||
LOCAL
|
||
ENTRY_COUNT,
|
||
TCB_ADR;
|
||
|
||
IF NOT SYMBOL_TABLE ('RSX11S') THEN RETURN;
|
||
|
||
ENTRY_COUNT = .RSX_MAX_TCBS;
|
||
TCB_ADR = SYMBOL ($TSKHD) - FL$OFFSET (T_TCBL);
|
||
|
||
WHILE GETWRD ((TCB_ADR = GETWRD (.TCB_ADR + FL$OFFSET (T_TCBL))) + FL$OFFSET (T_TCBL)) NEQ 0 DO
|
||
BEGIN
|
||
|
||
IF (ENTRY_COUNT = .ENTRY_COUNT - 1) LSS 0 THEN RETURN PUTLN (1, CH$ASCIZ (WARNING, 'TOO MANY TASKS'));
|
||
|
||
IF (.DISPLAY_FLAG [STD_FLAG]) OR (.DISPLAY_FLAG [ATL_FLAG] AND FL$SET (GETWRD (.TCB_ADR + FL$OFFSET (
|
||
T_STAT)), TS_EXE)) OR (.DISPLAY_FLAG [FIX_FLAG] AND FL$SET (GETWRD (.TCB_ADR +
|
||
FL$OFFSET (T_ST2)), T2_FXD))
|
||
THEN
|
||
BEGIN
|
||
|
||
LOCAL
|
||
ADR,
|
||
LBN : VECTOR [2];
|
||
|
||
BIND
|
||
NAME_0 = GETWRD (.TCB_ADR + FL$OFFSET (T_NAM) + 0),
|
||
NAME_1 = GETWRD (.TCB_ADR + FL$OFFSET (T_NAM) + 2),
|
||
STATUS = GETWRD (.TCB_ADR + FL$OFFSET (T_STAT)),
|
||
PCB_ADR = GETWRD (.TCB_ADR + FL$OFFSET (T_PCB)),
|
||
HEADER_ADR = GETWRD (PCB_ADR + SYMBOL ('P.HDR'));
|
||
|
||
MCRFLG = FL$SET (GETWRD (.TCB_ADR + FL$OFFSET (T_ST3)), T3_CLI);
|
||
|
||
IF (NAME_0 EQL RAD50_WORD ('...') AND NAME_1 EQL RAD50_WORD ('MCR')) THEN MCRFLG = 2;
|
||
|
||
PUTLN (2, CH$ASCIZ (' %2R'), NAME_0, NAME_1);
|
||
PUTLN (0, CH$ASCIZ (' ------'));
|
||
PUTLN (1, CH$ASCIZ ('%4STCB ADDRESS = %P PAR = %2R PCB ADDRESS = %P'), .TCB_ADR,
|
||
GETWRD (PCB_ADR + FL$OFFSET (P_NAM) + 0), GETWRD (PCB_ADR + FL$OFFSET (P_NAM) + 2), PCB_ADR);
|
||
LBN [0] = GETBYT (.TCB_ADR + FL$OFFSET (T_LBN));
|
||
LBN [1] = GETWRD (.TCB_ADR + FL$OFFSET (T_LBN) + 1);
|
||
PUTLN (0, CH$ASCIZ ('%4SLOAD ADDRESS = %P00 LOAD DEVICE = %@ LBN = %@'),
|
||
(GETWRD (PCB_ADR + FL$OFFSET (P_REL)) + GETWRD (GETWRD (HEADER_ADR + FL$OFFSET (H_WND)) +
|
||
FL$OFFSET (W_BOFF) + 2)), DMPDEV, GETWRD (.TCB_ADR + FL$OFFSET (T_LDV)), DMPLBN, LBN);
|
||
PUTLN (0, CH$ASCIZ ('%4SPRI = %D. I/O COUNT = %D. UIC = [%O,%O] TI = %@'),
|
||
GETBYT (.TCB_ADR + FL$OFFSET (T_PRI)), GETBYT (.TCB_ADR + FL$OFFSET (T_IOC)),
|
||
GETBYT (HEADER_ADR + FL$OFFSET (H_CUIC) + 1), GETBYT (HEADER_ADR + FL$OFFSET (H_CUIC) + 0),
|
||
DMPDEV, GETWRD (.TCB_ADR + FL$OFFSET (T_UCB)));
|
||
PUTLN (0, CH$ASCIZ ('%4SMAX SIZE = %P EVENT FLAGS = <1-16> %P <17-32> %P'),
|
||
GETWRD (.TCB_ADR + FL$OFFSET (T_MXSZ)), GETWRD (.TCB_ADR + FL$OFFSET (T_EFLG) + 0),
|
||
GETWRD (.TCB_ADR + FL$OFFSET (T_EFLG) + 2));
|
||
BEGIN
|
||
|
||
BIND
|
||
TASK_STAT = FIELDS_LIST (('TS.EXE', '-TS.EXE'), 'TS.RDN', 'TS.MSG', 'TS.NRP', 'TS.OUT',
|
||
'TS.CKP', 'TS.CKR');
|
||
|
||
PUTLN (0, CH$ASCIZ ('%4ST.STAT: %@'), BITLS, TASK_STAT, STATUS)
|
||
END;
|
||
BEGIN
|
||
|
||
BIND
|
||
TASK_ST2 = FIELDS_LIST ('T2.AST', 'T2.DST', ('T2.CHK', '-T2.CHK'), 'T2.CKD', 'T2.BFX',
|
||
'T2.FXD', 'T2.TIO', 'T2.CAF', 'T2.HLT', 'T2.ABO', 'T2.STP', 'T2.SPN', 'T2.WFR'),
|
||
TASK_ST2_PRE = FIELD_LIST (('PRESTP', 'T2.STPA'), ('PRESPN', 'T2.SPNA'),
|
||
('PREWFR', 'T2.WFRA'));
|
||
|
||
PUTLN (0,
|
||
(IF FL$SET (STATUS, T2_AST) THEN CH$ASCIZ ('%4ST.ST2: %@') ELSE CH$ASCIZ ('%4ST.ST2: %@%@'
|
||
)), BITLS, TASK_ST2, (ADR = GETWRD (.TCB_ADR + FL$OFFSET (T_ST2))), BITLS, TASK_ST2_PRE,
|
||
.ADR)
|
||
END;
|
||
BEGIN
|
||
|
||
BIND
|
||
TASK_ST3 = FIELDS_LIST ('T3.ACP', ('T3.PMD', '-T3.PMD'), 'T3.REM', 'T3.PRV', 'T3.MCR',
|
||
'T3.SLV', 'T3.CLI', 'T3.RST', 'T3.NSD', 'T3.CAL', 'T3.ROV', 'T3.NET');
|
||
|
||
PUTLN (0, CH$ASCIZ ('%4ST.ST3: %@'), BITLS, TASK_ST3, GETWRD (.TCB_ADR + FL$OFFSET (T_ST3)))
|
||
END;
|
||
|
||
IF .FLAGS [M_RSX_DUMP]
|
||
THEN
|
||
BEGIN
|
||
SKIP (1);
|
||
VMADMP (0, .TCB_ADR, .TCB_ADR + SYMBOL ('T.LGTH'));
|
||
SKIP (1);
|
||
END;
|
||
|
||
IF .DISPLAY_FLAG [ATL_FLAG]
|
||
THEN
|
||
BEGIN
|
||
DMPRCQ (.TCB_ADR); !Dump the receive queue.
|
||
|
||
IF .MCRFLG EQL 2 THEN DMPMCR (.TCB_ADR); !Dump the MCR command buffer.
|
||
|
||
DMPAST (.TCB_ADR); !Dump the AST queue
|
||
DMPRRQ (.TCB_ADR); !Dump the receive by reference queue.
|
||
END;
|
||
|
||
END;
|
||
|
||
END;
|
||
|
||
END; !End of DMPTCB
|
||
ROUTINE DMPRCQ (TCB_ADDRESS) : NOVALUE =
|
||
|
||
!++
|
||
! FUNCTIONAL DESCRIPTION:
|
||
!
|
||
!
|
||
! FORMAL PARAMETERS:
|
||
!
|
||
! NONE
|
||
!
|
||
! IMPLICIT INPUTS:
|
||
!
|
||
! NONE
|
||
!
|
||
! IMPLICIT OUTPUTS:
|
||
!
|
||
! NONE
|
||
!
|
||
! ROUTINE VALUE:
|
||
!
|
||
! NONE
|
||
!
|
||
! SIDE EFFECTS:
|
||
!
|
||
! NONE
|
||
!
|
||
!--
|
||
|
||
BEGIN
|
||
|
||
LOCAL
|
||
ENTRY_COUNT,
|
||
RCV_ADDRESS;
|
||
|
||
IF (RCV_ADDRESS = GETWRD (.TCB_ADDRESS + FL$OFFSET (T_RCVL))) NEQ 0
|
||
THEN
|
||
BEGIN
|
||
PUTLN (1, CH$ASCIZ ('%6SRECEIVE QUEUE'));
|
||
PUTLN (0, CH$ASCIZ ('%6S-------------'));
|
||
ENTRY_COUNT = RSX_MAX_RCQ;
|
||
|
||
DO
|
||
BEGIN
|
||
|
||
IF (ENTRY_COUNT = .ENTRY_COUNT - 1) LSS 0
|
||
THEN
|
||
RETURN PUTLN (1,
|
||
CH$ASCIZ (WARNING,
|
||
'LIST TOO LONG'));
|
||
|
||
IF .MCRFLG LEQ 0
|
||
THEN
|
||
BEGIN
|
||
PUTLN (1, CH$ASCIZ ('%6SRECEIVE BLOCK ADDRESS = %P'), .RCV_ADDRESS);
|
||
SKIP (1);
|
||
VMADMP (0, .RCV_ADDRESS, .RCV_ADDRESS + R_LGTH);
|
||
END
|
||
ELSE
|
||
BEGIN
|
||
PUTLN (1, CH$ASCIZ ('%6SCOMMAND LINE INPUT BUFFER ADDRESS = %P UCB = %P'), .RCV_ADDRESS,
|
||
GETWRD (.RCV_ADDRESS + 2));
|
||
SKIP (1);
|
||
VMADMP (0, .RCV_ADDRESS, .RCV_ADDRESS + M_LGTH);
|
||
END;
|
||
|
||
END
|
||
WHILE (RCV_ADDRESS = GETWRD (.RCV_ADDRESS)) NEQ 0;
|
||
|
||
END;
|
||
|
||
END; !End of DMPRCQ
|
||
ROUTINE DMPMCR (TCB_ADDRESS) : NOVALUE =
|
||
|
||
!++
|
||
! FUNCTIONAL DESCRIPTION:
|
||
!
|
||
!
|
||
! FORMAL PARAMETERS:
|
||
!
|
||
! NONE
|
||
!
|
||
! IMPLICIT INPUTS:
|
||
!
|
||
! NONE
|
||
!
|
||
! IMPLICIT OUTPUTS:
|
||
!
|
||
! NONE
|
||
!
|
||
! ROUTINE VALUE:
|
||
!
|
||
! NONE
|
||
!
|
||
! SIDE EFFECTS:
|
||
!
|
||
! NONE
|
||
!
|
||
!--
|
||
|
||
BEGIN
|
||
|
||
LOCAL
|
||
ENTRY_COUNT,
|
||
CMD_ADDRESS,
|
||
UCB_ADDRESS;
|
||
|
||
IF (CMD_ADDRESS = GETWRD (SYMBOL ($MCRCB))) NEQ 0
|
||
THEN
|
||
BEGIN
|
||
PUTLN (1, CH$ASCIZ ('%6SMCR COMMAND BLOCKS'));
|
||
PUTLN (0, CH$ASCIZ ('%6S------------------'));
|
||
ENTRY_COUNT = RSX_MAX_MCR;
|
||
|
||
DO
|
||
BEGIN
|
||
|
||
IF (ENTRY_COUNT = .ENTRY_COUNT - 1) LSS 0
|
||
THEN
|
||
RETURN PUTLN (1,
|
||
CH$ASCIZ (WARNING,
|
||
'LIST TOO LONG'));
|
||
|
||
PUTLN (1, CH$ASCIZ ('%6SBUFFER ADDRESS = %P UCB = %P'), .CMD_ADDRESS,
|
||
(UCB_ADDRESS = GETWRD (.CMD_ADDRESS + 2)));
|
||
SKIP (1);
|
||
VMADMP (0, .CMD_ADDRESS, .CMD_ADDRESS + (IF .UCB_ADDRESS THEN 2 ELSE 84));
|
||
END
|
||
WHILE (CMD_ADDRESS = GETWRD (.CMD_ADDRESS)) NEQ 0;
|
||
|
||
END;
|
||
|
||
END; !End of DMPMCR
|
||
ROUTINE DMPAST (TCB_ADDRESS) : NOVALUE =
|
||
|
||
!++
|
||
! FUNCTIONAL DESCRIPTION:
|
||
!
|
||
!
|
||
! FORMAL PARAMETERS:
|
||
!
|
||
! NONE
|
||
!
|
||
! IMPLICIT INPUTS:
|
||
!
|
||
! NONE
|
||
!
|
||
! IMPLICIT OUTPUTS:
|
||
!
|
||
! NONE
|
||
!
|
||
! ROUTINE VALUE:
|
||
!
|
||
! NONE
|
||
!
|
||
! SIDE EFFECTS:
|
||
!
|
||
! NONE
|
||
!
|
||
!--
|
||
|
||
BEGIN
|
||
|
||
LOCAL
|
||
ENTRY_COUNT,
|
||
AST_ADDRESS,
|
||
PARAMETERS;
|
||
|
||
IF (AST_ADDRESS = GETWRD (.TCB_ADDRESS + FL$OFFSET (T_ASTL))) NEQ 0
|
||
THEN
|
||
BEGIN
|
||
PUTLN (1, CH$ASCIZ ('%6SAST QUEUE'));
|
||
PUTLN (0, CH$ASCIZ ('%6S---------'));
|
||
ENTRY_COUNT = RSX_MAX_AST;
|
||
|
||
DO
|
||
BEGIN
|
||
|
||
IF (ENTRY_COUNT = .ENTRY_COUNT - 1) LSS 0
|
||
THEN
|
||
RETURN PUTLN (1,
|
||
CH$ASCIZ (WARNING,
|
||
'LIST TOO LONG'));
|
||
|
||
PUTLN (1, CH$ASCIZ ('%6SAST BLOCK ADDRESS = %P A.CBL = %P'), .AST_ADDRESS,
|
||
GETWRD (.AST_ADDRESS + FL$OFFSET (A_CBL)));
|
||
PUTLN (0, CH$ASCIZ ('%6SA.BYT = %P A.AST = %P A.NPR = %P'),
|
||
GETWRD (.AST_ADDRESS + FL$OFFSET (A_BYT)), GETWRD (.AST_ADDRESS + FL$OFFSET (A_AST)),
|
||
(PARAMETERS = GETWRD (.AST_ADDRESS + FL$OFFSET (A_NPR))));
|
||
SKIP (1);
|
||
VMADMP (0, .AST_ADDRESS, .AST_ADDRESS + A_LGTH^1 + .PARAMETERS);
|
||
END
|
||
WHILE (AST_ADDRESS = GETWRD (.AST_ADDRESS)) NEQ 0;
|
||
|
||
END;
|
||
|
||
END; !End of DMPAST
|
||
ROUTINE DMPRRQ (TCB_ADDRESS) : NOVALUE =
|
||
|
||
!++
|
||
! FUNCTIONAL DESCRIPTION:
|
||
!
|
||
!
|
||
! FORMAL PARAMETERS:
|
||
!
|
||
! NONE
|
||
!
|
||
! IMPLICIT INPUTS:
|
||
!
|
||
! NONE
|
||
!
|
||
! IMPLICIT OUTPUTS:
|
||
!
|
||
! NONE
|
||
!
|
||
! ROUTINE VALUE:
|
||
!
|
||
! NONE
|
||
!
|
||
! SIDE EFFECTS:
|
||
!
|
||
! NONE
|
||
!
|
||
!--
|
||
|
||
BEGIN
|
||
|
||
LOCAL
|
||
ENTRY_COUNT;
|
||
|
||
ENTRY_COUNT = RSX_MAX_RRQ;
|
||
|
||
IF (ENTRY_COUNT = .ENTRY_COUNT - 1) LSS 0 THEN RETURN PUTLN (1, CH$ASCIZ (WARNING, 'LIST TOO LONG'));
|
||
|
||
END; !End of DMPRRQ
|
||
ROUTINE DMPLBN (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;
|
||
|
||
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 DMPLBN
|
||
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
|
||
END !End of module
|
||
|
||
ELUDOM
|