Columbia Kermit/kermit.zip/pub/tpdoskermit/async.pas

Pascal/Delphi Source File | 2020-01-01 | 13.3 KB | 505 lines

$R-,S-,I-,D+,T+,F-,V+,B-,N-,L+
UNIT ASYNC;

INTERFACE

Uses Delays;

(**************************** ASYNC.PAS *********************************)
(*                                                                      *)
(*     Modul for bruk av 1,2,3 el. 4 COM-porter samtidig, med interrupt *)
(*     bde ved sending og mottak og uavhengige ring-buffere opptil     *)
(*     64k for hver retning og port.                                    *)
(*                                                                      *)
(*     Oslo, November 1987 Terje Mathisen, Norsk Hydro                  *)
(*                                                                      *)
(**************************** ASYNC.PRO *********************************)

CONST RX_int     = 1;
      TX_int     = 2;
      RLS_int    = 4;
      MODEM_int  = 8;
      SumOf_int  =15;
TYPE
  ComPortType = 1..4;
  ParityType = (No_Parity, Even_Parity, Odd_Parity, Zero_Parity, One_Parity);

  RS_IntSet = 0..SumOf_int;
  RS_BufPtrType  = ^RS_BufferType;
  RS_BufferType = RECORD
              ICadr, IntNr     : WORD;

              oldModemContrReg : BYTE;
              oldLevel  : BYTE;
              oldVector : Pointer;

              xin : Pointer;
              xout, SizeX, LimitX    : WORD;

              Tin : WORD;
              Tout : Pointer;
              SizeT, SendFirst : WORD;

              ShowXoffPtr : Pointer;
              Toggle_Xoff, RLS_user, MODEM_user : Pointer;

              Ctrl_P    : BYTE;  {0 - > default, 1..4 -> NOTIS}

              UseTint, HostXoff : BOOLEAN;
              Bufferfilled : BYTE;

              AutoXoff, AltXoff : BOOLEAN;
              Xoff1C, Xoff2C, Xon1C, Xon2C     : CHAR;

              Line_Status, MODEM_status : BYTE;
              WaitTX : BOOLEAN;
              Int_Mask : BYTE;
              oldIntEnableReg : BYTE;
            END;

VAR
  RS_BufPtr : ARRAY [ComPortType] OF RS_BufPtrType;
  RS_TimeOut : WORD;

  RS_Buffer : ARRAY [ComPortType] OF RS_BufferType; { Must be in data-seg! }

  PROCEDURE RS_MakeBuffer(Rsize,Tsize,IOaddr,SWint:WORD; com : WORD);

  PROCEDURE RS_Init (baudRate : LongInt;
                  NbrOfBits,           { 5|6|7|8 }
                  StopBits: WORD;      { 1|2 }
                  Parity: ParityType;
            { (No_Parity, Even_Parity, Odd_Parity, Zero_Parity, One_Parity) }
                  VAR result: BOOLEAN;
                  com: ComPortType); { 1..4 }

  PROCEDURE RS_Stop(com: ComPortType);

  PROCEDURE RS_Start(rs_int: RS_IntSet; com: ComPortType);

  PROCEDURE RS_BusyRead(VAR ch:CHAR;VAR done : BOOLEAN; com : WORD);

  PROCEDURE RS_ReadBlock(VAR buf;max:WORD;VAR bytes:WORD;com : WORD);

  PROCEDURE RS_Write(ch: CHAR;VAR done : BOOLEAN; com: WORD );

  PROCEDURE RS_WriteBlock(VAR buf;len: WORD;VAR bytes:WORD; com: WORD);

  FUNCTION RS_GetChar(VAR ch : CHAR; com : WORD): BOOLEAN;

  FUNCTION RS_Avail(com : WORD): WORD;

  FUNCTION RS_Room(com : WORD): WORD;

  PROCEDURE RS_Enable(com : WORD);

  PROCEDURE RS_WriteFirst(ch:CHAR;com:WORD);

  PROCEDURE RS_ClrBuffer(com: WORD);

  PROCEDURE RS_Set_TX_Int(rs_int : RS_IntSet; com : WORD);

  FUNCTION RS_Empty(com : WORD) : BOOLEAN;

  PROCEDURE RS_Break(ms : WORD;com : WORD);

  PROCEDURE RS_StopLink(com : WORD);

  PROCEDURE RS_StartLink(com : WORD);

  PROCEDURE RS_StopAll;

IMPLEMENTATION

CONST
  LineContrReg    = 3; { to specify format of transmitted data }
  LowBaudRateDiv  = 0; { lower byte of divisor to select baud rate }
  HighBaudRateDiv = 1; { higher byte of divisor }
  LineStatusReg   = 5; { holds status info on the data transfer }
  ReceiverReg     = 0; { received CHAR is in this register }
  TransmitReg     = 0; { CHAR to send is put in this reg }
  IntEnableReg    = 1; { to enable the selected interrupt }
  IntIdentReg     = 2;
  ModemContrReg   = 4; { controls the interface to a modem }

    PROCEDURE GetAlignMem(VAR p : Pointer; size : WORD);
    VAR temp : ^BYTE;
    BEGIN
      REPEAT
        GetMem(p,size);
        IF Ofs(p^) = 0 THEN Exit;
        FreeMem(p,size);
        New(temp);
      UNTIL FALSE;
    END;

  PROCEDURE RS_MakeBuffer(Rsize, Tsize, IOaddr, SWint, com: WORD);
  CONST PortTab : ARRAY [ComPortType] OF WORD = ($3F8,$2F8,$3E8,$2E8);
        IntTab  : ARRAY [ComPortType] OF BYTE = (12,11,12,11);
  VAR c, c0, c1 : WORD;
  BEGIN
    IF Rsize + Tsize > MemAvail - $100 THEN BEGIN
      Halt(1);
    END;
    IF com = 0 THEN BEGIN
      c0 := 1; c1 := 4;
    END
    ELSE BEGIN
      IF com > 4 THEN Halt(1);
      c0 := com; c1 := com;
    END;
    FOR c := c0 TO c1 DO WITH RS_Buffer[c] DO BEGIN
      IF (com = 0) AND (c > 1) THEN
        RS_Buffer[c] := RS_Buffer[1]
      ELSE BEGIN
        IF Rsize > 0 THEN BEGIN
          GetAlignMem(xin,Rsize);
          SizeX := Rsize;
          LimitX := Rsize DIV 8;
        END;

        IF Tsize > 0 THEN BEGIN
          GetAlignMem(Tout,Tsize);
          SizeT := Tsize;
        END;
      END;

      IF IOaddr = 0 THEN
        ICadr := PortTab[c]
      ELSE
        ICadr := IOaddr;

      IF SWint = 0 THEN
        IntNr := IntTab[c]
      ELSE
        IntNr := SWint;

{                       Disse variablene er nullstilt allerede!
      xin := 0;
      xout := 0;
      SendFirst := 0;
      tin := 0;
      tout := 0;
      Ctrl_P := 0;
      UseTint := FALSE;
      Sending := FALSE;
      Receiving := FALSE;
      HostXoff := FALSE;
      BufferFilled := 0;
      AltXoff  := FALSE;
      ShowXoffPtr := NIL;
      Toggle_Xoff := 0;
      RLS_user := 0;
      MODEM_user := 0;
}
                                       {Default to use XON/XOFF!}
      AutoXoff := TRUE;
      Xoff1C   := ^S;
      Xon1C    := ^Q;
    END;
  END;

  PROCEDURE RS_Init (baudRate  : LongInt;
                  NbrOfBits,           { 5|6|7|8 }
                  StopBits: WORD;      { 1|2 }
                  Parity: ParityType;
            { (No_Parity, Even_Parity, Odd_Parity, Zero_Parity, One_Parity) }
                  VAR result: BOOLEAN;
                  com: ComPortType); { 1..4 }
  CONST ParityTab : ARRAY [ParityType] OF BYTE = (0,$18,$08,$38,$28);
    VAR divisor : WORD;
        parameters: BYTE;

  BEGIN (* Init *)
    result := FALSE;

    WITH RS_Buffer[com] DO BEGIN
      IF Xin = NIL THEN BEGIN          {No buffer allocated!}
        Halt(1);
      END;

    (* load the divisor of the baud rate generator: *)
      IF baudrate < 1 THEN Exit;
      divisor := (115200 + (baudrate DIV 2)) DIV baudrate;
      Port[ICadr+LineContrReg] := $80;
      Port[ICadr+HighBaudRateDiv] := Hi(divisor);
      Port[ICadr+LowBaudRateDiv]  := Lo(divisor);

        (* prepare the parameters: *)
      parameters := ParityTab[Parity];

      IF stopBits = 2 THEN
        parameters := parameters + 4
      ELSE IF stopBits <> 1 THEN Exit;

      IF (nbrOfBits < 5) OR (nbrOfBits > 8) THEN Exit;
      Port[ICadr+LineContrReg] := parameters + (nbrOfBits - 5);

        (* Disable Interrupts: *)
      Port[ICadr+IntEnableReg] := 0;
      result := TRUE;
    END;
  END                                  { Init };

    CONST
      I8259ContrWord1 = $21;  (* Interrupt controller,
                                 Operation Control Word 1 *)

(************************* ASSEMBLER ROUTINES FOR MAX SPEED ****************)

    PROCEDURE RS_Com1Int;                            EXTERNAL;

    PROCEDURE RS_Com2Int;                            EXTERNAL;

    PROCEDURE RS_Com3Int;                            EXTERNAL;

    PROCEDURE RS_Com4Int;                            EXTERNAL;

    PROCEDURE RS_BusyRead(VAR ch:CHAR;VAR done : BOOLEAN;
              com : WORD);                    EXTERNAL;

    PROCEDURE RS_ReadBlock(VAR buf;max:WORD;
              VAR bytes : WORD;com : WORD);EXTERNAL;

    PROCEDURE RS_Write(ch: CHAR;VAR done : BOOLEAN;
              com: WORD );                    EXTERNAL;

    PROCEDURE RS_WriteBlock(VAR buf;len: WORD;
              VAR bytes : WORD; com: WORD);EXTERNAL;

    FUNCTION RS_GetChar(VAR ch : CHAR;
             com : WORD): BOOLEAN;            EXTERNAL;

    FUNCTION RS_Avail(com : WORD): WORD;   EXTERNAL;

    FUNCTION RS_Room(com : WORD): WORD;    EXTERNAL;

    PROCEDURE RS_Enable(com : WORD);          EXTERNAL;

    PROCEDURE RS_WriteFirst(ch:CHAR;com:WORD);EXTERNAL;

  {$L ASYNC.OBJ}

(***************************************************************************)

VAR vect_tab : ARRAY [0..255] OF Pointer ABSOLUTE 0:0;

PROCEDURE Disable; Inline($FA);

PROCEDURE Enable; Inline($FB);

PROCEDURE GetVector(vnr : WORD; VAR vector : Pointer);
BEGIN
  vector := vect_tab[vnr];
END;                                   {GetVector}

PROCEDURE SetVector(vnr : WORD; vector : Pointer);
BEGIN
  Disable;
    vect_tab[vnr] := vector;
  Enable;
END;                                   {PutVector}

PROCEDURE RS_Start(rs_int : RS_IntSet; com: ComPortType);
VAR
  adr : Pointer;
  mask, tempSet : BYTE;
  dummy : WORD;
  ch : CHAR;
  ok : BOOLEAN;
BEGIN
  WITH RS_Buffer[com] DO
    IF OldVector = NIL THEN BEGIN

      (* enable interrupts in the interrupt controller (8259): *)
      tempSet := Port[I8259ContrWord1];
      (* set the interrupt vector *)

      GetVector(IntNr,OldVector);
      CASE com OF
        1 : adr := @RS_Com1int;
        2 : adr := @RS_Com2int;
        3 : adr := @RS_Com3int;
        4 : adr := @RS_Com4int;
      END;
      SetVector(IntNr,adr);

      mask := 1 Shl (IntNr - 8);
      oldLevel := tempSet AND mask;

      DISABLE;
      Port[I8259ContrWord1] := tempSet AND NOT mask;

      dummy  :=  Port[ICadr+IntIdentReg] +
                 Port[ICadr+LineStatusReg] +
                 Port[ICadr+ModemContrReg] +
                 Port[ICadr+ReceiverReg];    (* clear the controller *)

      WORD(xin)    := 0;
      xout         := 0;

      SendFirst    := 0;
      tin          := 0;
      WORD(tout)   := 0;

      HostXoff     := FALSE;
      WaitTX       := FALSE;
      AutoXoff     := TRUE;
      BufferFilled := 0;
      Line_Status  := 0;
      MODEM_Status := 0;

      tempSet := Port[ICadr+ModemContrReg];
      oldModemContrReg := tempSet AND 11;    { DTR and RTS }

      Port[ICadr+ModemContrReg] := tempSet OR 11;

      Int_Mask := rs_int;
      oldIntEnableReg := Port[ICadr+IntEnableReg];
      Port[ICadr+IntEnableReg] := rs_int;
      UseTint := (TX_int AND rs_int) <> 0;

      ENABLE;

    END;
    dummy := 50;
    REPEAT
      RS_BusyRead(ch,ok,com);               { Remove pending int's }
      Dec(dummy);
    UNTIL NOT ok OR (dummy = 0);
END                                {RS_Start};

PROCEDURE RS_Stop(com: ComPortType);
BEGIN
  WITH RS_Buffer[com] DO
    IF OldVector <> NIL THEN BEGIN
      DISABLE;

    (* restore old mask in 8259: *)
      Port[I8259ContrWord1] := Port[I8259ContrWord1] OR oldLevel;

    (* disable interrupts in 8250: *)
      Port[ICadr+IntEnableReg] := oldIntEnableReg;
    (* restore modem control register in 8250: *)
      Port[ICadr+ModemContrReg] :=
         (Port[ICadr+ModemContrReg] AND 244) OR oldModemContrReg;
      ENABLE;

    (* restore the old interrupt vector *)
      SetVector(IntNr,OldVector);
      OldVector := NIL;
    END;
END                                {RS_Stop};
(*
PROCEDURE RS_Read(VAR ch: CHAR;com: WORD );
VAR done : BOOLEAN;
BEGIN
  REPEAT
    RS_BusyRead (ch, done, com);
  UNTIL done;
END                                {RS_Read};
*)
PROCEDURE RS_ClrBuffer(com: WORD);
BEGIN
  WITH RS_Buffer[com] DO BEGIN
    Disable;
    WORD(xin) := 0;
    xout := 0;
    tin := 0;
    WORD(tout) := 0;
    SendFirst := 0;
    Enable;
  END;
END;                               {ClrBuffer}

PROCEDURE RS_Set_TX_Int(rs_int : RS_IntSet; com : WORD);
BEGIN
  WITH RS_Buffer[com] DO BEGIN
    Disable;
    tin := 0;
    WORD(tout) := 0;
    SendFirst := 0;
    Int_Mask := rs_int;
    Port[ICadr+IntEnableReg] := rs_int;
    UseTint := (TX_int AND rs_int) <> 0;
    Enable;
  END;
END;                               {RS_Set_TX_Int}

FUNCTION RS_Empty(com : WORD) : BOOLEAN;
VAR ch : CHAR;
    ok : BOOLEAN;
BEGIN
  WITH RS_Buffer[com] DO
    RS_Empty := WORD(xin) = xout;
END;                                 {EmptyBuffer}

PROCEDURE RS_Break(ms : WORD;com : WORD);
VAR oldreg : BYTE;
BEGIN
  WITH RS_Buffer[com] DO BEGIN
    WaitTX := TRUE;
    WHILE Port[ICadr+LineStatusReg] AND 32 = 0 DO ; { wait for no traffic }
    oldreg := Port[ICadr+LineContrReg];
    Port[ICadr+LineContrReg]:= oldreg OR 64;
    Delay(ms);
    Port[ICadr+LineContrReg] := OldReg;
    Delay(250);
    WaitTX := FALSE;
    IF NOT HostXoff THEN RS_Enable(com);
  END;
END;                                 {RS_Break}

PROCEDURE RS_StopLink(com : WORD);
VAR bf : BYTE;
BEGIN
  WITH RS_Buffer[com] DO
    IF AutoXoff THEN BEGIN
      Disable;
      bf := BufferFilled;
      BufferFilled := BufferFilled OR 2;
      Enable;
      IF bf = 0 THEN BEGIN
        RS_WriteFirst(Xoff1C,com);
        Delay(10);
      END;
    END;
END;

PROCEDURE RS_StartLink(com : WORD);
VAR bf : BYTE;
BEGIN
  WITH RS_Buffer[com] DO
    IF AutoXoff THEN BEGIN
      Disable;
      BufferFilled := BufferFilled AND 253;
      bf := BufferFilled;
      Enable;
      IF bf = 0 THEN BEGIN
        RS_WriteFirst(Xon1C,com);
      END;
    END;
END;

VAR SaveExit : Pointer;

PROCEDURE RS_StopAll;
BEGIN
  RS_Stop(1);
  RS_Stop(2);
  RS_Stop(3);
  RS_Stop(4);
  ExitProc := SaveExit;
END;

BEGIN
  FillChar(RS_Buffer,SizeOf(RS_Buffer),#0);
  RS_BufPtr[1] := Addr(RS_Buffer[1]);
  RS_BufPtr[2] := Addr(RS_Buffer[2]);
  RS_BufPtr[3] := Addr(RS_Buffer[3]);
  RS_BufPtr[4] := Addr(RS_Buffer[4]);
  RS_TimeOut := 0;
  SaveExit := ExitProc;
  ExitProc := @RS_StopAll;
END.