{$G+,F+}
Program COMM_Creation;
Uses UTILS;
Const
    sBuffer   =128;
    bwPos     :Word=0;
    brPos     :Word=0;
Type
    tBaudRates=(_300,_1200,_2400,_4800,_7200,_9600,_12000,_14400,_19200,_38400,_57600,_115200);
    tParity   =(None, Odd, Even, Mark, Space);
    tBuffer   =Array[0..sBuffer] of Byte;
Const
    InInt      :Boolean=False;

    CurrentCom :Byte=3;

    PortAddr   :Array[1..4] of Word=($3F8, $2F8, $3E8, $2E8);

    baseTHR        =0;  baseRBR        =0;
    baseIER        =1;  baseIIR        =2; {Add these to base address}
    baseLCR        =3;  baseMCR        =4;
    baseLSR        =5;  baseMSR        =6;
    baseScratchPad =7;  baseDLL        =8;  baseDLM        =9;

    PIC = $21; {Programmable Interrupt Controller port}

    Divisor   :Array[_300.._115200] of Word=(384,96,48,24,16,12,9,8,6,3,2,1);

    comNoInterrupt  =1;  comModemStatus  =0;  comTHREmpty     =2;
    comRBFFull      =4;  comError        =6;

    comBits         :Array[5..8] of Byte=(0,1,2,3);

    com1StopBit     =0;
    com2StopBit     =4;

    comParity       :Array[None..Space] of byte=(0, 8, 24, 40, 56);

Var
     THR,RBR,IER,IIR,LCR,MCR,LSR,MSR,ScratchPad,DLL,DLM :Word;
     combuff                                            :^tBuffer;
     oldcomint                                          :Pointer;
{ÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄ}
{ÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄ}
{$F+,R-,I-,S-,W-}
Procedure COMIntHandler; Interrupt;
Begin
  InInt    :=True;
  comBuff^[bwPos]:=port[RBR];
  if bwPos=sBuffer then bwPos:=0 else inc(bwPos);
  port[$20]:=$20;
  InInt    :=False;{}
End;
{$F-,S-,R+,I+}
{ÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄ}
Procedure SetBit(Var Number:Byte; Bit : Byte);
Begin
  Number := Number OR (1 SHL Bit);
End;
{ÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄ}
Procedure ClearBit(Var Number :byte; Bit : Byte);
 Begin
  Number := Number AND NOT (1 SHL Bit);
 End;
{ÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄ}
Function ReadBit(Number, Bit : byte) : Boolean;
Begin
  ReadBit := (Number AND (1 SHL Bit)) <> 0;
 End;
{ÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄ}
Function SerialInterruptType:Byte; Assembler;
asm
  mov dx, IIR;
  in al, dx;
end;
{ÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄ}
Procedure SetBitPort(p:word; bit:byte);
Var temp:byte;
Begin
  temp:=port[p]; setbit(temp, bit); port[p]:=temp;
End;
{ÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄ}
Procedure ClearBitPort(p:word; bit:byte);
Var temp:byte;
Begin
  temp:=port[p]; clearbit(temp, bit); port[p]:=temp;
End;
{ÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄ}
Procedure InitSerial(comport:byte; baud:tBaudRates; bits,stopbits,parity:byte);
var temp:byte;
Begin
     CurrentCom:=ComPort;
     THR:=portAddr[ComPort]+baseTHR;  RBR:=portAddr[ComPort]+baseRBR;
     IER:=portAddr[ComPort]+baseIER;  IIR:=portAddr[ComPort]+baseIIR;
     LCR:=portAddr[ComPort]+baseLCR;  MCR:=portAddr[ComPort]+baseMCR;
     LSR:=portAddr[ComPort]+baseLSR;  MSR:=portAddr[ComPort]+baseMSR;
     ScratchPad:=portAddr[ComPort]+baseScratchPad;
     DLL:=portAddr[ComPort]+baseDLL;  DLM:=portAddr[ComPort]+baseDLM;
     port[LCR]:=128+parity+stopbits+bits; {Set comm params + 128!}
     port[THR]:=Lo(divisor[baud]);                    {Set comm speed}
     port[IER]:=Hi(divisor[baud]);
     clearbitport(LCR, 7); {Turn off 128 in LCR}
     setbitport(IER, 0);
     setbitport(MCR,3);
     new(combuff); fillchar(combuff^, 0, sizeof(combuff^));
     case comport of
                  1,3   :begin
                            getintvec($B,oldcomint);
                            setintvec($B,addr(ComIntHandler));
                            setbitport(PIC, 4);
                         end;
                  2,4   :begin
                            getintvec($C,oldcomint);
                            setintvec($C,addr(ComIntHandler));
                            setbitport(PIC, 3);
                         end;
                  end;{}
End;
{ÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄ}
Procedure DeInitSerial;
Begin
    dispose(combuff);
    case currentcom of
         1,3        :setintvec($B,oldcomint);
         2,4        :setintvec($C,oldcomint);
         End;
End;
{ÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄ}
Procedure SerWriteCh(ch:char);
Begin
    port[RBR]:=byte(Ch);
End;
{ÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄ}
Procedure SerWriteSt(s:string);
Var c:byte;
Begin
     while not boolean(port[LSR] and $20) do;
     asm cli; end;
     for c:=1 to length(s) do SerWriteCh(s[c]);
     asm sti; end;
End;
{ÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄ}
Function SerDataAvail:Boolean;
Begin
   if brPos=bwPos then SerDataAvail:=False else SerDataAvail:=True;
End;
{ÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄ}
Function SerReadCh:Char;
Begin
  repeat until not InInt;
  if not SerDataAvail then begin SerReadCh:=#0; exit; end;
  if brPos=sBuffer then brPos:=0 else inc(brPos);
  SerReadCh:=char(comBuff^[brPos]);
  inc(brPos);
End;
{ÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄ}
{ÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄ}
Begin
     InitSerial(3, _19200, comBits[8], com1StopBit, comParity[None]);
     writeln(port[IIR]);
     SerWriteSt('ATDT'+#$A+#$D);
     DeInitSerial;
End.