%title 'Show -- MailBox Master command'

module Show_mbx (
    ident = 'V4.0') =

begin

%sbttl 'module declarations'

library 'SYS$LIBRARY:STARLET';
library 'MBMLIB';


forward routine Show_Fao: novalue;

external routine Fao;

literal DevNam_Size = 64;
own
    DevBufSiz, DevChar: $bblock[4], DevClass, ErrCnt, OpCnt, PID,
    OwnUIC: vector[2, word], DevDepend, RefCnt, VProt,
    DevNam: vector[DevNam_Size, byte],
    DevNam_dsc: $dsc preset (
	[DSC$B_DTYPE] = DSC$K_DTYPE_T,
	[DSC$B_CLASS] = DSC$K_CLASS_S,
	[DSC$A_POINTER] = DevNam);

bind
    ItmLst = uplit (DVI_ItmLst (
	<code = DEVBUFSIZ, buffer = DevBufSiz>,
	<code = DEVCHAR, buffer = DevChar>,
	<code = DEVCLASS, buffer = DevClass>,
	<code = DEVDEPEND, buffer = DevDepend>,
	<code = DEVNAM, buflen = DevNam_Size,
	    buffer = DevNam, retlen = DevNam_dsc[DSC$W_LENGTH]>,
	<code = ERRCNT, buffer = ErrCnt>,
	<code = OPCNT, buffer =  OpCnt>,
	<code = OWNUIC, buffer = OwnUIC>,
	<code = PID, buffer = PID>,
	<code = REFCNT, buffer = RefCnt>,
	<code = VPROT, buffer = VProt>));


%sbttl 'Show -- Show device characteristics of mailbox'

global routine Show_mbx =
(
    external routine
	STR$FREE1_DX: addressing_mode (general),
	CLI$GET_VALUE: addressing_mode (general);
    local
	sts: VMS_sts initial (SS$_NORMAL),
	j: initial (0),
	MailBox_dsc: $dsc_dynamic;


    while CLI$GET_VALUE (%ascid 'MailBox', MailBox_dsc) do
    (
	if (j = .j + 1) gtr 1 then Fao (%ascid '');

	sts = $GETDVI (efn = 0, devnam = MailBox_dsc, itmlst = ItmLst);

	if .sts then
	(
	    $WAITFR (efn = 0);
	    if .DevClass eql DC$_MAILBOX then
		Show_Fao ()
	    else
	    (
		signal (MBM_Error (NOTMBX, MailBox_dsc, DevNam_dsc));
		sts = MBM_Cond (NOTMBX);
	    )
	)
	else
	    signal (MBM_Error (GETDVI, MailBox_dsc), SS_Error (.sts));

	STR$FREE1_DX (MailBox_dsc);
    );

    return .sts
);


%sbttl 'Show_Fao -- Output routine for SHOW command'

routine Show_Fao: novalue =
(
    local
	Not_VProt: word;
    bind
	Prot = Not_VProt: bitvector[16],
	MsgCnt = DevDepend: word,
	R = uplit byte (%c'R'),
	W = uplit byte (%c'W'),
	P = uplit byte (%c'P'),
	L = uplit byte (%c'L');


    Fao (%ascid 
	'  Mailbox !AS    Owner PID  !XL    Owner UIC  [!OW,!OW]',
	DevNam_dsc, .PID, .OwnUIC[1], .OwnUIC[0]);

    Not_VProt = not .VProt;
    Fao (%ascid
	'  Buffer size          !9UL    Protection  !4(AD),!4(AD),!4(AD),!4(AD)',
	.DevBufSiz,
	.Prot[0],  R, .Prot[1],  W,  .Prot[2],  P, .Prot[3],  L,
	.Prot[4],  R, .Prot[5],  W,  .Prot[6],  P, .Prot[7],  L,
	.Prot[8],  R, .Prot[9],  W,  .Prot[10], P, .Prot[11], L,
	.Prot[12], R, .Prot[13], W,  .Prot[14], P, .Prot[15], L);

    Fao (%ascid
	'  Messages in mailbox  !9UW    Operation count  !9UL',
	.MsgCnt, .OpCnt);

    Fao (%ascid
	'  Reference count      !9UL    Error count      !9UL',
	.RefCnt, .ErrCnt);
);


end
eludom