{ ROSMAC.INC - Remote Operating System Machine Dependent Routines }
{ From KP/Z-CLK.INC by N. Saunders and BB2.INC by Steve Fox }
{ Modified and enhanced for Epson QX-10 by Mick Gaitor - 10 May 85 }

const
{ Machine specific constants }

  DataPort   = $11;          { Data port }
  StatusPort = $13;          { Status/Control port }
  RatePort   = $06;          { Data rate port for CTC baud rate generator }
  BasePort   = $07;          { Base port for CTC baud rate generator }

{ StatusPort commands }

  RESCHN     = $18;          { reset channel }
  RESSTA     = $10;          { reset ext/status }
  WRREG1     = $00;          { value to write to register 1 }
  WRREG3     = $C1;          { 8 bits/char, rx enable }
  WRREG4     = $44;          { 16x, 1 stop bit, no parity }
  DTROFF     = $68;          { dtr off, rts off }
  DTRON      = $EA;          { dtr on, 8 bits/char, tx enable, rts on }
  ONINS      = $30;          { error reset }

{ StatusPort status masks }

  DAV        = $01;          { data available }
  TRDY       = $04;          { transmit buffer empty }
  DCD        = $08;          { data carrier detect }
  PE         = $10;          { parity error }
  OE         = $20;          { overrun error }
  FE         = $40;          { framing error }
  ERR        = $70;          { parity, overrun and framing error }

{ Smartmodem result codes }

  OKAY        = '0';         { Command executed with no errors }
  CONNECT300  = '1';         { Carrier detect at 300 bps }
  RING        = '2';         { Ring signal detected }
  NOCARRIER   = '3';         { Carrier lost or never heard }
  ERROR       = '4';         { Error in command execution }
  CONNECT1200 = '5';         { Carrier detect at 1200 bps }

{ Rate setting commands }

  BD300      : array[1..2] of byte = ($A0,$01);	{ 300  bps }
  BD1200     : array[1..2] of byte = ($68,$00);	{ 1200 bps }

  BDVECT     = $B6;				{ QX-10 vector word }


     {** System routines **}

procedure system_init;
{ System particular initialization to be done once (when ROS first starts) }
  begin
  end;

procedure putstat(st: StrStd);
{ Put 'st' on status line and return to normal display.
  'Made some changes to use the QX-10 status line without erasing the
   date/time display the QX puts there.  [MAG]
}
  const
    status_line    = 25;                    { Line used for system status }
    last_line      = 24;                    { Last line on screen }
  begin
    while Length(st) < 65 do		    { pad 'st' to 65 (65 = 80-15 : }
      st := st+' ';			    { the length of QX TAD display) }
    GotoXY(1, status_line);
    LowVideo;
    write(st);
    HighVideo;
    GotoXY(1, last_line)
  end;

     {** Time and date routines **}

function BCD_to_Bin(orig : byte): byte;
{ This routine converts single bytes from BCD, which the QX-10's clock
  outputs by default (in fact, I don't know how to get the clock to
  output in binary, though I know it does), to binary, which ROS expects.
  The routine was converted from an assembler routine in 8080/8085 Assembly
  Language Subroutines by Leventhal & Saville (1983 - Osborne/McGraw-Hill.
  I suspect there is a much more elegant way to do this - it just doesn't
  come to mind right at the moment. (Actually, in-line machine code would
  be more compact, but the code would also be less obvious.)  [MAG]
}
  const
    mask_lower = $F0;				{ to mask off upper nibble }
    mask_upper = $0F;				{ to mask off lower nibble }
  var
    byt,temp : byte;
  begin
    { do binary multiply by 10 }
    byt := orig;				{ get copy of argument }
    byt := byt and mask_lower;                  { get upper nibble }
    byt := byt shr 1;				{ shift right 1 bit }
    temp := byt;				{ temp = upper nibble*2 }
    byt := byt shr 2;				{ shift right two more times -
						  byt = upper nibble*8 }
    temp := temp+byt;                           { hold binary value(hi nibble)
						  temp = upper nibble*10 }
    byt := orig;				{ get argument back }
    byt := byt and mask_upper;                  { get lower nibble }
    BCD_to_Bin := byt+temp;                     { add bin lower to bin upper }
  end; {BCD_to_Bin}

procedure GetTAD(var t: tad_array);
{ Return a 6 element integer array of the current system time in
  seconds, minutes, hours, day, month, and year.
  This routine is based on a BASIC routine in THE EPSON QX-10
  USER'S GUIDE by James Hansen (1984 - Scott, Foresman & Co.).
}
  const
    ClkAddr = $3D;
    ClkData = $3C;
  var
    ClkRegs : array[0..9] of byte;
    ndx     : integer;
  begin
    repeat
      { read all registers into a holding array for ease of access }
      for ndx := 0 to 9 do
        begin
          port[ClkAddr] := ndx;			{ write RAM addr to clock port }
          ClkRegs[ndx]  := port[ClkData]	{ read register data           }
        end;
      { check seconds data }
      port[ClkAddr] := 0;			{ write secs addr to clock port }
    until port[ClkData] = ClkRegs[0];		{ make sure time hasn't changed }
    { return time and date to calling routine }
    t[0] := BCD_to_Bin(ClkRegs[0]);		{ secs }
    t[1] := BCD_to_Bin(ClkRegs[2]);		{ mins }
    t[2] := BCD_to_Bin(ClkRegs[4]);		{ hrs  }
    t[3] := BCD_to_Bin(ClkRegs[7]);		{ day  }
    t[4] := BCD_to_Bin(ClkRegs[8]);		{ mo   }
    t[5] := BCD_to_Bin(ClkRegs[9]);		{ yr   }
  end;

procedure SetTAD(var t: tad_array);
  const
    ClkAddr = $3D;
    ClkData = $3C;
  var
    ClkRegs : array[0..9] of integer;
    ndx     : integer;
  begin
    { read all registers into a holding array for ease of access }
    for ndx := 0 to 9 do
      begin
        port[ClkAddr] := ndx;			{ write RAM addr to clk port }
        ClkRegs[ndx]  := port[ClkData]		{ read register data         }
      end;
    { place new time and date in holding array slots }
    ClkRegs[0] := t[0];				{ secs }
    ClkRegs[2] := t[1];				{ mins }
    ClkRegs[4] := t[2];				{ hrs  }
    ClkRegs[7] := t[3];				{ day  }
    ClkRegs[8] := t[4];				{ mo   }
    ClkRegs[9] := t[5];				{ yr   }
    { write holding array back to clock port }
    for ndx := 0 to 9 do
      begin
        port[ClkAddr] := ndx;			{ write RAM addr to clock port }
        port[ClkData] := ClkRegs[ndx]		{ write register data          }
      end
  end;

     {** Modem-interface routines **}

function mdcarck: boolean;
{ Check to see if carrier is present }
begin
  port[StatusPort] := RESSTA;
  mdcarck := ((DCD and port[StatusPort]) <> 0)
end;

function mdinprdy: boolean;
{ Check for ready to input from modem }
var
  bt: byte;
begin
  if (DAV and port[StatusPort]) <> 0
    then
      begin
        port[StatusPort] := 1;
        if (ERR and port[StatusPort]) <> 0
          then
            begin
              port[StatusPort] := ONINS;
              bt := port[DataPort];
              mdinprdy := FALSE
            end
          else mdinprdy := TRUE
      end
    else mdinprdy := FALSE
end;

function mdinp: byte;
{ Input a byte from modem - no wait - assumed ready }
begin
  mdinp := port[DataPort]
end;

procedure mdout(b: byte);
{ Output a byte to modem - wait until ready }
begin
  repeat
  until (TRDY and port[StatusPort]) <> 0;
  port[DataPort] := b
end;

procedure mdinit;
{ Initialize the sio channel and the Hayes Smartmodem 1200 or compatible }
const
  sio_init: array[1..9] of byte = 
    (RESCHN,4,WRREG4,1,WRREG1,5,DTROFF,3,WRREG3);
var
  bt       : byte;
  i        : integer;
  mdm_attn : string[2];
  mdm_init : string[38];
begin
  for i := 0 to 9 do
    port[StatusPort] := sio_init[i];        { initialize the SIO channel }
  port[StatusPort] := 5;                    { set to write register 5    }
  port[StatusPort] := DTRON;		    { pull DTR high }
  mdm_attn := 'AT';
  mdm_init := 'ATH0E0Q0V0M0X1 S0=0 S2=3 S4=255 S5=255';
  port[BasePort] := BDVECT;		    { send vector addr to CTC, then }
  for i := 1 to 2 do			    { set the 46818 to 1200 baud -  }
    port[RatePort] := BD1200[i];	    { (needs 2-byte write)  [MAG]   }
  delay (500);                              {let the modem settle for a bit}
  for i := 1 to 2 do
    begin
      bt := ord(mdm_attn[i]);               { force the modem to 1200 baud }
      mdout(bt)
    end;
  bt := ord(CR);
  mdout(bt);
  delay (2000);                             {wait a sec...}
  for i := 1 to 38 do
    begin
      bt := ord(mdm_init[i]);               {initialize the modem}
      mdout(bt)
    end;
  bt := ord(CR);
  mdout(bt);
  bt := mdinp;                              { clear any previous rings }
  bt := mdinp
end;

procedure mdbusy;
const
  sio_init: array[1..9] of byte = 
    (RESCHN,4,WRREG4,1,WRREG1,5,DTROFF,3,WRREG3);
var
  bt        : byte;
  i	    : integer;
  mdm_attn  : string[2];
  mdm_local : string[6];
begin
  for i := 1 to 9 do
    port[StatusPort] := sio_init[i];        { initialize the SIO channel }
  port[StatusPort] := 5;                    { set to write register 5    }
  port[StatusPort] := DTRON;		    { pull DTR high }
  mdm_attn := 'AT';
  mdm_local := 'ATH1M0';		    { 'M0' should be last to work on
					      the Prometheus ProModem 1200
					      [MAG] }
  delay (500);                              { let the modem settle for a bit }
  for i := 1 to 2 do
    begin
      bt := ord(mdm_attn[i]);               { force the modem to 1200 baud }
      mdout(bt)
    end;
  bt := ord(CR);
  mdout(bt);
  delay (2000);                             { wait a sec... }
  for i := 1 to 6 do
    begin
      bt := ord(mdm_local[i]);              { initialize the modem }
      mdout(bt)
    end;
  bt := ord(CR);
  mdout(bt);
end;

function mdring: boolean;
{ Determine if the phone is ringing }
begin
  if mdinprdy
    then mdring := (RING = chr(mdinp))
    else mdring := FALSE
end;

procedure mdhangup;
{ Hangup modem }
var
  bt       : byte;
  i        : integer;
  mdm_hang : string[4];
begin
  repeat
    port[StatusPort] := 5;             { setup to write register 5 }
    port[StatusPort] := DTROFF;        { clear DTR, causing hangup }
    delay(2000);
    port[StatusPort] := 5;
    port[StatusPort] := DTRON;
    if mdcarck
      then
        begin
	  mdm_hang := 'ATH0';
          for i := 1 to 3 do
            begin
              bt := ord(ETX);
              mdout(bt)
            end;
          delay(1500);
          for i := 1 to 4 do
            begin
              bt := ord(mdm_hang[i]);
              mdout(bt)
            end;
          bt := ord(CR);
          mdout(bt)
        end;
  until not(mdcarck);
  { This added section will restore the modem to its default state IF the
    sysop or other authorized user signals ROS to end. 13MAY85  [MAG]       }
  if fini then
    begin
      mdm_hang := 'ATZ ';	       { "smart" modem cancel              }
      for i := 1 to 4 do
        begin
          bt := ord(mdm_hang[i]);
          mdout(bt)
        end;
      bt := ord(CR);
      mdout(bt);
    end
end;

procedure mdans;
{ Detect and set system to rate at which modem answered phone }
  var
    i        : integer;
    bt       : byte;
    mdm_answ : string[3];
  begin
    repeat
    until mdinprdy;
    bt := mdinp;
    mdm_answ := 'ATA';
    for i := 1 to 3 do
      begin
        bt := ord(mdm_answ[i]);
        mdout(bt)
      end;
    bt := ord(CR);
    mdout(bt);
    repeat
    until mdinprdy;
    case chr(mdinp) of
      CONNECT1200:
        begin
	  port[BasePort] := BDVECT;	     { send vector addr to CTC, then }
	  for i := 1 to 2 do		     { set the 46818 to 1200 baud -  }
	    port[RatePort] := BD1200[i];     { (needs 2-byte write)  [MAG]   }
          rate := 0.02075;		     { I have NO idea if this is right }
          delay(500);
          bt := mdinp;
          bt := mdinp
        end;
      CONNECT300:
        begin
	  port[BasePort] := BDVECT;	     { send vector addr to CTC, then }
	  for i := 1 to 2 do		     { set the 46818 to 300 baud -   }
	    port[RatePort] := BD300[i];      { (needs 2-byte write)  [MAG]   }
          rate := 0.083;		     { I have NO idea if this is right }
          delay(500);
          bt := mdinp;
          bt := mdinp
        end;
      NOCARRIER: mdhangup
    end
  end;