{ global declarations }

const
  UART_THR = $00;    { offset from base of UART Registers for IBM PC }
  UART_RBR = $00;
  UART_IER = $01;
  UART_IIR = $02;
  UART_LCR = $03;
  UART_MCR = $04;
  UART_LSR = $05;
  UART_MSR = $06;

  I8088_IMR = $21;   { port address of the Interrupt Mask Register }

  COM1_Base = $03F8;  { port addresses for the UART }
  COM2_Base = $02F8;

  COM1_Irq = 4;  { Interrupt line for the UART }
  COM2_Irq = 3;

  Async_Buffer_Max = $0FFF;

var

  OldInterruptSegment,
  OldInterruptOffset : integer;

  Async_Buffer       : Array[0..Async_Buffer_Max] of char;
  Async_Open_Flag    : Boolean;   { true if Open but no Close }
  Async_Port         : Integer;   { current Open port number (1 or 2) }
  Async_Base         : Integer;   { base for current open port }
  Async_Irq          : Integer;   { irq for current open port }

  Async_Buffer_Overflow : Boolean;  { True if buffer overflow has happened }
  Async_Buffer_Used     : Integer;
  Async_MaxBufferUsed   : Integer;

    { Async_Buffer is empty if Head = Tail }
  Async_Buffer_Head  : Integer;   { Locn in Async_Buffer to put next char }
  Async_Buffer_Tail  : Integer;   { Locn in Async_Buffer to get next char }
  Async_Buffer_NewTail : Integer;

const
  Async_Num_Bauds = 8;
  Async_Baud_Table : array [1..Async_Num_Bauds] of record
                                                     Baud, Bits : integer
                                                   end
                   = ((Baud:110;  Bits:$00),
                      (Baud:150;  Bits:$20),
                      (Baud:300;  Bits:$40),
                      (Baud:600;  Bits:$60),
                      (Baud:1200; Bits:$80),
                      (Baud:2400; Bits:$A0),
                      (Baud:4800; Bits:$C0),
                      (Baud:9600; Bits:$E0));

{----------------------------------------------------------------------}
{ Issue Interrupt $14 to initialize the UART                           }
{ See the IBM PC Technical Reference Manual for the format of ComParm  }
{----------------------------------------------------------------------}

procedure BIOS_RS232_Init(ComPort, ComParm : Integer);
var
  Regs : Registers;
begin
  with Regs do
    begin
      ax := ComParm AND $00FF;  { AH=0; AL=ComParm }
      dx := ComPort;
      Intr($14, Regs)
    end
end; { BIOS_RS232_Init }

{----------------------------------------------------------------------}
{ call DOS to set an interrupt vector                                  }
{----------------------------------------------------------------------}
procedure GetInterruptVector(v : integer);
var Regs : Registers;
begin
  with Regs do
    begin
      ax := $3500 + (v AND $00FF);
      MsDos(Regs);
      OldInterruptSegment := bx;
      OldInterruptOffset  := es;
    end;
end;

procedure DOS_Set_Intrpt(v, s, o : integer);
var
  Regs : Registers;
begin
  with Regs do
    begin
      ax := $2500 + (v AND $00FF);
      ds := s;
      dx := o;
      MsDos(Regs)
    end
end; { DOS_Set_Intrpt }

procedure RestoreInterruptVector(v : integer);
begin
  DOS_Set_Intrpt(v, OldInterruptSegment, OldInterruptOffset);
end;

{----------------------------------------------------------------------}
{                                                                      }
{  ASYNCISR.INC - Interrupt Service Routine                            }
{ Invoked when the UART has received a byte of data from the           }
{  communication line                                                  }
{                                                                      }
{----------------------------------------------------------------------}

procedure Async_Isr;
interrupt;
begin

  Inline(
    $FB/                           { STI }
      { get the incoming character }
      { Async_Buffer[Async_Buffer_Head] := Chr(Port[UART_RBR + Async_Base]); }
    $8B/$16/Async_Base/            { MOV DX,Async_Base }
    $EC/                           { IN AL,DX }
    $8B/$1E/Async_Buffer_Head/     { MOV BX,Async_Buffer_Head }
    $88/$87/Async_Buffer/          { MOV Async_Buffer[BX],AL }
      { Async_Buffer_NewHead := Async_Buffer_Head + 1; }
    $43/                           { INC BX }
      { if Async_Buffer_NewHead > Async_Buffer_Max then
          Async_Buffer_NewHead := 0; }
    $81/$FB/Async_Buffer_Max/      { CMP BX,Async_Buffer_Max }
    $7E/$02/                       { JLE L001 }
    $33/$DB/                       { XOR BX,BX }
      { if Async_Buffer_NewHead = Async_Buffer_Tail then
          Async_Buffer_Overflow := TRUE
        else }
{L001:}
    $3B/$1E/Async_Buffer_Tail/     { CMP BX,Async_Buffer_Tail }
    $75/$08/                       { JNE L002 }
    $C6/$06/Async_Buffer_Overflow/$01/ { MOV Async_Buffer_Overflow,1 }
    $90/                           { NOP generated by assembler for some reason }
    $EB/$16/                       { JMP SHORT L003 }
      { begin
          Async_Buffer_Head := Async_Buffer_NewHead;
          Async_Buffer_Used := Async_Buffer_Used + 1;
          if Async_Buffer_Used > Async_MaxBufferUsed then
            Async_MaxBufferUsed := Async_Buffer_Used
        end; }
{L002:}
    $89/$1E/Async_Buffer_Head/     { MOV Async_Buffer_Head,BX }
    $FF/$06/Async_Buffer_Used/     { INC Async_Buffer_Used }
    $8B/$1E/Async_Buffer_Used/     { MOV BX,Async_Buffer_Used }
    $3B/$1E/Async_MaxBufferUsed/   { CMP BX,Async_MaxBufferUsed }
    $7E/$04/                       { JLE L003 }
    $89/$1E/Async_MaxBufferUsed/   { MOV Async_MaxBufferUsed,BX }
{L003:}
      { disable interrupts }
    $FA/                           { CLI }
      { Port[$20] := $20; }  { use non-specific EOI }
    $B0/$20/                       { MOV AL,20h }
    $E6/$20 )                      { OUT 20h,AL }
end; { Async_Isr }

{----------------------------------------------------------------------}
{      Async_Init                                                      }
{      Performs initialization.                                        }
{----------------------------------------------------------------------}

procedure Async_Init;
begin
  Async_Open_Flag := FALSE;
  Async_Buffer_Overflow := FALSE;
  Async_Buffer_Used := 0;
  Async_MaxBufferUsed := 0;
end; { Async_Init }

{----------------------------------------------------------------------}
{ Async_Close                                                          }
{ Turn off the COM port interrupts.                                    }
{ reset the interrupt system when UART interrupts no longer needed     }
{----------------------------------------------------------------------}

procedure Async_Close;
var
  i, m : Integer;
begin
  if Async_Open_Flag then          { disable the IRQ on the 8259 }
    begin
      Inline($FA);                 { disable interrupts }
      i := Port[I8088_IMR];        { get the interrupt mask register }
      m := 1 shl Async_Irq;        { set mask to turn off interrupt }
      Port[I8088_IMR] := i OR m;
                                   { disable the 8250 data ready interrupt }
      Port[UART_IER + Async_Base] := 0;
                                   { disable OUT2 on the 8250 }
      Port[UART_MCR + Async_Base] := 0;
      Inline($FB);                 { enable interrupts }
                                   { restore old interrupt vector }
      RestoreInterruptVector(Async_Irq + 8);
      Async_Open_Flag := FALSE     { so we know the port is closed }
    end
end; { Async_Close }

{----------------------------------------------------------------------}
{      Async_Open(Port, Baud : Integer;                                }
{               Parity : Char;                                         }
{               WordSize, StpBits : Integer) : Boolean                 }
{      Sets up interrupt vector, initialies the COM port for           }
{      processing, sets pointers to the buffer.  Returns FALSE if COM  }
{      port not installed.                                             }
{----------------------------------------------------------------------}

function Async_Open(ComPort       : Integer;
                    BaudRate      : Integer;
                    Parity        : Char;
                    WordSize      : Integer;
                    StopBits      : Integer): boolean;
var
  ComParm : Integer;
  i, m : Integer;
begin
  if Async_Open_Flag then Async_Close;

  if ComPort = 2 then
    begin
      Async_Port := 2;
      Async_Base := COM2_Base;
      Async_Irq  := COM2_Irq
    end
  else
    begin
      Async_Port := 1;  { default to COM1 }
      Async_Base := COM1_Base;
      Async_Irq  := COM1_Irq
    end;

  GetInterruptVector(Async_Irq + 8);

  if (Port[UART_IIR + Async_Base] AND $00F8) <> 0
  then
    Async_Open := FALSE
  else
    begin

      Async_Buffer_Head := 0;
      Async_Buffer_Tail := 0;
      Async_Buffer_Overflow := FALSE;

  { Build the ComParm for RS232_Init }
  { See Technical Reference Manual for description }

      ComParm := $0000;

  { Set up the bits for the baud rate }
      i := 0;
      repeat
        i := i + 1
      until (Async_Baud_Table[i].Baud = BaudRate) OR (i = Async_Num_Bauds);
      ComParm := ComParm OR Async_Baud_Table[i].Bits;

      if Parity in ['E', 'e'] then ComParm := ComParm OR $0018
      else if Parity in ['O', 'o'] then ComParm := ComParm OR $0008
      else ComParm := ComParm OR $0000;  { default to No parity }

      if WordSize = 7
        then ComParm := ComParm OR $0002
        else ComParm := ComParm OR $0003;  { default to 8 data bits }

      if StopBits = 2
        then ComParm := ComParm OR $0004
        else ComParm := ComParm OR $0000;  { default to 1 stop bit }

  { use the BIOS COM port initialization routine to save typing the code }
      BIOS_RS232_Init(Async_Port - 1, ComParm);

      DOS_Set_Intrpt(Async_Irq + 8, CSeg, Ofs(Async_Isr));

  { read the RBR and reset any possible pending error conditions }
  { first turn off the Divisor Access Latch Bit to allow access to RBR, etc. }

      Inline($FA);  { disable interrupts }

      Port[UART_LCR + Async_Base] := Port[UART_LCR + Async_Base] AND $7F;
  { read the Line Status Register to reset any errors it indicates }
      i := Port[UART_LSR + Async_Base];
  { read the Receiver Buffer Register in case it contains a character }
      i := Port[UART_RBR + Async_Base];

  { enable the irq on the 8259 controller }
      i := Port[I8088_IMR];  { get the interrupt mask register }
      m := (1 shl Async_Irq) XOR $00FF;
      Port[I8088_IMR] := i AND m;

  { enable the data ready interrupt on the 8250 }
      Port[UART_IER + Async_Base] := $01; { enable data ready interrupt }

  { enable OUT2 on 8250 }
      i := Port[UART_MCR + Async_Base];
      Port[UART_MCR + Async_Base] := i OR $08;

      Inline($FB); { enable interrupts }
      Async_Open_Flag := TRUE;  { bug fix by Scott Herr }
      Async_Open := TRUE;
  end;
end; { Async_Open }

{----------------------------------------------------------------------}
{      Transmits the character.                                        }
{----------------------------------------------------------------------}

procedure kam_out(C : char);
var
  i, m, counter : Integer;
begin
  Port[UART_MCR + Async_Base] := $0B; { turn on OUT2, DTR, and RTS }

  { wait for CTS }
  counter := MaxInt;
  while (counter <> 0) AND ((Port[UART_MSR + Async_Base] AND $10) = 0) do
    counter := counter - 1;

  { wait for Transmit Hold Register Empty (THRE) }
  if counter <> 0 then  counter := MaxInt;
  while (counter <> 0) AND ((Port[UART_LSR + Async_Base] AND $20) = 0) do
    counter := counter - 1;

  if counter <> 0 then
    begin
      { send the character }
      Inline($FA); { disable interrupts }
      Port[UART_THR + Async_Base] := Ord(C);
      Inline($FB) { enable interrupts }
    end
  else
    begin
      Async_close;
      restore_entry_screen;
      writeln('COM',xmt_port:1,' has timed out.');
      writeln('Check KAM for power on and/or proper operation.');
      halt;
    end;
end;

{----------------------------------------------------------------------}
{      Remove Character From Interrupt Driven Buffer                   }
{----------------------------------------------------------------------}

function kam_in: char;
begin
  Inline($FA);                           { disable interrupts }
  kam_in := Async_Buffer[Async_Buffer_Tail];
  Async_Buffer_Tail := (Async_Buffer_Tail + 1) AND Async_Buffer_Max;
  Async_Buffer_Used := Async_Buffer_Used - 1;
  Inline($FB);                           { enable interrupts }
end;

{----------------------------------------------------------------------}
{      If a character is available, returns TRUE                       }
{----------------------------------------------------------------------}

function char_ready:boolean;
begin
  char_ready := (Async_Buffer_Head <> Async_Buffer_Tail);
{  if (Async_Buffer_Head = Async_Buffer_Tail)
    then char_ready := FALSE
    else char_ready := TRUE; }
end;

var _bufchr : char;

procedure clear_buffer;
begin
  repeat
    if char_ready then _bufchr := kam_in;
    delay(10);
  until NOT char_ready;
end;

procedure kam_cmd(s : msg_type);
var i : integer;
begin
  for i := 1 to length(s) do
    kam_out(s[i]);
end;

procedure kam_cmd_CR(s : msg_type);
begin
  kam_cmd(s + #13);
end;

procedure xmt_mode;
begin
  if mode in [CW,RTTY,ASCII] then
  begin
    xmt_ON := TRUE;
    kam_cmd(^C'T');
    clear_buffer;
    case mode of
      CW : ;
      RTTY, ASCII : if xmt_on_delay > 0 then
                      delay(xmt_on_delay * 100);
    end;
  end;
end;

procedure cw_status;
var  status_str : string[7];
     i : integer;
begin
  status_str := '        ';
  repeat
    for i := 1 to 6 do
      status_str[i] := status_str[i + 1];
    repeat until char_ready;
    status_str[7] := kam_in;
  until (status_str[1] = '-');
  if (status_str[7] = '-') then
    rcv_wpm := copy(status_str,5,2);
end;

procedure rcv_stat;
begin
  if mode in [CW,RTTY,ASCII] then
  begin
    kam_cmd(^C'R');
    case mode of
      ASCII : clear_buffer;
      RTTY  : clear_buffer;
      CW    : cw_status;
    end;
  end;
end;

procedure rcv_mode;
begin
  if mode in [CW,RTTY,ASCII] then
  begin
    xmt_ON := FALSE;
    rcv_stat;
  end;
end;


procedure set_rtty_baud;
begin
  kam_cmd(^C'R');
  kam_cmd(^C + chr(49+baud));
  clear_buffer;
  if xmt_ON then xmt_mode;
end;

procedure mod_rtty_invert;
begin
  kam_cmd(^C'R');
  kam_cmd(^C'I');
  invert := NOT invert;
  clear_buffer;
  if xmt_ON then xmt_mode;
end;

procedure set_rtty_shift;
begin
  kam_cmd(^C'R');
  kam_cmd(^C'S');
  clear_buffer;
  if xmt_on then xmt_mode;
end;

procedure cw_mode;
begin
  mode := CW;
  kam_cmd_CR('E OFF');
  kam_cmd_CR('XM ON');
  clear_buffer;
  kam_cmd_CR('CW ' + xmt_wpm);
  cw_status;
  state := receive;
end;

procedure kam_xmt_wpm;
begin
  kam_cmd(^C'X');
  clear_buffer;
  cw_mode;
  if xmt_ON then
    kam_cmd(^C'T');
end;

procedure rtty_mode;
begin
  baud := 0;
  mode := RTTY;
  kam_cmd_CR('E OFF');
  kam_cmd_CR('XM ON');
  kam_cmd_CR('MARK 2100');
  kam_cmd_CR('SPACE 2300');
  kam_cmd_CR('RB ' + baud_rate[baud] );
  kam_cmd_CR('SH ' + rtty_shift[shift]);
  kam_cmd_CR('INVERT OFF');
  kam_cmd_CR('CRAdd ON');
  kam_cmd_CR('LF ON');
  kam_cmd_CR('DIDdle ON');
  kam_cmd_CR('R');
  state := receive;
end;

procedure ascii_mode;
begin
  baud := 5;
  mode := ASCII;
  kam_cmd_CR('MARK 2100');
  kam_cmd_CR('SPACE 2300');
  kam_cmd_CR('ASCB ' + baud_rate[baud] );
  kam_cmd_CR('INVERT OFF');
  kam_cmd_CR('CRAdd ON');
  kam_cmd_CR('LF ON');
  kam_cmd_CR('A');
  state := receive;
end;

procedure packet_mode;
begin
  mode := PACKET;
  kam_cmd_CR('MARK '+packet_mark);
  kam_cmd_CR('SPACE '+packet_space);
  kam_cmd_CR('E ON');
  kam_cmd_CR(SW_VHF+'A');
  band := VHF;
  state := transceive;
end;

procedure HF_Packet;
begin
  kam_cmd(^C);
  kam_cmd_CR(SW_HF+'A');
  band := HF;
end;

procedure VHF_Packet;
begin
  kam_cmd(^C);
  kam_cmd_CR(SW_VHF+'A');
  band := VHF;
end;

procedure amtor_mode;
begin
  mode := AMTOR;
  state := transceive;
  kam_cmd_CR('E ON');
  kam_cmd_CR('A');
  band := HF;
end;

procedure packet_connect;
begin
  kam_cmd_CR('C ' + PKCall);
end;

procedure packet_disconnect;
begin
  kam_cmd(^C);
  kam_cmd_CR('D');
end;

procedure PacketID;
var i : integer;
begin
  kam_cmd_CR(^C);
  clear_buffer;
  for i := 1 to 5 do
  begin
    kam_cmd_CR('I');
    delay(2000);
  end;
  clear_buffer;
end;


procedure new_mode;
begin
  clear_buffer;
  case mode of
    AMTOR, CW, RTTY, ASCII : kam_cmd(^C'X');
    PACKET : kam_cmd_CR(^C'D');
  end;
  clear_buffer;
  save_screen;
  aux_color;
  window(35,8,45,16);
  clrscr;
  writeln;
  writeln(' 1> CW');
  writeln(' 2> RTTY');
  writeln(' 3> ASCII');
  writeln(' 4> PACKET');
  writeln(' 5> AMTOR');
  writeln;
  write  (' select..');
  repeat key := readkey until key in ['1'..'5'];
  case key of
    '1' : cw_mode;
    '2' : rtty_mode;
    '3' : ascii_mode;
    '4' : packet_mode;
    '5' : amtor_mode;
  end;
  window(1,1,80,25);
  restore_screen;
end;

procedure init_interface;
begin
  Async_Init;
  if (Async_Open(xmt_port, kam_baud_rate, 'N', 8, 1) = FALSE) then
  begin
    restore_entry_screen;
    Writeln('COM',xmt_port:1,' not installed.');
    halt;
  end;
  writeln('Initializing KAM interface');
  kam_cmd_CR('XOFF 0');
  kam_cmd_CR('XON 0');  clear_buffer;
  packet_mode;
end;

procedure reset_kam;
begin
  case mode of
    CW, RTTY, ASCII, AMTOR : kam_cmd(^C'X');
    PACKET : begin
               kam_cmd_CR('MARK 2100');
               kam_cmd_CR('SPACE 2300');
               kam_cmd_CR(SW_VHF+'A');
             end;
  end;
  clear_buffer;
  Async_close;
end;