%title 'Set -- MailBox Master command'

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

begin

%sbttl 'module declarations'

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


forward routine Set_Protection;


literal DevNam_Size = 64;
own
    DevClass,
    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 = DEVCLASS, buffer = DevClass>,
	<code = DEVNAM, buflen = DevNam_Size,
	    buffer = DevNam, retlen = DevNam_dsc[DSC$W_LENGTH]>));


%sbttl 'Set_mbx -- Set_mbx MailBox'

global routine Set_mbx =
(
    external routine
	STR$FREE1_DX: addressing_mode (general),
	CLI$PRESENT: addressing_mode (general),
	CLI$GET_VALUE: addressing_mode (general),
	CLI_GET_PROTECTION;
    bind
	Pro_Label = %ascid 'PROTECTION';
    local
	sts: VMS_sts,
	Protection: word,

	MailBox_dsc: $dsc_dynamic;


    if not CLI$GET_VALUE (%ascid 'MailBox', MailBox_dsc) then
	return SS$_NORMAL;

    if CLI$PRESENT (Pro_Label) then
    (
	sts = CLI_GET_PROTECTION (Pro_Label, Protection);
	if .sts then
	    Set_Protection (MailBox_dsc, .Protection);
    )
    else
    (
	signal (MBM_Error (PROREQ));
	sts = MBM_Cond (PROREQ);
    );

    STR$FREE1_DX (MailBox_dsc);
    return .sts
);


%sbttl 'Set_Protection -- set MailBox protection'

routine Set_Protection (MailBox: ref $dsc, Protection) =
(
    local
	sts: VMS_sts, Channel: word;


    sts = $GETDVI (efn = 0, devnam = .MailBox, itmlst = ItmLst);
    if not .sts then
    (
	signal (MBM_Error (GETDVI, .MailBox), SS_Error (.sts));
	return .sts;
    )
    else
	$WAITFR (efn = 0);

    if .DevClass neq DC$_MAILBOX then
    (
	signal (MBM_Error (NOTMBX, .MailBox, DevNam_dsc));
	return MBM_Cond (NOTMBX);
    );

    sts = $ASSIGN (devnam = DevNam_dsc, chan = Channel);
    if not .sts then
    (
	signal (
	    MBM_Error (ASSIGN, .MailBox, DevNam_dsc),
	    SS_Error (.sts));
	return .sts;
    );

    sts = $QIOW (
	chan = .Channel,
	func = IO$_SETMODE or IO$M_SETPROT,
	P2 = .Protection);

    $DASSGN (chan = .Channel);

    if not .sts then
	signal (
	    MBM_Error (SETPROT, .MailBox, DevNam_dsc),
	    SS_Error (.sts));

    return .sts
);


end
eludom