UNIT WCom;

{ -- Asychronous communications routines for Turbo Pascal  --
   Copyright (c) 1995 by Wayne Hoxsie. Revision date 5-27-95

   You may use this unit as you please as long as you mention
   me in your documentation.

}
INTERFACE

PROCEDURE AsyncTransmit(ch1:char);
FUNCTION  AsyncRecieve:char;
PROCEDURE AsyncFlushComm;
FUNCTION  AsyncCharWaiting:BOOLEAN;
FUNCTION  AsyncCDetect:boolean;
PROCEDURE AsyncInit(port_num:byte);
PROCEDURE AsyncShutdown;

IMPLEMENTATION

USES DOS;

CONST
(****************************************************************************
  These are the common base addresses and IRQ's for the 4 COM ports.  These
  will need to be edited if you use non-standard addresses or IRQ's
*)

  port_base_id : array[0..4] of word = (0,$3f8,$2f8,$2e8,$3e8);
  port_IRQ : array[0..4] of byte = (0,4,3,4,3);


(****************************************************************************
  These are jusr the mneumonics for the UART registers which are accesses
  relative to the com port's base address.
*)
  IER=1;
  FCR=2;
  IIR=2;
  LCR=3;
  MCR=4;
  LSR=5;
  MSR=6;

VAR
(****************************************************************************
  The head and tail are mearly to keep track of how many characters are in
  the buffer.  If they are not equal, then there are characters waiting to
  be processed.  Since it is a circular buffer, there may be characters still
  in the buffer which have already been processed.
*)

  buf_head,buf_tail : word;
  com_buf : array[0..1024] of byte;

(****************************************************************************
  These are the variables which will hold the current com port info.
*)

  async_irq,port_base : word;

(****************************************************************************
  These are just the ASM CLI and RTI instructions used to prevent another
  interrupt during the processing of data directly related to the interrupt
  handler.
*)

PROCEDURE Disable; INLINE($FA);
PROCEDURE Enable;  INLINE($FB);

(****************************************************************************
  This is the actual interrupt handler.  When a character is recieved by the
  com port, it signals the 8259 PIC which flags the processor to run the
  following code.  It grabs the character from the UART register and puts it
  into our circular buffer to be processed by the program at a later time.
  This is the essence of "Interrupt Driven Communications."
*)

{$F+}                                 { Make it a FAR function }
PROCEDURE async_isr; INTERRUPT;
BEGIN
  com_buf[buf_head]:=port[port_base];
  inc(buf_head);
  IF buf_head = 1024 THEN
    buf_head := 0;
  port[$20]:=$20;
END;
{$F-}

(****************************************************************************
  This procedure mearly sends a character out the com port.
*)
PROCEDURE AsyncTransmit(ch1:CHAR);
VAR
  temp : BYTE;
BEGIN

(*
  First we poll the LSR until there are no characters waiting in the
  transmitter holding register.  The bit we check (bit 5) is the THRE
  (Transmit Holding Register Empty) bit.
*)

  repeat
    temp:=port[port_base + LSR] AND $20;
  until temp<>0;

(*
  Now we can place a character in the register for the UART to send out.
*)

  port[port_base]:=integer(ch1);
END;

(****************************************************************************
  This function just checks to see if a character is waiting to be processed.
  It doesn't effect the character at all.
*)
FUNCTION  AsyncCharWaiting:BOOLEAN;
BEGIN
  asynccharwaiting := buf_head<>buf_tail;
END;

(****************************************************************************
  This function pulls a character out of our buffer and increments the
  pointers appropriately so that the interrupt handler can put the next
  character at the right place.  If no character is available, then we
  return a 0.
*)

FUNCTION  AsyncRecieve:char;
VAR
  c1 : char;
BEGIN
(* First make sure a char is waiting *)
  if buf_head <> buf_tail then
  BEGIN
    disable;
    c1 := char(com_buf[buf_tail]);
    inc(buf_tail);
    if buf_tail = 1024 then
      buf_tail := 0;
    enable;
    asyncrecieve:=c1;
  END  else
    asyncrecieve:=#0;
END;

(****************************************************************************
  This flushes all characters out of the buffer and resets the pointers
*)

PROCEDURE AsyncFlushComm;
BEGIN
  disable;
  buf_head :=0;
  buf_tail :=0;
  enable;
END;

(****************************************************************************
  This procedure sets the DTR pin to the desired value--ON or OFF--to tell
  the program on the other end that we are ready or not-ready.
*)

PROCEDURE dtr(i : BOOLEAN);
VAR
  i1 : word;
BEGIN
  i1 := port[port_base + MCR] AND $00FE;
  if i then
  port[port_base + MCR]:= i1+1 else
  port[port_base + MCR] := i1;
END;

(****************************************************************************
  This tells us if a carrier is detected or not.
*)

FUNCTION  AsyncCDetect:boolean;
BEGIN
  asynccdetect := (port[port_base + MSR] AND $0080)<> 0;
END;

(****************************************************************************
  This is the procedure that must be called to set up our com port for
  operation.  This installs the interrupt and sets the registers to the
  desired values.
*)

PROCEDURE AsyncInit(port_num : byte);
VAR
  temp : word;
BEGIN
  port_base := port_base_id[port_num];
  async_irq := port_IRQ[port_num];
  setintvec(8 + async_irq, addr(async_isr));
  buf_head :=0;
  buf_tail := 0;
  port[port_base + LCR]:= $03;          { set N81 parameters }
  disable;
  temp := port[port_base + LSR];        { Read LSR to reset all bits }
  temp := port[port_base];              { clear any character still pending }
  temp := port[$21];                    { read the PIC mask }
  temp := temp AND((1 SHL async_irq)XOR $00FF);  {set appropriate bit }
  port[$21]:=temp;                      {set the PIC mask appropriately}
  port[port_base + IER]:=1;
  temp:=port[port_base + MCR];
  port[port_base + MCR]:= temp OR $0A;  {Set MCR }
  port[port_base + FCR]:=$c0;           {enable FIFO's on 16550A's }
  enable;
  dtr(TRUE);                            {tell the world, "We're ready!" }
END;

(****************************************************************************
  This resets all the stuff we set up in the first place.
*)
PROCEDURE AsyncShutdown;
VAR
  temp : integer;
  oldvec : pointer;
BEGIN
  if port_base<>0 then BEGIN
    disable;
    temp := port[$21];
    temp := temp OR ((1 SHL async_irq));  { unmask the PIC }
    port[$21]:= temp;
    port[port_base + IIR]:=0;             { shutdown the interrupts }
    port[port_base + MCR]:=3;
    getintvec(8,oldvec);
    setintvec(async_irq+8,oldvec);
    enable;
    port_base:=0;
  END;
END;

END.

{End of Unit==Cut here}

program dumb_terminal;

uses dos,wcom,crt;

var
  temp : char;
  done : boolean;
  i,code : integer;

begin
  if(paramcount<1) then
    i:=1
  else
    val(paramstr(1),i,code);
  done:=false;
  asyncinit(2);
  repeat begin
    if keypressed then begin
      temp:=readkey;
      if temp=#27 then done:=true;
      asynctransmit(temp);
    end;
    if asynccharwaiting then
      write(asyncrecieve);
  end;
  until done;
  asyncshutdown;
end.