Uses Crt,Dos;

Const
  RxR=0;                        {Receive Data, bei Lesezugriffen}
  TxR=0;                        {Transmit Data, bei Schreibzugriffen}
  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;                          {keine Parit�t}
  O=8;                          {ungerade Parit�t}
  E=24;                         {gerade Parit�t}

  IRQ_Tab:Array[1..4] of Word   {Interrupt-Nummern der Schnittsctellen}
    =(4,3,4,3);
  Base_Tab:Array[1..4] of Word  {Portadressen der Schnittstellen}
    =($3f8,$2f8,$3e8,$2e8);

Var OldInt:Pointer;             {originaler Interrupt-Vektor}
    Key:Char;                   {gedr�ckte Taste}
    IRQ,                        {IRQ-Nummer des aktuellen Ports}
    Base:Word;                  {Portadresse des aktuellen Ports}
    fertig:Boolean;             {Flag f�r Programm-Ende}

Procedure Handler;interrupt;
{Interrupt-Handler, nimmt Zeichen von ser. Port entgegen}
Begin
  Write(Chr(Port[Base+RxR]));   {Zeichen vom Port holen und ausgeben}
  Port[$20]:=$20;               {EOI senden}
End;

Procedure Open_Port(Nr:Word);
{bereitet COM-Port auf Ein-/Ausgabe vor}
Begin
  IRQ:=IRQ_Tab[Nr];             {IRQ-Nummer holen}
  Base:=Base_Tab[Nr];           {Basis-Adress holen}
  GetIntVec(IRQ+8,OldInt);      {Zeiger verbiegen}
  SetIntVec(IRQ+8,@Handler);
  Port[$21]:=Port[$21] and      {IRQ zulassen}
    not (1 shl IRQ);
  Port[Base+MCR]:=11;           {Auxiliary Output, RTS und DTR setzen}
  Port[Base+IER]:=1;            {Interrupt Enable f�r Receive}
End;

Procedure Close_Port;
{setzt COM-Interrupts zur�ck}
Begin
  SetIntVec(IRQ+8,OldInt);      {IRQ-Vektor wiederherstellen}
  Port[Base+MCR]:=0;            {Signale zur�cksetzen}
  Port[Base+IER]:=0;            {Interrupts ausschalten}
  Port[$21]:=                   {Interrupt-Controller zur�cksetzen}
    Port[$21] or (1 shl IRQ);
End;

Procedure Set_Speed(bps:LongInt);
{setzt Port-Geschwindigkeit}
Var Divisor:Word;
Begin
  Port[Base+LCR]:=Port[Base+LCR]{DLAB einschalten}
    or 128;
  Divisor:=115200 div bps;
  Port[Base+DLL]:=Lo(Divisor);  {Werte in Divsor Latch schreiben}
  Port[BAse+DLH]:=Hi(Divisor);
  Port[Base+LCR]:=Port[Base+LCR]{DLAB ausschalten}
    and not 128;
End;

Procedure Set_Param(Data,Par,Stop:Word);
{setzt die Parameter Datenbits, Parit�t und Stopbits}
Begin
  Port[Base+LCR]:=
    (Data-5)                    {Bit 0-1 auf Datenbit setzen}
    + Par                       {Parit�t dazu}
    + (Stop-1) shl 2;           {Stopbits in Bit 2 des LCR setzen}
End;

Procedure Error;
{wird bei Time-Out in der Sende-Prozedur aufgerufen}
Begin
  WriteLn;
  WriteLn('Sende-Timeout');     {Meldung}
  Close_Port;                   {Port schlie�en}
  Halt(1);                      {und abbrechen}
End;

Procedure Transmit(c:Char);
{sendet Zeichen �ber seriellen Port}
Var Time_Out:Integer;           {Z�hler f�r Time-Out}
Begin
  Time_Out:=-1;
  While Port[Base+MSR] and 16 = 0 Do Begin
    Dec(Time_Out);              {Warten auf CTS}
    If Time_Out=0 Then Error;
  End;
  Time_Out:=-1;
  While Port[Base+LSR] and 32 = 0 Do Begin
    Dec(Time_Out);              {Warten auf leeres Transmitter-Register}
    If Time_Out=0 Then Error;
  End;
  Port[Base+TxR]:=Ord(c);       {Zeichen senden}
End;

Begin
  Open_Port(2);                 {COM �ffnen}
  Set_Speed(19200);             {Geschwindigkeit 19200 bps}
  Set_Param(8,N,1);             {Parameter setzen}
  WriteLn;
  WriteLn('Terminal in Funktion (Alt-X zum Beenden):');
  Repeat
    Key:=ReadKey;               {Taste lesen}
    If Key <> #0 Then           {normale Tasten an COM-Port senden}
      Transmit(Key)
    Else                        {bei Alt-X beenden}
      If ReadKey=#45 Then fertig:=true;
  Until fertig;
  Close_Port;                   {Interrupts ausschalten}
End.