CD/PC Actual 13/CDA13.ISO/cdactual/demobin/share/program/Pascal/ANSIDRVR.ZIP/ANSICOM.PAS

Pascal/Delphi Source File | 1992-05-03 | 18.1 KB | 926 lines

{
Turbo Pascal ANSI Drivers
Version 1.12
Copyright (c) 1990 by Not So Serious Software

Original concept by Ian Silver
Design and implementation by Kevin Dean

Kevin Dean
Fairview Mall P.O. Box 55074
1800 Sheppard Avenue East
Willowdale, Ontario
CANADA    M2J 5B9
CompuServe ID: 76336,3114
}


{$I-,F-,S-,R-}
unit ANSICOM;


interface


uses
  DOS,
  ANSI;


type
  ErrorProc =            { Communications error handling procedure }
    procedure(var Error : word);


const
  Init =            { Initialize modem when setting parameters }
    true;
  NoInit =            { Assume modem already initialized }
    false;

  SyncTransmit =        { Synchronize transmission with output function }
    true;
  AsyncTransmit =        { Return from output function immediately }
    false;

  NoCommError =            { No communications error }
    $0000;
  ReceiveOverrun =        { Received data overrun }
    $0001;
  TransmitOverrun =        { Output buffer overrun }
    $0002;
  ParityError =            { Data parity error }
    $0004;
  FramingError =        { Data framing error }
    $0008;
  BreakDetect =            { Break signal detected }
    $0010;
  CommTimeOut =            { Communications time-out (off-line) }
    $0020;
  NoCarrier =            { No carrier }
    $0040;
  CtrlBreak =            { Ctrl-Break key pressed }
    $0080;
  NotOnline =            { Communications routines not online }
    $0100;


function InitCOM(COMPort : byte; Baud : integer; Bits : byte; Parity : char;
 Stop : byte; Init : boolean; Sync : boolean; Error : pointer) : integer;
function SetBaud(Baud : integer; Bits : byte; Parity : char; Stop : byte) : integer;
procedure Disconnect;
procedure ReleaseCOM;
procedure AssignCOM(var F : Text);
function KeyPressed : boolean;
function ReadKey : char;

{ These functions are not to be called directly; they are used internally }
function ModemIn(var F : Text) : integer;
function ModemOut(var F : Text) : integer;


implementation


type
  ModemRecord =
    record
    Addr : word;        { COM port address }
    EnableMask : byte;        { Interrupt enable mask }
    ResetMask : byte;        { Interrupt reset mask }
    IntrNum : byte        { Interrupt number }
    end;

  ModemArray =
    array [1 .. 4] of ModemRecord;

const
  THR =                { Transmitter holding register }
    0;
  RDR =                { Receiver data register }
    0;
  BRDL =            { Baud rate divisor (low byte) }
    0;
  BRDH =            { Baud rate divisor (high byte) }
    1;
  IER =                { Interrupt enable register }
    1;
  IIR =                { Interrupt identification register }
    2;
  LCR =                { Line control register }
    3;
  MCR =                { Modem control register }
    4;
  LSR =                { Line status register }
    5;
  MSR =                { Modem status register }
    6;

  DCD =                { Data carrier detect bit in MSR }
    $80;

  DTR =                { Data transmit ready in MCR }
    $01;
  RTS =                { Request-to-send in MCR }
    $02;
  IntrOn =            { Interrupt-enable (GPO2) in MCR }
    $08;

  NoIntr =            { No interrupt pending }
    $01;
  ChangedMSR =            { Change in modem status register }
    $00;
  EmptyTHR =            { Transmitter holding register empty }
    $02;
  DataReceived =        { Data received }
    $04;
  ReceiveError =        { Reception error or break condition received }
    $06;

  TransmitDone : boolean =    { True if output buffer is empty }
    true;

  MBufSize =            { Modem buffer size }
    $400;

  MIBufStart : integer =    { Start index of input communications buffer }
    0;
  MIBufEnd : integer =        { End index of input communications buffer }
    0;
  MOBufStart : integer =    { Start index of output communications buffer }
    0;
  MOBufEnd : integer =        { End index of output communications buffer }
    0;

  _COMPort : byte =        { COM port in use }
    0;

  OldCommInt : pointer =    { Old communications interrupt }
    nil;

  ModemData : ModemArray =
    (
      (
      Addr : $3F8; EnableMask : $EF; ResetMask : $64; IntrNum : $0C
      ),
      (
      Addr : $2F8; EnableMask : $F7; ResetMask : $63; IntrNum : $0B
      ),
      (
      Addr : $3E8; EnableMask : $EF; ResetMask : $64; IntrNum : $0C
      ),
      (
      Addr : $2E8; EnableMask : $F7; ResetMask : $63; IntrNum : $0B
      )
    );

  ErrorHandler : pointer =    { User-defined error handling procedure }
    nil;

  CommError : word =        { Last communications error }
    NoCommError;

type
  MBufArray =            { Modem buffer array }
    array [0 .. MBufSize] of byte;

var
  BasePort : word;        { Base communications port }
  IntrMask : byte;        { Modem interrupt mask }
  MCRStat : byte;        { Modem control register status }
  InitModem : boolean;        { True if modem was initialized in InitCOM }
  TransmitSync : boolean;    { True if transmission and output are synchronized }
  MIBuf, MOBuf : MBufArray;    { Input and output buffers }
  OldExit : pointer;        { Old exit procedure }


{***}
{ Increment buffer index, wrap around if necessary }
function IncIndex(Index : integer) : integer;

begin
if Index = MBufSize then
  Index := 0
else
  Inc(Index);

IncIndex := Index
end;


{***}
{ Decrement buffer index, wrap around if necessary }
function DecIndex(Index : integer) : integer;

begin
if Index = 0 then
  Index := MBufSize
else
  Dec(Index);

DecIndex := Index
end;


{***}
{ Transmit next byte in output buffer if available }
procedure TransmitByte;

begin
if MOBufStart = MOBufEnd then
  TransmitDone := true
else
  begin
  TransmitDone := false;
  Port[BasePort + THR] := MOBuf[MOBufStart];
  MOBufStart := IncIndex(MOBufStart)
  end
end;


{***}
{ Receive a byte into the input buffer }
procedure ReceiveByte;

begin
MIBuf[MIBufEnd] := Port[BasePort + RDR];
MIBufEnd := IncIndex(MIBufEnd);
if MIBufStart = MIBufEnd then
  begin
  MIBufEnd := DecIndex(MIBufEnd);
  CommError := CommError or ReceiveOverrun
  end
end;


{***}
{ Check modem status }
procedure CheckStatus;

var
  Status : byte;    { Line status }

begin
{ Read line status register }
Status := Port[BasePort + LSR];

if Status and $02 <> 0 then
  CommError := CommError or ReceiveOverrun;
if Status and $04 <> 0 then
  CommError := CommError or ParityError;
if Status and $08 <> 0 then
  CommError := CommError or FramingError;
if Status and $10 <> 0 then
  CommError := CommError or BreakDetect;
if Status and $80 <> 0 then
  CommError := CommError or CommTimeOut;

{ Check for carrier }
Status := Port[BasePort + MSR];
if Status and DCD = 0 then
  CommError := CommError or NoCarrier
else
  CommError := CommError and not NoCarrier
end;


{***}
{ Serial communications interrupt }
procedure CommInt(Flags, CS, IP, AX, BX, CX, DX, SI, DI, DS, ES, BP : word);
interrupt;

var
  IntrType : byte;    { Interrupt type }

begin
IntrType := Port[BasePort + IIR];

while IntrType <> NoIntr do
  begin
  case IntrType of
    EmptyTHR:
      TransmitByte;

    DataReceived:
      ReceiveByte;

    ChangedMSR, ReceiveError:
      CheckStatus
    end;

  IntrType := Port[BasePort + IIR]
  end;

{ Acknowledge interrupt }
Port[$20] := $20
end;


{***}
{ Clear interrupts by reading all communications registers }
procedure ClearInterrupts;

var
  IntrType : byte;    { Interrupt type }
  X : byte;        { Temporary storage to read registers }

begin
IntrType := Port[BasePort + IIR];

while IntrType <> NoIntr do
  begin
  case IntrType of
    EmptyTHR:
      ;

    DataReceived:
      X := Port[BasePort + RDR];

    ChangedMSR, ReceiveError:
      begin
      X := Port[BasePort + LSR];
      X := Port[BasePort + MSR]
      end
    end;

  IntrType := Port[BasePort + IIR]
  end
end;


{***}
{ Initialize communications port and install interrupt }
function InitCOM(COMPort : byte; Baud : integer; Bits : byte; Parity : char;
 Stop : byte; Init : boolean; Sync : boolean; Error : pointer) : integer;

var
  Result : integer;        { Initialization result }
  Regs : Registers;        { Registers used in dummy interrupt call }
  X : byte;            { Dummy value for COM port registers }

begin
{ No error }
Result := 0;

if (COMPort >= 1) and (COMPort <= 4) then
  begin
  _COMPort := COMPort;

  BasePort := ModemData[COMPort].Addr;

  { Save modem interrupt enable mask }
  IntrMask := Port[BasePort + IER];

  InitModem := Init;

  if InitModem then
    begin
    { Disable communications interrupts }
    Port[BasePort + IER] := 0;

    Result := SetBaud(Baud, Bits, Parity, Stop)
    end;

  if Result = 0 then
    begin
    { Install communications interrupt }
    GetIntVec(ModemData[COMPort].IntrNum, OldCommInt);
    SetIntVec(ModemData[COMPort].IntrNum, @CommInt);

    { Save transmission type }
    TransmitSync := Sync;

    { Save user-defined error handler }
    ErrorHandler := Error;

    { Set interrupt enable mask }
    Port[$21] := Port[$21] and ModemData[COMPort].EnableMask;

    { Reset interrupt line }
    Port[$20] := ModemData[COMPort].ResetMask;

    { Check for carrier }
    if Port[BasePort + MSR] and DCD = 0 then
      CommError := NoCarrier;

    { Interrupt on data received, THR empty, data reception error, and change in MSR }
    Port[BasePort + IER] := $0F;

    { DTR active, RTS active, interrupts on }
    MCRStat := Port[BasePort + MCR];
    Port[BasePort + MCR] := DTR or RTS or IntrOn;

    { Clear all pending interrupts }
    ClearInterrupts
    end
  end
else
  Result := 1;

InitCOM := Result
end;


{***}
{ Change baud rate and data format dynamically }
function SetBaud(Baud : integer; Bits : byte; Parity : char; Stop : byte) : integer;

var
  Result : integer;        { Initialization result }
  LowDiv, HighDiv : byte;    { Low and high bytes of baud rate divisor }
  DataFormat : byte;        { Modem data format (bits, parity, etc) }

begin
if _COMPort <> 0 then
  begin
  Result := 0;

  { Set baud rate divisors }
  if Baud = 110 then
    begin
    LowDiv := $17;
    HighDiv := $04
    end
  else if Baud = 300 then
    begin
    LowDiv := $80;
    HighDiv := $01
    end
  else if Baud = 600 then
    begin
    LowDiv := $C0;
    HighDiv := $00
    end
  else if Baud = 1200 then
    begin
    LowDiv := $60;
    HighDiv := $00
    end
  else if Baud = 1800 then
    begin
    LowDiv := $40;
    HighDiv := $00
    end
  else if Baud = 2400 then
    begin
    LowDiv := $30;
    HighDiv := $00
    end
  else if Baud = 3600 then
    begin
    LowDiv := $20;
    HighDiv := $00
    end
  else if Baud = 4800 then
    begin
    LowDiv := $18;
    HighDiv := $00
    end
  else if Baud = 9600 then
    begin
    LowDiv := $0C;
    HighDiv := $00
    end
  else
    Result := 1;

  { Determine number of data bits }
  case Bits of
    5:
      DataFormat := $00;

    6:
      DataFormat := $01;

    7:
      DataFormat := $02;

    8:
      DataFormat := $03;

    else
      Result := 1
    end;

  { Determine number of stop bits }
  case Stop of
    1:
      { Bit is 0 }
      ;

    2:
      DataFormat := DataFormat or $04;

    else
      Result := 1
    end;

  { Determine parity }
  case UpCase(Parity) of
    'N':
      { No parity, bit is 0 }
      ;

    'O':
      { Odd parity }
      DataFormat := DataFormat or $08;

    'E':
      { Even parity }
      DataFormat := DataFormat or $18;

    'M':
      { Mark parity }
      DataFormat := DataFormat or $28;

    'S':
      { Space parity }
      DataFormat := DataFormat or $38;

    else
      Result := 1
    end;

  if Result = 0 then
    begin
    { Turn on bit 7 of line control register to set baud rate }
    Port[BasePort + LCR] := Port[BasePort + LCR] or $80;

    { Set low and high baud rate divisors }
    Port[BasePort+ BRDL] := LowDiv;
    Port[BasePort+ BRDH] := HighDiv;

    { Set data format }
    Port[BasePort + LCR] := DataFormat
    end
  end
else
  { Modem not previously initialized }
  Result := 1;

SetBaud := Result
end;


{***}
{ Disconnect modem }
procedure Disconnect;

begin
{ Turn off data transmit ready bit }
Port[BasePort + MCR] := Port[BasePort + MCR] and not DTR;

{ Wait enough time for other modem to recognize loss of carrier }
Delay(1000);

{ Turn on data transmit ready bit }
Port[BasePort + MCR] := Port[BasePort + MCR] or DTR
end;


{***}
{ Release communications port }
procedure ReleaseCOM;

begin
if OldCommInt <> nil then
  begin
  if InitModem then
    Disconnect;

  { Restore communications interrupt }
  SetIntVec(ModemData[_COMPort].IntrNum, OldCommInt);
  OldCommInt := nil;

  { Reset modem interrupt mask }
  Port[BasePort + IER] := IntrMask;

  { Reset interrupt enable mask }
  Port[$21] := Port[$21] or not ModemData[_COMPort].EnableMask;

  { Reset MCR }
  Port[BasePort + MCR] := MCRStat;

  _COMPort := 0
  end
end;


{$F+}

{***}
{ Release modem on exit }
procedure ExitRelease;

begin
ExitProc := OldExit;
ReleaseCOM
end;

{$F-}


{***}
{ Check for communications error and call error routine if defined }
procedure CheckError;

const
  ErrorPending : boolean =    { True if error handling is already underway }
    false;

begin
if (CommError <> NoCommError) and not ErrorPending then
  if ErrorHandler <> nil then
    begin
    ErrorPending := true;
    ErrorProc(ErrorHandler)(CommError);
    ErrorPending := false
    end
  else
    CommError := NoCommError
end;


{$F+}

{***}
{ Handle line-oriented communications input }
function ModemIn(var F : Text) : integer;

var
  NumRead : integer;    { Number of characters read }
  Done : boolean;    { True if end of line }
  Key : char;        { Character received }

begin
{ Make sure program has been properly initialized }
if OldCommInt = nil then
  CommError := CommError or NotOnline;

NumRead := 0;

Done := false;
while not Done do
  begin
  { Generate DOS OK interrupt while waiting for character }
  while (MIBufStart = MIBufEnd) and (CommError = NoCommError) do
    inline
    (
    $CD/$28    { INT    28h }
    );

  CheckError;

  Key := Chr(MIBuf[MIBufStart]);
  MIBufStart := IncIndex(MIBufStart);

  case Key of
    NUL:
      { Ignore extended keys }
      begin
      { Generate DOS OK interrupt while waiting for character }
      while (MIBufStart = MIBufEnd) and (CommError = NoCommError) do
    inline
    (
    $CD/$28        { INT    28h }
    );

      CheckError;

      MIBufStart := IncIndex(MIBufStart)
      end;

    BRK:
      if CheckBreak then
    CommError := CommError or CtrlBreak;

    BS:
      { Erase last character if possible }
      if (NumRead <> 0) and (WhereX <> 1) then
    begin
    Write(BS, ' ', BS);
    Dec(NumRead)
    end;

    CR, LF:
      { End of line }
      begin
      Done := true;
      TextRec(F).BufPtr^[NumRead] := CR;
      Inc(NumRead);
      TextRec(F).BufPtr^[NumRead] := LF;
      Inc(NumRead);
      WriteLn
      end;

    EOF_:
      { End of file }
      if CheckEOF then
    begin
    Done := true;
    TextRec(F).BufPtr^[NumRead] := EOF_;
    Inc(NumRead)
    end;

    ESC:
      { Clear current input }
      begin
      Write('\', LF);
      if MaxX = 0 then
    GotoXY(WhereX - NumRead - 1 + MaxX, WhereY)
      else
    GotoXY((WhereX - NumRead + MaxX - 2) mod MaxX + 1, WhereY);
      NumRead := 0
      end;

    else
      { Display the character }
      with TextRec(F) do
    if NumRead < BufSize - 2 then
      begin
      BufPtr^[NumRead] := Key;
      Write(Key);
      Inc(NumRead)
      end
    end
  end;

{ Save buffer pointers }
with TextRec(F) do
  begin
  BufPos := 0;
  BufEnd := NumRead
  end;

ModemIn := 0
end;


{***}
{ Display text on modem }
function ModemOut(var F : Text) : integer;

var
  I : integer;        { Index into buffer }

begin
with TextRec(F) do
  begin
  for I := 0 to BufPos - 1 do
    begin
    MOBuf[MOBufEnd] := Ord(BufPtr^[I]);
    if MOBuf[MOBufEnd] = Ord(FF) then
      { Translate form feed }
      ClrScr
    else
      begin
      MOBufEnd := IncIndex(MOBufEnd);
      if MOBufStart = MOBufEnd then
    begin
    MOBufEnd := DecIndex(MOBufEnd);
    CommError := CommError or TransmitOverrun
    end
      end
    end;

  BufPos := 0
  end;

CheckError;

{ Start transmission if necessary }
if TransmitDone and (OldCommInt <> nil) then
  TransmitByte;

if TransmitSync and (OldCommInt <> nil) then
  { Wait for end of transmission }
  while not TransmitDone and (CommError = NoCommError) do
    inline
    (
    $CD/$28    { INT    28h }
    );

CheckError;

ModemOut := 0
end;


{***}
{ Flush modem buffer }
function ModemFlush(var F : Text) : integer;

begin
with TextRec(F) do
  if Mode = fmInput then
    { Ignore flush request }
    ModemFlush := 0
  else
    { Chain to F's default output routine }
    ModemFlush := IOFunc(InOutFunc)(F)
end;


{***}
{ Open modem for input or output }
function ModemOpen(var F : Text) : integer;

begin
with TextRec(F) do
  if Mode = fmInput then
    IOFunctions(UserData).NextInOut := @ModemIn
  else
    IOFunctions(UserData).NextInOut := @ModemOut;

ModemOpen := 0
end;


{***}
{ Close modem (do nothing) }
function ModemClose(var F : Text) : integer;

begin
ModemClose := 0
end;

{$F-}


{***}
{ Assign a file to the modem }
procedure AssignCOM(var F : Text);

var
  IOChain : IOFunctions;    { Modem I/O function chain }

begin
with IOChain do
  begin
  NextOpen := @ModemOpen;
  NextInOut := nil;
  NextFlush := @ModemFlush;
  NextClose := @ModemClose
  end;

AssignANSI(F, IOChain)
end;


{***}
{ Return true if character in input buffer }
function KeyPressed : boolean;

begin
CheckError;
KeyPressed := MIBufStart <> MIBufEnd
end;


{***}
{ Read character from input buffer }
function ReadKey : char;

var
  Key : char;    { Character received }

begin
{ Generate DOS OK interrupt while waiting for character }
while (MIBufStart = MIBufEnd) and (CommError = NoCommError) do
  inline
  (
  $CD/$28    { INT    28h }
  );

CheckError;

Key := Chr(MIBuf[MIBufStart]);
MIBufStart := IncIndex(MIBufStart);

if (Key = BRK) and CheckBreak then
  begin
  CommError := CommError or CtrlBreak;
  CheckError
  end;

ReadKey := Key
end;


{***}
begin
OldExit := ExitProc;
ExitProc := @ExitRelease;

Close(Input);
Close(Output);

AssignCOM(ANSIFile);
Rewrite(ANSIFile);

AssignCOM(Input);
Reset(Input);

AssignCOM(Output);
Rewrite(Output)
end.