Uses Crt,Dos;

Const
  RxR=0;                        {Receive Data, for read accesses}
  TxR=0;                        {Transmit Data, for write accesses}
  IER=1;                        {Interrupt Enable}
  IIR=2;                        {Interrupt Identification}
  LCR=3;                        {Line Control}
  MCR=4;                        {Modem Control}
  LSR=5;                        {Line Status}
  MSR=6;                        {Modem Status}
  DLL=0;                        {Divisor Latch High}
  DLH=1;                        {Divisor Latch Low}

  N=0;                          {no parity}
  O=8;                          {odd parity}
  E=24;                         {even parity}

  IRQ_Tab:Array[1..4] of Word   {Interrupt numbers of the ports}
    =(4,3,4,3);
  Base_Tab:Array[1..4] of Word  {Port addresses of the ports}
    =($3f8,$2f8,$3e8,$2e8);

Var OldInt:Pointer;             {original interrupt vector}
    Key:Char;                   {pressed key}
    IRQ,                        {IRQ number of current port}
    Base:Word;                  {port address of current port}
    finished:Boolean;             {flag for program end}

Procedure Handler;interrupt;
{Interrupt handler, receives characters from serial port}
Begin
  Write(Chr(Port[Base+RxR]));   {take characters from port and output}
  Port[$20]:=$20;               {send EOI}
End;

Procedure Open_Port(No:Word);
{prepares COM port for input/output}
Begin
  IRQ:=IRQ_Tab[No];             {get IRQ number}
  Base:=Base_Tab[No];           {get base address}
  GetIntVec(IRQ+8,OldInt);      {bend/deflect pointer}
  SetIntVec(IRQ+8,@Handler);
  Port[$21]:=Port[$21] and      {allow IRQ}
    not (1 shl IRQ);
  Port[Base+MCR]:=11;           {Auxiliary Output, set RTS and DTR}
  Port[Base+IER]:=1;            {Interrupt Enable for Receive}
End;

Procedure Close_Port;
{resets COM interrupts}
Begin
  SetIntVec(IRQ+8,OldInt);      {restore IRQ vector}
  Port[Base+MCR]:=0;            {reset signals}
  Port[Base+IER]:=0;            {disable interrupts}
  Port[$21]:=                   {reset Interrupt Controller}
    Port[$21] or (1 shl IRQ);
End;

Procedure Set_Speed(bps:LongInt);
{sets port speed}
Var Divisor:Word;
Begin
  Port[Base+LCR]:=Port[Base+LCR]{enable DLAB}
    or 128;
  Divisor:=115200 div bps;
  Port[Base+DLL]:=Lo(Divisor);  {write values in Divisor Latch}
  Port[BAse+DLH]:=Hi(Divisor);
  Port[Base+LCR]:=Port[Base+LCR]{disable DLAB}
    and not 128;
End;

Procedure Set_Param(Data,Par,Stop:Word);
{sets parameters for data bits, parity and stop bits}
Begin
  Port[Base+LCR]:=
    (Data-5)                    {set bits 0-1 to data bit}
    + Par                       {add parity}
    + (Stop-1) shl 2;           {set stop bits in Bit 2 of LCR}
End;

Procedure Error;
{called during time out in the Send procedure}
Begin
  WriteLn;
  WriteLn('Send time out');     {message}
  Close_Port;                   {close port}
  Halt(1);                      {and abort}
End;

Procedure Transmit(c:Char);
{sends characters via serial port}
Var Time_Out:Integer;           {counter for time out}
Begin
  Time_Out:=-1;
  While Port[Base+MSR] and 16 = 0 Do Begin
    Dec(Time_Out);              {wait for CTS}
    If Time_Out=0 Then Error;
  End;
  Time_Out:=-1;
  While Port[Base+LSR] and 32 = 0 Do Begin
    Dec(Time_Out);              {wait for empty transmitter register}
    If Time_Out=0 Then Error;
  End;
  Port[Base+TxR]:=Ord(c);       {send characters}
End;

Begin
  Open_Port(2);                 {open COM}
  Set_Speed(19200);             {speed 19200 bps}
  Set_Param(8,N,1);             {set parameters}
  WriteLn;
  WriteLn('terminal in function (Alt-X to exit):');
  Repeat
    Key:=ReadKey;               {read key}
    If Key <> #0 Then           {send normal keys to COM port}
      Transmit(Key)
    Else                        {exit on Alt-X}
      If ReadKey=#45 Then finished:=true;
  Until finished;
  Close_Port;                   {disable interrupts}
End.
