msndmail:
	  proc options(main);

    %replace
	true   by '1'b,
	false  by '0'b;

%include 'cpnetdio.dcl';
%include 'mpmdio.dcl';
%include 'diomod.dcl';

	dcl
		1 MailBox_UQCB static,
		  2 pointer ptr,
		  2 msgadr ptr,
		  2 name char(8) initial ('MailBoxQ');
	dcl
		MailBoxAdr ptr,
		1 MailBox based (MailBoxAdr),
		  2 nmb_mail fixed(7),
		  2 size_mail bit(8),
		  2 mailslots ptr;
	dcl
		MailSlotAdr ptr,
		1 MailSlot (0:16) based (MailSlotAdr),
		  2 MailInPtr fixed(7),
		  2 MailOutPtr fixed(7),
		  2 MailCnt fixed(7),
		  2 MailBufferPtr ptr;
	dcl
		MailBufferAdr ptr,
		MailBuffer (0:8191) based (MailBufferAdr) bit(8);
	dcl
		MailAdr ptr,
		1 Mail based (MailAdr),
		  2 size fixed(7),
		  2 source bit(8),
		  2 text char(254);
	dcl
		sysdatpgadr ptr,
		1 sysdatpg based (sysdatpgadr),
		  2 memtop bit(8),
		  2 nmbcns fixed(7),
		  2 brkptrst fixed(7),
		  2 syscallstks bit(8),
		  2 bankswitched bit(8),
		  2 z80cpu bit(8),
		  2 bankedbdos bit(8),
		  2 basebankedbdos ptr,
		  2 configtbladr ptr;

	dcl
		configtblptr ptr,
		1 configtbl based (configtblptr),
		  2 status bit(8),
		  2 masterID bit(8),
		  2 maxnmbslvs fixed(7),
		  2 nmbloggedin fixed(7),
		  2 loggedinvctr bit(16),
		  2 slaveIDs (1:16) bit(8),
		  2 password char(8);

	dcl
		dbuffv ptr,
		command char(127) var based (dbuffv);

	dcl
		Hex char(16) static initial
		  ('0123456789ABCDEF'),
		HextoBit (1:16) char(4) static initial
		  ('0000','0001','0010','0011',
		   '0100','0101','0110','0111',
		   '1000','1001','1010','1011',
		   '1100','1101','1110','1111');

	dcl
		i fixed(15),
		startcol fixed(7),
		stopcol fixed(7),
		fieldlen fixed(7),
		slaveIDstr char(2),
		slaveID bit(8),
		version bit(16),
		v char(254) var;


  /*************************
  *                        *
  *   Main  Program        *
  *                        *
  *************************/

  version = vers();
  if substr (version,1,8) ~= '01'b4 then
  do;
    put skip list ('Must be running under MP/M.');
    call reboot();
  end;

  if ~opnque (addr (MailBox_UQCB)) then
  do;
    put skip list ('NETWRKIF not configured for mail.');
    call reboot();
  end;

  MailBox_UQCB.msgadr = addr (MailBoxAdr);
  call rdque (addr (MailBox_UQCB));
  MailSlotAdr = addr (MailBox.mailslots);
  sysdatpgadr = sysdat();
  configtblptr = sysdatpg.configtbladr;
  dbuffv = dbuff();
  startcol = index (command,'(') + 1;
  if startcol = 1 then
  do;
    put skip list ('Destination slave ID must be specified.');
    go to exit;
  end;
  stopcol = index (command,')');
  fieldlen = stopcol - startcol;
  if fieldlen < 1 | fieldlen > 2 then
  do;
    put skip list ('Illegal slave ID specification.');
    go to exit;
  end;
  slaveIDstr = substr (command,startcol,fieldlen);
  slaveIDstr = translate (slaveIDstr,'ABCDEF','abcdef');
  SlaveID = '0'b4 || HextoBit (index (Hex,substr(slaveIDstr,1,1)));
  if fieldlen = 2 then
  do;
    SlaveID = substr(SlaveID,5,4) ||
              HextoBit (index (Hex,substr(slaveIDstr,2,1)));
  end;

  startcol = index (command,'"') + 1;
  if startcol = 1 then
  do;
    put skip list ('Message must be enclosed in double quotes.');
    go to exit;
  end;
  stopcol = index (substr (command,startcol),'"');
  if stopcol = 0
    then stopcol = length(command) + 1;
    else stopcol = stopcol + startcol - 1;
  fieldlen = min (stopcol - startcol,MailBox.size_mail);

  do i = 1 to configtbl.maxnmbslvs;
    if substr (configtbl.loggedinvctr,17-i,1) = '1'b then
    do;
      if slaveID = configtbl.slaveIDs(i) then
      do;
        if MailSlot(i).MailCnt = MailBox.nmb_mail then
        do;
          put skip list ('Slave mail box full.');
          put skip list ('  Do you wish to overwrite? ');
          get list (v);
          if translate (v,'Y','y') ~= 'Y'
            then go to exit;
          MailSlot(i).MailOutPtr = MailSlot(i).MailOutPtr + 1;
          if MailSlot(i).MailOutPtr = MailBox.nmb_mail
            then MailSlot(i).MailOutPtr = 0;
        end;
        else
        do;
          MailSlot(i).MailCnt = MailSlot(i).MailCnt + 1;
        end;
        MailBufferAdr = MailSlot(i).MailBufferPtr;
        MailAdr = addr (MailBuffer(fixed(MailBox.size_mail,15) *
                              fixed(MailSlot(i).MailInPtr,15)));
        Mail.size = fieldlen;
        Mail.source = configtbl.masterID;
        substr (Mail.text,1,fieldlen) =
                             substr (command,startcol,fieldlen);
        MailSlot(i).MailInPtr = MailSlot(i).MailInPtr + 1;
        if MailSlot(i).MailInPtr = MailBox.nmb_mail
          then MailSlot(i).MailInPtr = 0;
        go to exit;
      end;
    end;
  end;

  put skip list ('Destination processor not logged in.');

exit:
  call wrque (addr (MailBox_UQCB));
  call reboot();

end msndmail;