{ 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
  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 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 }

{----------------------------------------------------------------------}
{                                                                      }
{  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 }
      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;

  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
  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;
end;

{----------------------------------------------------------------------}
{      If a character is available, returns TRUE and moves the         }
{        character from the buffer to the parameter                    }
{      Otherwise, returns FALSE                                        }
{----------------------------------------------------------------------}

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

procedure clear_buffer;
var c : char;
begin
  delay(25);
  while char_ready do
  begin
    c := kam_in;
    if (mode = CW) then delay(15);
  end;
end;

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

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

procedure xmt_mode;
begin
  xmt_ON := TRUE;
  last_char_sent := #00;
  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;

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];
    delay(15);
    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
  kam_cmd(^C'R');
  case mode of
    ASCII : clear_buffer;
    RTTY  : clear_buffer;
    CW    : cw_status;
  end;
end;

procedure rcv_mode;
begin
  xmt_ON := FALSE;
  rcv_stat;
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('CW ' + xmt_wpm);
  cw_status;
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('RB ' + baud_rate[baud] );  clear_buffer;
  kam_cmd_CR('SH ' + rtty_shift[shift]); clear_buffer;
  kam_cmd_CR('INVERT OFF');              clear_buffer;
  kam_cmd_CR('CRAdd ON');                clear_buffer;
  kam_cmd_CR('LF ON');                   clear_buffer;
  kam_cmd_CR('DIDdle ON');               clear_buffer;
  kam_cmd_CR('R');                       clear_buffer;
end;

procedure ascii_mode;
begin
  baud := 5;
  mode := ASCII;
  kam_cmd_CR('ASCB ' + baud_rate[baud] ); clear_buffer;
  kam_cmd_CR('INVERT OFF');               clear_buffer;
  kam_cmd_CR('CRAdd ON');                 clear_buffer;
  kam_cmd_CR('LF ON');                    clear_buffer;
  kam_cmd_CR('A');                        clear_buffer;
end;

procedure select_mode;
begin
  aux_color;
  frame(28,10,53,16);
  window(29,11,52,15);
  clrscr;
  writeln(' Select     <1>  CW');
  writeln('            <2>  RTTY');
  writeln('            <3>  ASCII');
  writeln;
    write('          ....');
  repeat key := readkey until key in ['1'..'3'];
  case key of
    '1' : cw_mode;
    '2' : rtty_mode;
    '3' : ascii_mode;
  end;
end;

procedure new_mode;
begin
  kam_cmd(^C'X');
  clear_buffer;
  save_screen;
  select_mode;
  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'); clear_buffer;
  kam_cmd_CR('XON 0');  clear_buffer;
  kam_cmd_CR('E OFF');  clear_buffer;
  kam_cmd_CR('XM ON');  clear_buffer;
  select_mode;
end;

procedure reset_kam;
begin
  kam_cmd(^C'X');
  clear_buffer;
  Async_close;
end;