Programmer 7500/MAX_PROGRAMMERS.iso/INFO/TURBOPAS/ASYNCH.ZIP/ASYNCH.PAS

Pascal/Delphi Source File | 1988-02-11 | 11.6 KB | 379 lines

{$R+}    {Range checking off}
{$B-}    {Boolean short circuiting off}
{$S-}    {Stack checking on}
{$I-}    {I/O checking on}
{$N-}    {No numeric coprocessor}

(**********************************************************************)
(*                                                                    *)
(*    Unit for communications for the IBM PC and compatibles          *)
(*                                                                    *)
(*                 Version 1.0      February 2, 1988                  *)
(*                                                                    *)
(*    This unit supports only Com 1 and 2 at this time and has not    *)
(*    been fully ported over to Turbo 4.0.  If you make improvements  *)
(*    on this code, please send me a message or a copy of the fix     *)
(*    to the below address:                                           *)
(*                                                                    *)
(*                  Dale Barnes                                       *)
(*                  127 Post Oak Place                                *)
(*                  Shalimar, FL  32579                               *)
(*                  [phone]                                    *)
(*                  CIS 76530,1441                                    *)
(*                                                                    *)
(**********************************************************************)

Unit Asynch;

Interface

Uses
  Dos,
  Crt;


CONST
  BuffSize = 4096;
  Cr       = #13;
  Lf       = #10;

TYPE
  Buffer_Type = 0..BuffSize;
  ComType     = (Com1, Com2);
  ByteChar = RECORD CASE Boolean OF
               True  : (O : Byte);
               False : (C : Char)
             END;

VAR
  C              : Char;
  Local          : Boolean;
  Prt            : Boolean;
  Comp           : Comtype;
  Head, Tail     : Buffer_Type;
  CPort          : Byte;
  Tbyte          : Byte;
  LByte          : Byte;
  EightBits      : Byte;
  IntBuffer      : ARRAY[0..BuffSize] OF ByteChar;
  ModemWait      : integer;


PROCEDURE IntHandler;                            (* Comm interrupt handler *)

PROCEDURE SetRate(R : Integer);                           (* set baud rate *)

PROCEDURE Clear_Buffer;                        (* empties the buffer queue *)

PROCEDURE IntOn(Com : ComType);    (* turns on interrupts -- handles int24 *)

PROCEDURE IntOff;                (* turns interrupts off -- handles int 24 *)

FUNCTION ReadCom : Char; (* reads [if one is avaiable] a char from the modem *)

PROCEDURE Drop;

PROCEDURE On_Hook(On : boolean);

PROCEDURE Raise;

PROCEDURE Drop_DTR;

PROCEDURE WriteCom(Ch : Char; screen : Boolean);      (* write Ch to modem *)

FUNCTION ModemInput : Boolean; (* returns true is a character is available *)

FUNCTION Online : Boolean;       (* returns true if caller or sysop online *)

FUNCTION Ringing : Boolean;            (* returns true if phone is ringing *)

PROCEDURE Determine_Bits;                    (* determines the parity bits *)

PROCEDURE SendString(Txt : String; Crs : Integer); (* sends a string with CRS *)

PROCEDURE Send(Txt : String);     (* sends a string with NO screen echo *)

PROCEDURE Check_Ring;                    (* if modem is ringing, sends ATA *)


{===========================================================================}

Implementation

(*-------------------------------------------------------------------*)
(*                    Low Level Asynch Routines                      *)
(*-------------------------------------------------------------------*)


Const

  Com1Base  = $03F8;
  Com2Base  = $02F8;
  Irq4      = $30;
  Irq3      = $2C;
  LineCtrl  = 3;
  LineStat  = 5;
  IntenReg  = 1;
  ModemStat = 6;
  ModemCtrl = 4;


Var

Regs     : Registers;
ComPort  : Integer;

MSR        : Integer;
LSR        : Integer;
LCR        : Integer;
MCR        : Integer;
OldVecSeg  : Integer;
OldVecOff  : Integer;
CdMask     : Integer;

procedure CommIntOn; inline($FB);
procedure CommIntOff; inline($FA);

PROCEDURE IntHandler;                            (* Comm interrupt handler *)
BEGIN
    INLINE
     ($50/                                           {   PUSH    AX           }
      $53/                                           {   PUSH    BX           }
      $51/                                           {   PUSH    CX           }
      $52/                                           {   PUSH    DX           }
      $57/                                           {   PUSH    DI           }
      $56/                                           {   PUSH    SI           }
      $06/                                           {   PUSH    ES           }
      $1E/                                           {   PUSH    DS           }
      $2E/$A1/$A0/$00/                               {   MOV     AX,CS:[00A0] }
      $50/                                           {   PUSH    AX           }
      $1F);                                          {   POP     DS           }
    TByte := Port[Comport];
    LByte := Port[LSR];
    Head := (Head+1) MOD BuffSize;
    IntBuffer[head].O := Tbyte;
    Port[$20] := $20;
    INLINE
     ($1F/                                           {   POP     DS           }
      $07/                                           {   POP     ES           }
      $5E/                                           {   POP     SI           }
      $5F/                                           {   POP     DI           }
      $5A/                                           {   POP     DX           }
      $59/                                           {   POP     CX           }
      $5B/                                           {   POP     BX           }
      $58/                                           {   POP     AX           }
      $5D/                                           {   POP     BP           }
      $89/$EC/                                       {   MOV     SP,BP        }
      $5D/                                           {   POP     BP           }
      $CF);                                          {   IRET                 }
  END;

PROCEDURE IntOn(Com : ComType);    (* turns on interrupts -- handles int24 *)
VAR TByte : Byte;                  (* i.e. IntOn(Com1) or IntOn(Com2);     *)
BEGIN
  CommIntOff;
  Head := 0;
  Tail := 0;
  CASE Com OF
    Com1 : ComPort := Com1Base;
    Com2 : Comport := Com2Base;
  END;
  MCR := ComPort+ModemCtrl;
  MSR := ComPort+ModemStat;
  LCR := ComPort+LineCtrl;
  LSR := ComPort+LineStat;
  TByte := Port[LSR];
  Port[LCR] := 3;
  Port[MCR] := 11;
  Port[Comport+IntenReg] := 1;
  TByte := Port[$21];
  Regs.Ax := $2500;
  Regs.DS := CSeg;
  Regs.DX := Ofs(IntHandler);
  CASE Com OF
    Com1 : BEGIN
             OldVecOff := MemW[0000 : Irq4];
             OldVecSeg := MemW[0000 : Irq4+2];
             Regs.AX   := Regs.AX+12;
             Intr($21, Regs);
             Port[$21] := TByte AND $EF;
           END;
    Com2 : BEGIN
             OldVecOff := MemW[0000 : Irq3];
             OldVecSeg := MemW[0000 : Irq3+2];
             Regs.AX := Regs.AX+11;
             Intr($21, Regs);
             Port[$21] := TByte AND $F7;
           END;
  END;
   CommIntOn;
END;


PROCEDURE IntOff;                (* turns interrupts off -- handles int 24 *)
VAR Tbyte : Byte;
  BEGIN
    TByte := Port[$21];
    Port[Comport+IntEnReg] := 0;
    IF Comport = $3F8 THEN
      BEGIN
        Port[$21] := TByte OR 16;
        MemW[0000:Irq4]   := OldVecOff;
        MemW[0000:Irq4+2] := OldVecSeg;
    END ELSE
      BEGIN
        MemW[0000:Irq3]   := OldVecOff;
        MemW[0000:Irq3+2] := OldVecSeg;
        Port[$21] := TByte OR 8;
      END;
  END;

PROCEDURE SetRate(R : Integer);                           (* set baud rate *)
VAR TdlMsb, TdlLsb : Byte;
BEGIN
  CommIntOff;
  TdlMsb := 0;
  CASE R OF
    300 : BEGIN                                                 { 300  Baud }
            TdlMsb := 1;
            TdlLsb := $80;
          END;
    1200 : TdlLsb := $60;                                      {  1200 Baud }
    2400 : TdlLsb := $30;                                      {  2400 Baud }
    4800 : TdlLsb := $18;                                      {  4800 Baud }
    7200 : TdlLsb := $10;                                      {  7200 Baud }
    9600 : TdlLsb := $0C;                                      {  9600 Baud }
   19200 : TdlLsb := $06;                                      { 19200 Baud }
  END;
   Port[LCR] := $80;
   Port[ComPort] := TdlLsb;
   Port[ComPort+1] := TdlMsb;
   Port[LCR] := 3;
   CommIntOn;
END;


PROCEDURE Clear_Buffer;                        (* empties the buffer queue *)
BEGIN
  CommIntOff;                                                        { CLI }
  Head := 0;
  Tail := 0;
  CommIntOn;                                                          { STI }
END;




PROCEDURE WriteCom(Ch : Char; screen : Boolean);      (* write Ch to modem *)
VAR X : Integer;                           (* screen determines if written *)
  BEGIN                                                 (* to screen as well *)
    REPEAT UNTIL Odd(Port[LSR] SHR 5);
    Port[ComPort] := Ord(Ch);
    IF screen THEN Write(Ch);
  END;


FUNCTION ModemInput : Boolean; (* returns true is a character is available *)
BEGIN
    ModemInput := (Head <> Tail);
  END;


FUNCTION ReadCom : Char; (* reads [if one is avaiable] a char from the modem *)
BEGIN
    CommIntOff;
    IF (Head <> Tail) THEN
      BEGIN
        Tail := (Tail+1) MOD BuffSize;
        ReadCom := IntBuffer[Tail].C;
      END;
    CommIntOn;
  END;

FUNCTION Online : Boolean;       (* returns true if caller or sysop online *)
BEGIN
  Online := (Port[MSR] AND CdMask = CDMask) OR Local;
END;


FUNCTION Ringing : Boolean;            (* returns true if phone is ringing *)
BEGIN
  Ringing := Port[MSR] AND 64 = 64;
END;


PROCEDURE Drop;
BEGIN
  Port[MCR] := (Port[MCR] AND 254);
  Delay(1000);
END;


PROCEDURE On_Hook;
BEGIN                                       { Simple procedure to place the }
  IF On THEN
  Send('ATM0H1') ELSE
    Send('ATH0');
  Delay(600);                                           { Modem On/Off Hook }
END;


PROCEDURE Raise;
BEGIN
  Port[MCR] := (Port[MCR] OR 1);
END;

PROCEDURE Drop_DTR;
BEGIN
  Drop;
  Raise;
  Local := False;
END;

PROCEDURE Determine_Bits;                    (* determines the parity bits *)
BEGIN
  EightBits := 0;
  C := Chr(Ord(ReadCom));
  IF (C = #13) THEN EightBits := 1;
  IF (C = #141) THEN EightBits := 2;
  C := Chr(Ord(C) AND $7F);
END;


PROCEDURE SendString(Txt : String; Crs : Integer); (* sends a string with CRS *)
VAR I : Integer;                                   (* carriage returns after *)
BEGIN
  FOR I := 1 TO Crs DO Txt := Txt+#13+#10;
   IF Local AND prt THEN Write(Txt);
    IF NOT Local THEN
      IF Online THEN FOR I := 1 TO Length(Txt) DO WriteCom(Txt[I], prt);
END;


PROCEDURE Send(Txt : String);     (* sends a string with NO screen echo *)
VAR I : Integer;
BEGIN
  Txt := Txt+Cr+Lf;
  FOR I := 1 TO Length(Txt) DO WriteCom(Txt[I], False);
END;


PROCEDURE Check_Ring;                    (* if modem is ringing, sends ATA *)
VAR T : Integer;
  BEGIN
    IF Ringing THEN
      BEGIN
        Delay(800);
        Send('ATA');
        WriteLn('■ Ring Detected - Answering Phone');
        T := 0;
        WHILE NOT Online AND (T < ModemWait) DO
          BEGIN
            Delay(1000);
            T := T+1;
          END;
      END;
  END;

End.