%title 'Create -- MailBox Master command'

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

begin

%sbttl 'module declarations'

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


forward routine
    Ignore_Signal;


%sbttl 'Create -- Create MailBox'

global routine Create =
(
    external routine
	STR$FREE1_DX: addressing_mode (general),
	CLI$GET_VALUE: addressing_mode (general),
	CLI$PRESENT: addressing_mode (general),
	CLI_GET_NUMBER,
	CLI_GET_PROTECTION,
	CLI_GET_TIME,
	SYS$SETDFPROT: addressing_mode (general),
	LIB$ESTABLISH: addressing_mode (general),
	Get_MBX_DevNam;
    bind
	Pro_Label = %ascid 'PROTECTION',
	Wait_Label = %ascid 'WAIT';
    local
	sts: VMS_sts, Wait: VMS_sts,
	Old_Hand,
	MailBox: $dsc_dynamic,
	DevNam: $dsc_dynamic,
	MaxMsg: initial (0),
	BufQuo: initial (0),
	Protection: word, Wait_Time,
	Permanent: VMS_sts, Temporary: VMS_sts,
	mbx_chan: word initial (0);

    label
	Create_Main;


Create_Main:
    (
	if not (sts = CLI$GET_VALUE (%ascid 'MailBox', MailBox)) then
	    leave Create_Main;

	sts = CLI_GET_NUMBER (%ascid 'BUFQUO', BufQuo);
	if (.sts neq 0) and (not .sts) then leave Create_Main;

	sts = CLI_GET_NUMBER (%ascid 'MAXMSG', MaxMsg);
	if (.sts neq 0) and (not .sts) then leave Create_Main;

	if CLI$PRESENT (Pro_Label) then
	(
	    sts = CLI_GET_PROTECTION (Pro_Label, Protection);
	    if not .sts then leave Create_Main;
	)
	else
	    SYS$SETDFPROT (0, Protection);

	if Wait = CLI$PRESENT (Wait_Label) then
	(
	    sts = CLI_GET_TIME (Wait_Label, Wait_Time);
	    if not .sts then leave Create_Main;
	);

	Permanent = CLI$PRESENT (%ascid 'PERMANENT');
	Temporary = CLI$PRESENT (%ascid 'TEMPORARY');
	if .Permanent eql .Temporary then
	(
	    signal (MBM_Error (CONFLICT));
	    sts = MBM_Cond (CONFLICT);
	    leave Create_Main;
	);
	Permanent = not .Temporary;

	Old_Hand = LIB$ESTABLISH (Ignore_Signal);
	sts = Get_MBX_DevNam (0, MailBox, DevNam);
	LIB$ESTABLISH (.Old_Hand);

	if not .sts then
	(
	    if .DevNam[DSC$W_LENGTH] gtr 0 then STR$FREE1_DX (DevNam);

	    sts = $CREMBX (
		prmflg = (if .Permanent then 1 else 0),
		chan = mbx_chan,
		maxmsg = .MaxMsg,
		bufquo = .BufQuo,
		promsk = .Protection,
		lognam = MailBox);

	    if .sts then
	    (
		Get_MBX_DevNam (.mbx_chan, 0, DevNam);
		signal (MBM_Error (CREATED, MailBox, DevNam));
	    )
	    else
	    (
		signal (MBM_Error (CREMBX, MailBox), SS_Error (.sts));
		leave Create_Main;
	    );
	)
	else
	(
	    signal (MBM_Error (EXISTS, MailBox, DevNam));
	    sts = MBM_Cond (EXISTS);
	);

	$CLREF (efn = Ctrl_C_efn);

	$CANTIM ();
	if .Wait then
	(
	    $SETIMR (efn = Timer_efn, daytim = Wait_Time);

	    $WFLOR (
		efn = Timer_efn,
		mask = ef_mask (Timer_efn, Ctrl_C_efn));
	);

    );

    if .Permanent and (.mbx_chan neq 0) then $DASSGN (chan = .mbx_chan);

    if .Mailbox[DSC$W_LENGTH] gtr 0 then STR$FREE1_DX (MailBox);
    if .DevNam[DSC$W_LENGTH] gtr 0 then STR$FREE1_DX (DevNam);

    return .sts
);


%sbttl 'Ignore_Signal -- any signal is ignored'

routine Ignore_Signal (Sig: ref vector, Mech: ref vector, Enbl: ref vector) =
(
    return 1
);

end
eludom