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

    {Here's a unit for sending and receiving async commands }

    { ======================= SERIAL COMMUNICATIONS ============================ }

    UNIT      Async;

    {$D-,V-,B-,S-,R-}

    INTERFACE

    USES      Dos, Crt;

    TYPE

      BAUD              = (B110,B150,B300,B600,B1200,B2400,B4800,B9600);
      PARITY            = (PNONE, PODD, PNOTHING, PEVEN);

    VAR
      AsyncInstalled    : BOOLEAN;
      AsyncActive       : BOOLEAN;

    PROCEDURE InitAsync(Com       :BYTE;
                        Speed     :BAUD;
                        Par       :PARITY;
                        Stop      :BYTE;
                        Dbits     :BYTE);
    PROCEDURE TermAsync;
    FUNCTION  CheckAsync          :WORD;
    PROCEDURE HangUp;
    PROCEDURE Send(Buffer         :STRING);
    PROCEDURE Receive(VAR Buffer  :STRING);

    IMPLEMENTATION

    CONST

      THR               = 0;
      RBR               = 0;
      IER               = 1;
      IIR               = 2;
      LCR               = 3;
      MCR               = 4;
      LSR               = 5;
      MSR               = 6;
      BUFFSIZE          = 255;
      TIMOUT            = 60000;
      EOI               : BYTE = $20;
      IRQ4low           : BYTE = $EF;
      IRQ4high          : BYTE = $10;
      IRQ3low           : BYTE = $F7;
      IRQ3high          : BYTE = $08;
      ErrorMask         : BYTE = $0E;
      DSRready          : BYTE = $20;
      OUT2              : BYTE = $08;
      DTR               : BYTE = $01;
      RTS               : BYTE = $02;

    VAR

      Regs              : REGISTERS;
      OldVector         : POINTER;
      AsyncStatus       : WORD;
      IntType           : BYTE;
      AsyncDisable      : BYTE;
      AsyncEnable       : BYTE;
      AsyncBuff         : ARRAY [0..BUFFSIZE] OF BYTE;
      Front             : INTEGER;
      Rear              : INTEGER;
      ComPort           : BYTE;
      ComBase           : WORD;

    {//////////////////////////////////////////////////////////////////////////}

    PROCEDURE ZeroDlab;

    { -- zero divisor latch access bit allowing access to THR, RBR and IER }

    BEGIN
              PORT[ComBase+LCR]:= PORT[ComBase+LCR] AND $7F;
    END;

    {//////////////////////////////////////////////////////////////////////////}

    PROCEDURE SetDTR;

    { -- enable interrupts and set DTR }

    BEGIN
      PORT[ComBase+MCR]:= OUT2 + DTR + RTS;
      DELAY(1000)
    END;

    {//////////////////////////////////////////////////////////////////////////}

    PROCEDURE ReadPorts;

    { -- read UART values }

    VAR
      Temp              : BYTE;

    BEGIN
      Temp:= PORT[ComBase];
      Temp:= PORT[ComBase+IIR];
      Temp:= PORT[ComBase+LSR];
      Temp:= PORT[ComBase+MSR];
    END;

    {//////////////////////////////////////////////////////////////////////////}

    PROCEDURE HangUp;

    { -- hang up phone }

    BEGIN
      ReadPorts;
      PORT[ComBase+MCR]:= 0;
      DELAY(1000);
    END;

    {//////////////////////////////////////////////////////////////////////////}

    FUNCTION CheckAsync;

    { -- return status MB = Line Status, LB = Modem Status }

    VAR
      LSReg             : WORD;

    BEGIN
      LSReg:= PORT[ComBase+LSR];
      CheckAsync:= (LSReg SHL 8) OR PORT[ComBase+MSR];
    END;

    {//////////////////////////////////////////////////////////////////////////}

    {$F+}

    PROCEDURE AsyncISR;

    INTERRUPT;

    { -- serial port interrupt routine }

    BEGIN
      PORT[$21]:= PORT[$21] AND AsyncDisable;
      INLINE($FB);        { enable interrupts }
      IntType:= PORT[ComBase+IIR] AND 6;
      IF IntType = 4 THEN
      BEGIN
        ZeroDlab;
        AsyncBuff[Rear]:= PORT[ComBase+RBR];
        Rear:= SUCC(Rear) MOD BUFFSIZE
      END;
      AsyncStatus:= (PORT[ComBase+LSR] SHL 8) + PORT[ComBase+MSR];
      INLINE($FA);        { disable interrupts }
      PORT[$20]:= EOI;
      PORT[$21]:= PORT[$21] AND AsyncEnable
    END;

    {$F-}

    {//////////////////////////////////////////////////////////////////////////}

    PROCEDURE InstallAsync;

    { -- replaces interrupt vector by user routine }

    BEGIN
      IF NOT(AsyncInstalled) THEN
      BEGIN
        GetIntVec($0C-ComPort,OldVector);
        SetIntVec($0C-ComPort,@AsyncISR);
        AsyncInstalled:=TRUE;
      END;
    END;

    {//////////////////////////////////////////////////////////////////////////}

    PROCEDURE DeinstallAsync;

    { -- restores interrupt vector }

    BEGIN
      IF AsyncInstalled THEN
      BEGIN
        SetIntVec($0C-ComPort,OldVector);
        AsyncInstalled:=FALSE;
      END;
    END;

    {//////////////////////////////////////////////////////////////////////////}

    PROCEDURE InitAsync(Com       : BYTE;
                        Speed     : BAUD;
                        Par       : PARITY;
                        Stop      : BYTE;
                        Dbits     : BYTE);

    { -- initialize serial port communications }

    BEGIN
      WITH Regs DO
      BEGIN
        IF NOT(AsyncActive) THEN
        BEGIN
          ComPort       := Com-1;
          MEMW[0:$400]  := $3F8;             { to prevent a BIOS bug }
          MEMW[0:$402]  := $2F8;             { to prevent a BIOS bug }
          IF ComPort    = 0 THEN
          BEGIN
            ComBase     := $3F8;
            AsyncEnable := IRQ4low;
            AsyncDisable:= IRQ4high;
          END
          ELSE
          BEGIN
            ComBase     := $2F8;
            AsyncEnable := IRQ3low;
            AsyncDisable:= IRQ3high
          END;
          Front         := 0;
          Rear          := 0;
          AsyncStatus   := 0;
          InstallAsync;
          DX            :=ComPort;
          AX            :=ORD(Speed)*32 + ORD(Par)*8 + (Stop-1)*4 + Dbits-5;
          INTR($14,Regs);
          ReadPorts;
          ZeroDlab;
          PORT[ComBase+IER]:= $05;
          INLINE($FA);                                { disable interrupts }
          PORT[$21]     :=PORT[$21] AND AsyncEnable;
          INLINE($FB);                                { enable interrupts }
          SetDTR;
          AsyncActive   := TRUE;
        END
        ELSE
        BEGIN
          HangUp;
          SetDTR;
        END;
      END;
    END;

    {//////////////////////////////////////////////////////////////////////////}

    PROCEDURE Receive;

    { -- get characters from circular buffer }

    VAR
      Ch                : CHAR;
      NbrChrs           : INTEGER;
      Count             : LONGINT;

    BEGIN
      Buffer  := '';
      Count   := TIMOUT;
      NbrChrs := 0;
      WHILE Count>0 DO
      BEGIN
        DEC(Count);
        IF Front <> Rear THEN
        BEGIN
          REPEAT
            Ch          := CHAR(AsyncBuff[Front]);
            Front       := SUCC(Front) MOD BUFFSIZE;
            IF Ch IN [#0..#31] THEN Ch:= #32;
            Buffer      := Buffer + Ch;
            INC(NbrChrs);
          UNTIL (Front = Rear) OR (NbrChrs = BUFFSIZE);
          Count:= TIMOUT;
        END;
      END;
    END;

    {//////////////////////////////////////////////////////////////////////////}

    PROCEDURE Send;

    VAR
      Ptr               : INTEGER;
      TH                : BYTE;
      CH                : CHAR;

    BEGIN
      IF LENGTH(Buffer)>0 THEN
      BEGIN
        SetDTR;
        FOR Ptr:=1 TO LENGTH(Buffer) DO
        BEGIN
          REPEAT
            TH:= PORT[ComBase+LSR] AND DSRready
          UNTIL TH<>0;
          CH:= Buffer[Ptr];
          IF (CH = '%') THEN
          BEGIN
            DELAY(1000);
            EXIT;
          END;
          IF (CH = '|') THEN CH:= #13;
          IF (CH = '~') THEN
            DELAY(2000)
          ELSE
            PORT[ComBase+THR]:= BYTE(CH);
        END;
        DELAY(1000);
      END;
    END;

    {//////////////////////////////////////////////////////////////////////////}

    PROCEDURE TermAsync;

    { -- terminate communications }

    BEGIN
      IF AsyncActive THEN
      BEGIN
        HangUp;
        INLINE($FA);                        { disable interrupts }
        PORT[$21]       := PORT[$21] OR (IRQ4high + IRQ3high);
        INLINE($FB);                        { enable interrupts }
        ZeroDlab;
        PORT[ComBase+IER]:= 0;
        DELAY(1000);
        DeinstallAsync;
        AsyncActive     := FALSE;
      END;
    END;

    {//////////////////////////////////////////////////////////////////////////}

    BEGIN
      AsyncInstalled    := FALSE;
      AsyncActive       := FALSE;
    END.

    It's a old unit from tp4 but it works well for me. I think it will not
    support the fifo buffers and the specials of the 16550 uart because
    they wern't available at that time but maybe somebody can modify it

    Greetings from:
                         Niko van Hagen
                         Monday, 25 March 1996, 10:19.
                         The Haghe, Holland
                         Fido       : 2:281/909.11
                         Internet   : nvhagen@worldonline.nl
                         PGP KEYID  : 6CF49689

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