ProfitPress Mega CDROM2 …eeware (MSDOS)(1992)(Eng)/ProfitPress-MegaCDROM2.B6I/PROG/PASCAL/MISCTI10.ZIP/TI226.ASC

Text File | 1988-04-18 | 20.8 KB | 628 lines

PRODUCT : TURBO PASCAL     NUMBER : 226
VERSION : 3.0xx
     OS : PC-DOS
   DATE : August 1, 1986

  TITLE : ASYNCHRONOUS COMMUNICATIONS

This  version  of Michael Quinlan's ASYNC.INC is compatible  with
IBM  PC  and  Compatibles.  It  gives  interrupt-driven  buffered
communication  capabilities to Turbo programs written for the IBM
PC.  It is heavily dependent on that hardware.

**NOTE:   Pages  12 through 15 contain an additional routine that
allows your program to change the communications parameters.

The  following example routines are public domain  programs  that
have  been uploaded to our Forum on CompuServe.  As a courtesy to
our  users  that  do not have  immediate  access  to  CompuServe,
Technical Support distributes these routines free of charge.

However,  because these routines are public domain programs,  not
developed by Borland International,  we are unable to provide any
technical support or assistance using these routines. If you need
assistance   using   these   routines,    or   are   experiencing
difficulties,  we  recommend  that you log  onto  CompuServe  and
request  assistance  from the Forum members that developed  these
routines.


{--------------------------------------------------------------}
{                        ASYNC.INC                             }
{                                                              }
{  Async Communication Routines                                }
{  by Michael Quinlan                                          }
{  with a bug fixed by Scott Herr                              }
{  made PCjr-compatible by W. M. Miller                        }
{  Highly dependent on the IBM PC and PC DOS 2.0               }
{                                                              }
{  based on the DUMBTERM program by CJ Dunford                 }
{  in the January 1984                                         }
{  issue of PC Tech Journal.                                   }
{                                                              }
{  Entry points:                                               }
{    Async_Init                                                }
{      Performs initialization.                                }
{                                                              }
{    Async_Open(Port, Baud : Integer;                          }
{               Parity : Char;                                 }
{               WordSize, StpBits : Integer) : Boolean         }
{   Sets up interrupt vector, initialize the COM port for      }
{   processing, sets pointers to the buffer.  Returns FALSE    }

{      port not installed.                                     }
{                                                              }
{    Async_Buffer_Check(var C : Char) : Boolean                }
{      If a character is available, returns TRUE and moves the }
{        character from the buffer to the parameter            }
{      Otherwise, returns FALSE                                }
{                                                              }
{    Async_Send(C : Char)                                      }
{      Transmits the character.                                }

{    Async_Send_String(S : LStr)                               }
{      Calls Async_Send to send each character of S.           }
{    Async_Close                                               }
{    Turn off the COM port interrupts.                         }
{    **MUST** BE CALLED BEFORE EXITING                         }
{    YOUR PROGRAM; otherwise you                               }
{    will see some really strange errors and have to re-boot.  }
{--------------------------------------------------------------}

{ global declarations }

type
  LStr = String[255];  { generic string type for parameters }

const
  UART_THR = $00;
      { offset from base of UART Registers for IBM PC }
  UART_RBR = $00;
  UART_IER = $01;
  UART_IIR = $02;
  UART_LCR = $03;
  UART_MCR = $04;
  UART_LSR = $05;
  UART_MSR = $06;

  I8088_IMR = $21;
       { port address of the Interrupt Mask Register }

const
  Async_DSeg_Save : Integer = 0;
                     { Save DS reg in Code Segment
                     for interrupt routine }

const
  Async_Buffer_Max = 4095;

var
  Async_Buffer    : Array[0..Async_Buffer_Max] of char;
  Async_Open_Flag : Boolean;
  Async_Port      : Integer; { current Open port number (1 or 2)
}
  Async_Base      : Integer; { base for current open port }
  Async_Irq       : Integer; { irq for current open port }

  Async_Buffer_Overflow : Boolean;
           { True if buffer overflow has happened }
  Async_Buffer_Used     : Integer;
  Async_MaxBufferUsed   : Integer;

    { Async_Buffer is empty if Head = Tail }
  Async_Buffer_Head  : Integer;
           { Locn in Async_Buffer to put next char }
  Async_Buffer_Tail  : Integer;
           { Locn in Async_Buffer to get next char }
  Async_Buffer_NewTail : Integer;

  Async_BIOS_Port_Table : Array[1..2] of Integer absolute $40:0;
    { This table is initialized by BIOS equipment determination
    code at boot time to contain the base addresses for the
    installed async adapters.  A value of 0 means "not in-
    stalled." }

const
  Async_Num_Bauds = 8;
  Async_Baud_Table : array [1..Async_Num_Bauds] of record
                                         Baud, Bits : integer
                                      end
                   = ((Baud:110;  Bits:$00),
                      (Baud:150;  Bits:$20),
                      (Baud:300;  Bits:$40),
                      (Baud:600;  Bits:$60),
                      (Baud:1200; Bits:$80),
                      (Baud:2400; Bits:$A0),
                      (Baud:4800; Bits:$C0),
                      (Baud:9600; Bits:$E0));


procedure BIOS_RS232_Init(ComPort, ComParm : Integer);
{ Issue Interrupt $14 to initialize the UART }
{ See the IBM PC Technical Reference Manual
  for the format of ComParm }
var
  Regs : record
           ax, bx, cx, dx, bp, si, di, ds, es, flag : Integer
         end;
begin
  with Regs do
    begin
      ax := ComParm and $00FF;  { AH=0; AL=ComParm }
      dx := ComPort;
      Intr($14, Regs)
    end
end; { BIOS_RS232_Init }

procedure DOS_Set_Intrpt(v, s, o : integer);
{ call DOS to set an interrupt vector }
var
  Regs : Record
           ax, bx, cx, dx, bp, si, di, ds, es, flag : integer
         end;
begin
  with Regs do
    begin
      ax := $2500 + (v and $00FF);
      ds := s;
      dx := o;
      MsDos(Regs)
    end
end; { DOS_Set_Intrpt }

{----------------------------------------------------------}
{                                                          }
{  ASYNCISR.INC - Interrupt Service Routine                }
{                                                          }
{----------------------------------------------------------}

procedure Async_Isr;
{ Interrupt Service Routine }
{ Invoked when the UART has received a byte of data from the
  communication line }

{ re-written 9/14/84 to be entirely in machine language;
  original source left as comments }

begin

  {NOTE: on entry, Turbo Pascal has already PUSHed BP and SP }
  Inline(
      { save all registers used }
    $50/                           { PUSH AX }
    $53/                           { PUSH BX }
    $52/                           { PUSH DX }
    $1E/                           { PUSH DS }
    $FB/                           { STI }
   { set up the DS register to point to Turbo Pascal's data
segment }
    $2E/$FF/$36/Async_Dseg_Save/   { PUSH CS:Async_Dseg_Save }
    $1F/                           { POP DS }
   { get the incoming character }
   { Async_Buffer[Async_Buffer_Head]
                  := Chr(Port[UART_RBR + Async_Base]); }
    $8B/$16/Async_Base/            { MOV DX,Async_Base }
    $EC/                           { IN AL,DX }
    $8B/$1E/Async_Buffer_Head/     { MOV BX,Async_Buffer_Head }
    $88/$87/Async_Buffer/          { MOV Async_Buffer[BX],AL }
      { Async_Buffer_NewHead := Async_Buffer_Head + 1; }
    $43/                           { INC BX }
      { if Async_Buffer_NewHead > Async_Buffer_Max then
          Async_Buffer_NewHead := 0; }
    $81/$FB/Async_Buffer_Max/      { CMP BX,Async_Buffer_Max }
    $7E/$02/                       { JLE L001 }
    $33/$DB/                       { XOR BX,BX }
      { if Async_Buffer_NewHead = Async_Buffer_Tail then
          Async_Buffer_Overflow := TRUE
        else }

{L001:}
   $3B/$1E/Async_Buffer_Tail/     { CMP BX,Async_Buffer_Tail }
   $75/$08/                       { JNE L002 }
   $C6/$06/Async_Buffer_Overflow/$01/ { MOV
Async_Buffer_Overflow,1 }
   $90/                           { NOP generated by assembler
                                    for some reason }
   $EB/$16/                       { JMP SHORT L003 }
     { begin
         Async_Buffer_Head := Async_Buffer_NewHead;
         Async_Buffer_Used := Async_Buffer_Used + 1;
         if Async_Buffer_Used > Async_MaxBufferUsed then
           Async_MaxBufferUsed := Async_Buffer_Used
       end; }
{L002:}
   $89/$1E/Async_Buffer_Head/     { MOV Async_Buffer_Head,BX }
   $FF/$06/Async_Buffer_Used/     { INC Async_Buffer_Used }
   $8B/$1E/Async_Buffer_Used/     { MOV BX,Async_Buffer_Used }
   $3B/$1E/Async_MaxBufferUsed/   { CMP BX,Async_MaxBufferUsed }
   $7E/$04/                       { JLE L003 }
   $89/$1E/Async_MaxBufferUsed/   { MOV Async_MaxBufferUsed,BX }
{L003:}
     { disable interrupts }
   $FA/                           { CLI }
     { Port[$20] := $20; }  { use non-specific EOI }
   $B0/$20/                       { MOV AL,20h }
   $E6/$20/                       { OUT 20h,AL }
     { restore the registers then use IRET to return }
     { the last two POPs are required because Turbo Pascal
       PUSHes these regs before we get control.  The manual
       doesn't so it, but that is what really happens }
   $1F/                           { POP DS }
   $5A/                           { POP DX }
   $5B/                           { POP BX }
   $58/                           { POP AX }
   $5C/                           { POP SP }
   $5D/                           { POP BP }
   $CF)                           { IRET }
end; { Async_Isr }

procedure Async_Init;
{ initialize variables }
begin
  Async_DSeg_Save := DSeg;
  Async_Open_Flag := FALSE;
  Async_Buffer_Overflow := FALSE;
  Async_Buffer_Used := 0;
  Async_MaxBufferUsed := 0;
end; { Async_Init }

procedure Async_Close;
{ reset the interrupt system when UART interrupts
  no longer needed }
var
  i, m : Integer;
begin
  if Async_Open_Flag then
    begin

      { disable the IRQ on the 8259 }
      Inline($FA);         { disable interrupts }
      i := Port[I8088_IMR];
                           { get the interrupt mask register }
      m := 1 shl Async_Irq;
                           { set mask to turn off interrupt }
      Port[I8088_IMR] := i or m;

      { disable the 8250 data ready interrupt }
      Port[UART_IER + Async_Base] := 0;

      { disable OUT2 on the 8250 }
      Port[UART_MCR + Async_Base] := 0;
      Inline($FB);          { enable interrupts }

      { re-initialize our data areas so
        we know the port is closed }
      Async_Open_Flag := FALSE

    end
end; { Async_Close }

function Async_Open(ComPort       : Integer;
                    BaudRate      : Integer;
                    Parity        : Char;
                    WordSize      : Integer;
                    StopBits      : Integer) : Boolean;
{ open a communications port }
var
  ComParm : Integer;
  i, m : Integer;
begin
  if Async_Open_Flag then Async_Close;

  if (ComPort = 2) and (Async_BIOS_Port_Table[2] <> 0) then
    Async_Port := 2
  else
    Async_Port := 1;  { default to COM1 }
  Async_Base := Async_BIOS_Port_Table[Async_Port];
  Async_Irq := Hi(Async_Base) + 1;

  if (Port[UART_IIR + Async_Base] and $00F8) <> 0 then
    Async_Open := FALSE
  else
    begin
      Async_Buffer_Head := 0;
      Async_Buffer_Tail := 0;
      Async_Buffer_Overflow := FALSE;

  { Build the ComParm for RS232_Init }
  { See Technical Reference Manual for description }

      ComParm := $0000;

  { Set up the bits for the baud rate }
      i := 0;
      repeat
        i := i + 1
      until (Async_Baud_Table[i].Baud = BaudRate)
              or (i = Async_Num_Bauds);
      ComParm := ComParm or Async_Baud_Table[i].Bits;

      if Parity in ['E', 'e'] then ComParm := ComParm or $0018
      else if Parity in ['O', 'o'] then
           ComParm := ComParm or $0008
      else ComParm := ComParm or $0000;  { default to No parity }

      if WordSize = 7 then ComParm := ComParm or $0002
      else ComParm := ComParm or $0003;  { default to 8 data bits
}

      if StopBits = 2 then ComParm := ComParm or $0004
      else ComParm := ComParm or $0000;  { default to 1 stop bit
}

      { use the BIOS COM port initialization routine
        to save typing the code }

      BIOS_RS232_Init(Async_Port - 1, ComParm);

      DOS_Set_Intrpt(Async_Irq + 8, CSeg, Ofs(Async_Isr));

{ read the RBR and reset any possible pending error conditions
  first turn off the Divisor Access Latch Bit to allow
  access to RBR, etc. }

      Inline($FA);  { disable interrupts }

      Port[UART_LCR + Async_Base] :=
              Port[UART_LCR + Async_Base] and $7F;
      { read the Line Status Register to reset any
        errors it indicates }
      i := Port[UART_LSR + Async_Base];
      { read the Receiver Buffer Register in case
        it contains a character }
      i := Port[UART_RBR + Async_Base];

      { enable the irq on the 8259 controller }
      i := Port[I8088_IMR];  { get the interrupt mask register }
      m := (1 shl Async_Irq) xor $00FF;
      Port[I8088_IMR] := i and m;

      { enable the data ready interrupt on the 8250 }
      Port[UART_IER + Async_Base] := $01;
      { enable data ready interrupt }

      { enable OUT2 on 8250 }
      i := Port[UART_MCR + Async_Base];
      Port[UART_MCR + Async_Base] := i or $08;

      Inline($FB); { enable interrupts }
      Async_Open_Flag := TRUE;  { bug fix by Scott Herr }
      Async_Open := TRUE
    end
end; { Async_Open }

function Async_Buffer_Check(var C : Char) : Boolean;
{ see if a character has been received; return it if yes }
begin
  if Async_Buffer_Head = Async_Buffer_Tail then
    Async_Buffer_Check := FALSE
  else
    begin
      C := Async_Buffer[Async_Buffer_Tail];
      Async_Buffer_Tail := Async_Buffer_Tail + 1;
      if Async_Buffer_Tail > Async_Buffer_Max then
        Async_Buffer_Tail := 0;
      Async_Buffer_Used := Async_Buffer_Used - 1;
      Async_Buffer_Check := TRUE
    end
end; { Async_Buffer_Check }

procedure Async_Send(C : Char);
{ transmit a character }
var
  i, m, counter : Integer;
begin
  Port[UART_MCR + Async_Base] := $0B; { turn on OUT2, DTR, and
RTS }

  { wait for CTS }
  counter := MaxInt;
  while (counter <> 0) and
        ((Port[UART_MSR + Async_Base] and $10) = 0) do
    counter := counter - 1;

  { wait for Transmit Hold Register Empty (THRE) }
  if counter <> 0 then counter := MaxInt;
  while (counter <> 0) and
        ((Port[UART_LSR + Async_Base] and $20) = 0) do
    counter := counter - 1;

  if counter <> 0 then
    begin
      { send the character }
      Inline($FA); { disable interrupts }
      Port[UART_THR + Async_Base] := Ord(C);
      Inline($FB) { enable interrupts }
    end
  else
    writeln('<<<TIMEOUT>>>');
end; { Async_Send }

procedure Async_Send_String(S : LStr);
{ transmit a string }
var
  i : Integer;
begin
  for i := 1 to length(S) do
    Async_Send(S[i])
end; { Async_Send_String }

________________________________________________________________

                        CHANGE PARAMETERS
________________________________________________________________

{ ASYCHG.INC - procedure to change communication parameters }
{ "on the fly" must be Included following ASYNC.INC }

procedure Async_Change(BaudRate      : Integer;
                       Parity        : Char;
                       WordSize      : Integer;
                       StopBits      : Integer);
{ change communication parameters "on the fly" }
{ you cannot use the BIOS routines because they drop DTR }

const num_bauds = 15;
    divisor_table : array [1..num_bauds] of record
                                            baud, divisor :
integer
                                          end
       = ((baud:50;  divisor:2304),
          (baud:75;  divisor:1536),
          (baud:110; divisor:1047),
          (baud:134; divisor:857),
          (baud:150; divisor:768),
          (baud:300; divisor:384),
          (baud:600; divisor:192),
          (baud:1200; divisor:96),
          (baud:1800; divisor:64),
          (baud:2000; divisor:58),
          (baud:2400; divisor:48),
          (baud:3600; divisor:32),
          (baud:4800; divisor:24),
          (baud:7200; divisor:16),
          (baud:9600; divisor:12));

var i : integer;
    dv  : integer;
    lcr : integer;

begin

  { Build the Line Control Register and find
    the divisor (for the baud rate) }

  { Set up the divisor for the baud rate }
  i := 0;
  repeat
    i := i + 1
  until (Divisor_Table[i].Baud = BaudRate) or (i = Num_Bauds);
  dv  := Divisor_Table[i].divisor;

  lcr := 0;
  case Parity of
    'E' : lcr := lcr or $18;  { even parity }
    'O' : lcr := lcr or $08;  { odd parity }
    'N' : lcr := lcr or $00;  { no parity }
    'M' : lcr := lcr or $28;  { Mark parity }
    'S' : lcr := lcr or $38;  { Space parity }
  else
    lcr := lcr or $00;  { default to no parity }
  end;

  case WordSize of
    5 : lcr := lcr or $00;
    6 : lcr := lcr or $01;
    7 : lcr := lcr or $02;
    8 : lcr := lcr or $03;
  else
    lcr := lcr or $03;  { default to 8 data bits }
  end;

  if StopBits = 2 then lcr := lcr or $04
  else lcr := lcr or $00;  { default to 1 stop bit }

  lcr := lcr and $7F;   { make certain the DLAB is off }

  Inline($FA);  { disable interrupts }

  { turn on DLAB to access the divisor }
  Port[UART_LCR + Async_Base] := Port[UART_LCR + Async_Base] or
$80;

  { set the divisor }
  Port[Async_Base] := Lo(dv);
  Port[Async_Base + 1] := Hi(dv);

  { turn off the DLAB and set the new comm. parameters }
  Port[UART_LCR + Async_Base] := lcr;

  Inline($FB);  { enable interrupts }

end; { Async_Change }

The following are two example programs which use ASYNC.INC.

  program DumbTerminal;
  {$C-}
  {$I ASYNC.INC}
  var
    ch: Char;
    stop: Boolean;
  begin
    stop := false;
    Async_Init;
    if not Async_Open(1, 1200, 'E', 7, 1) then
      begin
        writeln('Invalid port');
        Halt
      end;
    LowVideo;
     writeln('COM1 now open at 1200 baud, 7 data bits, even
parity, ',
            '1 stop bit.');
    write('All keyboard input will be sent out COM1');
    writeln('all input from COM1');
    writeln('will be displayed on the screen.  To quit, type
^Z.');
    writeln;
    repeat
      if Async_Buffer_Check(ch) then write(ch);
      if KeyPressed then
        begin
          read(Kbd, ch);
          if ch = ^Z then stop := true else Async_Send(ch)
        end
    until stop;
    Async_Close
  end.


program tty;

{$IASYNC.INC}

var
  c : char;

begin
  Async_Init;  { initialize variables }
  if not Async_Open(1, 1200, 'E', 7, 1) then  {open
communications port}
    begin
      writeln('**ERROR: Async_Open failed');
      halt
    end;

  writeln('TTY Emulation begins now...');
  writeln('Press any function key to terminate...');

  repeat
    if Async_Buffer_Check(c) then
      case c of
        #000 : ;  { strip incoming nulls }
        #010 : ;  { strip incoming line feeds }
        #012 : ClrScr;  { clear screen on a form feed }
        #013 : Writeln  { handle carriage return as CR/LF }
      else
        write(c)  { else write incoming char to the screen }
      end; { case }
    if KeyPressed then
      begin
        Read(Kbd, c);
        if c = #027 then  { handle IBM Extended Ascii codes }
          begin
            Read(Kbd, c);  { clear the rest of the extended code
}
            Async_Close;   { reset the interrupt system, etc. }
            Writeln('End of TTY Emulation...');
            Writeln('Max Buffer Used = ', Async_MaxBufferUsed);
            halt          { terminate the program }
          end
        else
          Async_Send(c)
      end
  until FALSE

end.