[Back to COMM SWAG index] [Back to Main SWAG index] [Original]

    {$R-,S-}
    unit ComPort;

    interface

    uses TPDos,
         TpString,
         TpInt;

    function OpenCom(PortNum,Params: Word): boolean;

    { Issues interrupt $14 to initialize the UART, sets up buffers            }
    { This procedure should be called using the const declarations following. }
    { Sample calling sequence:                                                }
    {      Port := Com1Port;                                                  }
    {      Params := Baud9600 + NoParity + WordSize8 + StopBits1;             }
    {      if InitCom( Port, Params ) then;                                   }

    function ComReady: boolean;
    {returns true if character ready;  false if no character waiting }

    function ReadCom: char;
    {returns character from com port}

    procedure WriteCom( C: char );
    {Send a character}

    procedure WriteComStr( S: string );
    {Writes a string, S, by repeatedly calling WriteCom}

    const
      AsyncBufMax = 4095;     {Upper limit of Async Buffer}

    var
      Async: record
        Overflow: boolean;
        PortNum,
        Base,
        Max,
        Head,
        Tail:    word;
        Buffer: array[0..AsyncBufMax] of char;
        end;

    const
      Baud110 =       $00;
      Baud150 =       $20;
      Baud300 =       $40;
      Baud600 =       $60;
      Baud1200 =      $80;
      Baud2400 =      $A0;
      Baud4800 =      $C0;
      Baud9600 =      $E0;
      EvenParity =    $18;
      OddParity =     $08;
      NoParity =      $00;
      WordSize7 =     $02;
      WordSize8 =     $03;
      StopBits1 =     $04;
      StopBits2 =     $00;
      Com1Port =      $00;
      Com2Port =      $01;

    {===========================================================================}
    {.pa}
    implementation

    const
      UART_THR  = $00;     {Transmit Hold Register}
      UART_RBR  = $00;     {Receive Buffer Register}
      UART_IER  = $01;     {Data ready interrupt}
      UART_IIR  = $02;     {}
      UART_LCR  = $03;     {}
      UART_MCR  = $04;     {OUT2}
      UART_LSR  = $05;     {Line Status Register}
      UART_MSR  = $06;     {}
      I8088_IMR = $21;     {Interrupt Mask Register on 8250\9}

    var
      AsyncBIOSPortTable: array[1..2] of word absolute $40:0;
      SaveExitProc:  pointer;

    procedure BiosInitCom(PortNum,Params: Word);
    inline(
      $58/          { POP   AX      ;Pop parameters         }
      $5A/          { POP   DX      ;Pop port number        }
      $B4/$00/      { MOV   AH,0    ;Code for initialize    }
      $CD/$14);     { INT   14H     ;Call BIOS              }

    function InChar(PortNum: Word): Char;
    inline(
      $5A/          { POP   DX      ;Pop port number        }
      $B4/$02/      { MOV   AH,2    ;Code for input         }
      $CD/$14);     { INT   14H     ;Call BIOS              }

    function InReady(PortNum: Word): Boolean;
    inline(
      $5A/          { POP   DX      ;Pop port number        }
      $B4/$03/      { MOV   AH,3    ;Code for status        }
      $CD/$14/      { INT   14H     ;Call BIOS              }
      $88/$E0/      { MOV   AL,AH   ;Get line status in AH  }
      $24/$01);     { AND   AL,1    ;Isolate Data Ready bit }

    {$F+} procedure ComIntHandler( BP: word ); interrupt; {$F-}

    var
      Regs:      IntRegisters absolute BP;
      NewHead:   word;

    begin   {ComIntHandler}

      with Async do begin
        Buffer[Head] := Chr( Port[UART_RBR + Base] );
        NewHead := succ( Head );
        if NewHead > Max then NewHead := 0;
        if NewHead = Tail then Overflow := true
        else Head := NewHead;
        InterruptsOff;
        Port[$20] := $20;   {use non-specific EOI}
        end;  {with Async}

      end;   {ComIntHandler}

    function OpenCom(PortNum,Params: Word): boolean;

    const
      Handle =  15;    {Select an arbitrary handle for TPInt}

    var
      IntNumber: byte;
      Junk,
      Mask:      word;
      IRQ,
      Vector:    byte;
      I:         integer;

    begin

      if Async.PortNum <> $FFFF then begin
        OpenCom := false;
        exit;
        end;
      Async.Base := AsyncBIOSPortTable[PortNum + 1];
      IRQ := Hi(Async.Base) + 1;
      IntNumber := IRQ + $8;
      if (Port[UART_IIR + Async.Base] and $F8) <> 0 then begin
        OpenCom := false;
        exit;
        end;
      if not InitVector( IntNumber, Handle, @ComIntHandler ) then begin
        OpenCom := false;
        exit;
        end;
      Async.PortNum := PortNum;
      {Other parameters already initialized}
      BiosInitCom(PortNum,Params);
      InterruptsOff;
      Port[UART_LCR + Async.Base] := Port[UART_LCR + Async.Base] and $7F;
      Junk := Port[UART_LSR + Async.Base];  {Reset any Line Status Register errors}
      Junk := Port[UART_RBR + Async.Base];  {Empty Receive Buffer Register}

      {Enable IRQ on the 8259 controller}
      Port[I8088_IMR] := Port[I8088_IMR] and ((1 shl IRQ) xor $FF);

      Port[UART_IER + Async.Base] := $01; {Enable data ready interrupt on the 8250}

      {Enable OUT2 on 8250}
      Port[UART_MCR + Async.Base] := Port[UART_MCR + Async.Base] or $08;
      Port[$20] := $20;   {clear out non-specific EOI}

      InterruptsOn;
      OpenCom := true;

      end;

    function ReadCom: char;
    {returns character from com port}

    begin

      with Async do begin
        repeat until Head <> Tail;   {Wait here for a character}
        ReadCom := Buffer[Tail];
        InterruptsOff;
        Inc( Tail );
        if Tail > Max then Tail := 0;
        InterruptsOn;
        end;

      end;    {ReadCom}

    function ComReady: boolean;
    {returns true if character ready;  false if no character waiting }

    begin

      with Async do begin
        if Head = Tail then ComReady := false
        else ComReady := true;
        end;

      end;    {ComReady}

    procedure WriteCom( C: char );
    {Send a character}

    var
      WaitCount: word;

    begin

      with Async do begin
        Port[UART_MCR + Base] := $0B;  {Turn on OUT2, DTR, and RTS}
        WaitCount := $FFFF;
        while (WaitCount <> 0) and ((Port[UART_MSR + Base] and $10) = 0) do
          dec(WaitCount);   {Wait for CTS (clear to send)}
        if WaitCount <> 0 then WaitCount := $FFFF;
        while (WaitCount <> 0) and ((Port[UART_LSR + Base] and $20) = 0) do
          dec(WaitCount);   {Wait for THRE  (transmit hold register empty)}
        if WaitCount <> 0 then begin
          InterruptsOff;
          Port[UART_THR + Base] := ord(C);   {send the character}
          InterruptsOn;
          end;
        end;

      end;   {WriteCom}

    procedure WriteComStr( S: string );
    {Writes a string, S, by repeatedly calling WriteCom}

    begin

      while length(S) > 0 do begin
        WriteCom( S[1] );
        S := copy( S, 2, 255 );     {throw away first character}
        end;

      end;

    procedure CloseCom;

    var
      IRQ:  byte;

    begin

      if Async.PortNum <> $FFFF then begin
        IRQ := Hi(Async.Base) + 1;
        InterruptsOff;
        Port[I8088_IMR] := Port[I8088_IMR] or (1 shl IRQ); {Turn off int reqs}
        Port[UART_IER + Async.Base] := 0;  {Disable 8250 Data ready interrupt}
        Port[UART_MCR + Async.Base] := 0;   {Disable OUT2 on 8250}
        InterruptsOn;
        end;

      end;   {CloseCom}

    {$F+} procedure ExitCom; {$F-}

    begin

      ExitProc := SaveExitProc;
      CloseCom;

      end;
    begin

      with Async do begin
        Overflow := false;
        PortNum := $FFFF;
        Max := AsyncBufMax;
        Head := 0;
        Tail := 0;
        end;
      SaveExitProc := ExitProc;
      ExitProc := @ExitCom;

    end.

[Back to COMM SWAG index] [Back to Main SWAG index] [Original]