Category : Pascal Source Code
Archive   : ASYNC12.ZIP
Filename : ASYNC12.PAS

 
Output of file : ASYNC12.PAS contained in archive : ASYNC12.ZIP
{****************************************************************************}
{* *}
{* ASYNC12 - Interrupt-driven asyncronous communications for Turbo Pascal *}
{* Version 1.2 - Wedensday June 14, 1989 *}
{* Copyright (C) 1989, Rising Edge Data Services *}
{* Author : Mark Schultz *}
{* *}
{*--------------------------------------------------------------------------*}
{* *}
{* The routines that follow comprise a Turbo Pascal UNIT that will fully *}
{* impliment interrupt-driven serial communications on a fully PC-compat- *}
{* able computer (those machines that use the 8250 or equivalent UART *}
{* mapped at the standard addresses). Full simultaneous buffering for *}
{* both input and output with variable buffer sizes for each port is *}
{* provided. Unlike many other libraries of a similar nature, up to 4 *}
{* ports may be active simultaneously (easily modified for more). *}
{* *}
{* For further details, consult the procedure/function headers within the *}
{* program or check the accompanying ASYNC12.DOC file. To successfuly *}
{* compile this unit, you MUST have the file "ASYNC.OBJ" in the "Object *}
{* directory" (as defined in the Integrated Environment) or the currently *}
{* logged directory; in short, where the compiler can find it. This file *}
{* contains the object code for the assembly-based routines within. *}
{* *}
{* This product is copyrighted (C) 1988 by Rising Edge Software, Inc. and *}
{* it's author, Mark Schultz. Permission is granted for non-commercial *}
{* use and distribution. Refer to the file ASYNC12.DOC for details. *}
{* *}
{* Version History: *}
{* *}
{* V1.2 - Improved performance (accuracy) of the ComExist function. *}
{* Several minor enhancements made to improve performance. *}
{* *}
{* V1.1 - Corrected errors that dealt with the handling of the 8259. Also *}
{* added compensation for "bugs" that are present in some 8250's *}
{* and equivalent gate arrays (Thanks to Ralph Schraven, Toshiba *}
{* Europa GmbH for tracking these problems down). *}
{* *}
{* V1.0 - First release *}
{* *}
{*--------------------------------------------------------------------------*}
{* *}
{* Status byte definition (C_Status): *}
{* *}
{* 7 6 5 4 3 2 1 0 *}
{* | | | | | | | |____ Input buffer empty *}
{* | | | | | | |________ Input buffer full *}
{* | | | | | |____________ Output buffer empty *}
{* | | | | |________________ Output buffer full *}
{* | | | |____________________ Input buffer overflow *}
{* | | |________________________ Output buffer overflow *}
{* | |____________________________ Hard handshake active (xmit stopped) *}
{* |________________________________ Soft handshake active (xmit stopped) *}
{* *}
{* Control byte definition (C_Ctrl): *}
{* *}
{* 7 6 5 4 3 2 1 0 *}
{* | | | | | | | |____ Enable RTS handshake *}
{* | | | | | | |________ Enable CTS handshake *}
{* | | | | | |____________ Enable software handshake *}
{* | | | | |________________ *}
{* | | | |____________________ *}
{* | | |________________________ *}
{* | |____________________________ *}
{* |________________________________ *}
{* *}
{****************************************************************************}

{$R-,V-,B-}

Unit ASYNC;

INTERFACE

{----------------------------------------------------------------------------}

Const
C_MinBaud = 50;
C_MaxBaud = 115200;

{ Base port addresses & interrupt usage }

C_MaxPort = 4;
C_MaxCom : Byte = C_MaxPort;
C_PortAddr : Array[1..C_MaxPort] Of Word = ($03F8,$02F8,$03E8,$02E8);
C_PortInt : Array[1..C_MaxPort] Of Byte = (4,3,4,3);

{----------------------------------------------------------------------------}

Type
C_PointerArray = Array[1..C_MaxPort] Of Pointer;
C_WordArray = Array[1..C_MaxPort] Of Word;
C_ByteArray = Array[1..C_MaxPort] Of Byte;
C_CharArray = Array[1..C_MaxPort] Of Char;
C_BooleanArray = Array[1..C_MaxPort] Of Boolean;

{----------------------------------------------------------------------------}

Var
C_InBufPtr,C_OutBufPtr : C_PointerArray; { Input/output buffer pointers }
C_InHead,C_OutHead : C_WordArray; { Input/output head pointers }
C_InTail,C_OutTail : C_WordArray; { Input/output tail pointers }
C_InSize,C_OutSize : C_WordArray; { Input/output buffer sizes }
C_RTSOn,C_RTSOff : C_WordArray; { RTS assert/drop buffer points }
C_StartChar,C_StopChar : C_CharArray; { Soft hndshake start/stop char }
C_Status,C_Ctrl : C_ByteArray; { STATUS and CONTROL registers }
C_XL3Ptr : C_ByteArray;
C_PortOpen : C_BooleanArray; { Port open/close flags }
C_Temp : Word; { Used for debugging }

{----------------------------------------------------------------------------}

{ Procedure headers - required for UNITization }

Function ComReadCh(ComPort:Byte) : Char;
Function ComReadChW(ComPort:Byte) : Char;
Procedure ComWriteCh(ComPort:Byte; Ch:Char);
Procedure ComWriteChW(ComPort:Byte; Ch:Char);
Procedure SetDTR(ComPort:Byte; Assert:Boolean);
Procedure SetRTS(ComPort:Byte; Assert:Boolean);
Procedure SetOUT1(ComPort:Byte; Assert:Boolean);
Procedure SetOUT2(ComPort:Byte; Assert:Boolean);
Function CTSStat(ComPort:Byte) : Boolean;
Function DSRStat(ComPort:Byte) : Boolean;
Function RIStat(ComPort:Byte) : Boolean;
Function DCDStat(ComPort:Byte) : Boolean;
Procedure SetRTSMode(ComPort:Byte; Mode:Boolean; RTSOn,RTSOff:Word);
Procedure SetCTSMode(ComPort:Byte; Mode:Boolean);
Procedure SoftHandshake(ComPort:Byte; Mode:Boolean; Start,Stop:Char);
Procedure ClearCom(ComPort:Byte; IO:Char);
Function ComBufferLeft(ComPort:Byte; IO:Char) : Word;
Procedure ComWaitForClear(ComPort:Byte);
Procedure ComWrite(ComPort:Byte; St:String);
Procedure ComWriteln(ComPort:Byte; St:String);
Procedure ComWriteWithDelay(ComPort:Byte; St:String; Dly:Word);
Procedure ComReadln(ComPort:Byte; Var St:String; Size:Byte; Echo:Boolean);
Function ComExist(ComPort:Byte) : Boolean;
Function ComTrueBaud(Baud:Longint) : Real;
Procedure ComParams(ComPort:Byte; Baud:LongInt; WordSize:Byte; Parity:Char; StopBits:Byte);
Function OpenCom(ComPort:Byte; InBufferSize,OutBufferSize:Word) : Boolean;
Procedure CloseCom(ComPort:Byte);
Procedure CloseAllComs;

{----------------------------------------------------------------------------}

IMPLEMENTATION

Uses DOS,CRT;

{$L ASYNC.OBJ}

Const
C_IER = 1; { 8250 register offsets }
C_IIR = 2;
C_LCR = 3;
C_MCR = 4;
C_LSR = 5;
C_MSR = 6;
C_SCR = 7;

Var
C_OldINTVec : C_PointerArray; { Storage for old hardware INT vectors }
X : Byte; { Used by initialization code }

{****************************************************************************}
{* *}
{* Procedure INT_Handler; External; *}
{* *}
{* Hardware interrupts 3 and 4 (vectors $0B and $0C) are pointed to *}
{* this routine. It is for internal use only and should NOT be called *}
{* directly. Written in assembly language (see ASYNC12.ASM). *}
{* *}
{****************************************************************************}

Procedure INT_Handler; External;

{****************************************************************************}
{* *}
{* Procedure ComReadCh(ComPort:Byte) : Char; External; *}
{* *}
{* ComPort:Byte -> Port # to use (1 - C_MaxCom) *}
{* *}
{* Returns character from input buffer of specified port. If the buffer *}
{* is empty, the port # invalid or not opened, a Chr(0) is returned. *}
{* Written in assembly language for best possible speed (see ASYNC12.ASM) *}
{* *}
{****************************************************************************}

Function ComReadCh(ComPort:Byte) : Char; External;

{****************************************************************************}
{* *}
{* Function ComReadChW(ComPort:Byte) : Char; External; *}
{* *}
{* ComPort:Byte -> Port # to use (1 - C_MaxCom) *}
{* *}
{* Works like ComReadCh, but will wait until at least 1 character is *}
{* present in the specified input buffer before exiting. Thus, ComReadChW *}
{* works much like the ReadKey predefined function. Written in assembly *}
{* language to maximize performance (see ASYNC12.ASM) *}
{* *}
{****************************************************************************}

Function ComReadChW(ComPort:Byte) : Char; External;

{****************************************************************************}
{* *}
{* Procedure ComWriteCh(ComPort:Byte; Ch:Char); External *}
{* *}
{* ComPort:Byte -> Port # to use (1 - C_MaxCom) *}
{* Ch:Char -> Character to send *}
{* *}
{* Places the character [Ch] in the transmit buffer of the specified port. *}
{* If the port specified is not open or nonexistent, or if the buffer is *}
{* filled, the character is discarded. Written in assembly language to *}
{* maximize performance (see ASYNC12.ASM) *}
{* *}
{****************************************************************************}

Procedure ComWriteCh(ComPort:Byte; Ch:Char); External;

{****************************************************************************}
{* *}
{* Procedure ComWriteChW(ComPort:Byte; Ch:Char); External; *}
{* *}
{* ComPort:Byte -> Port # to use (1 - C_MaxCom) *}
{* Ch:Char -> Character to send *}
{* *}
{* Works as ComWriteCh, but will wait until at least 1 free position is *}
{* available in the output buffer before attempting to place the character *}
{* [Ch] in it. Allows the programmer to send characters without regard to *}
{* available buffer space. Written in assembly language to maximize *}
{* performance (see ASYNC12.ASM) *}
{* *}
{****************************************************************************}

Procedure ComWriteChW(ComPort:Byte; Ch:Char); External;

{****************************************************************************}
{* *}
{* Procedure SetDTR(ComPort:Byte; Assert:Boolean); *}
{* *}
{* ComPort:Byte -> Port # to use (1 - C_MaxCom) *}
{* Call ignored if out-of-range *}
{* Assert:Boolean -> DTR assertion flag (TRUE to assert DTR) *}
{* *}
{* Provides a means to control the port's DTR (Data Terminal Ready) signal *}
{* line. When [Assert] is TRUE, the DTR line is placed in the "active" *}
{* state, signalling to a remote system that the host is "on-line" *}
{* (although not nessesarily ready to receive data - see SetRTS). *}
{* *}
{****************************************************************************}

Procedure SetDTR(ComPort:Byte; Assert:Boolean);

Var
P,X : Integer;

Begin
If (ComPort<1) Or (ComPort>C_MaxCom) Then Exit;
P := C_PortAddr[ComPort];

X := Port[P+C_MCR];
If Assert Then
X := X Or $01
Else
X := X And $FE;
Port[P+C_MCR] := X;
End;

{****************************************************************************}
{* *}
{* Procedure SetRTS(ComPort:Byte; Assert:Boolean) *}
{* *}
{* ComPort:Byte -> Port # to use (1 - C_MaxCom) *}
{* Call ignored if out-of-range *}
{* Assert:Boolean -> RTS assertion flag (Set TRUE to assert RTS) *}
{* *}
{* SetRTS allows a program to manually control the Request-To-Send (RTS) *}
{* signal line. If RTS handshaking is disabled (see C_Ctrl definition *}
{* and the the SetRTSMode procedure), this procedure may be used. SetRTS *}
{* should NOT be used if RTS handshaking is enabled. *}
{* *}
{****************************************************************************}

Procedure SetRTS(ComPort:Byte; Assert:Boolean);

Var
P,X : Integer;

Begin
If (ComPort<1) Or (ComPort>C_MaxCom) Then Exit;
P := C_PortAddr[ComPort];

X := Port[P+C_MCR];
If Assert Then
X := X Or $02
Else
X := X And $FD;
Port[P+C_MCR] := X;
End;

{****************************************************************************}
{* *}
{* Procedure SetOUT1(ComPort:Byte; Assert:Boolean) *}
{* *}
{* ComPort:Byte -> Port # to use (1 - C_MaxCom) *}
{* Call ignored if out-of-range *}
{* Assert:Boolean -> OUT1 assertion flag (set TRUE to assert OUT1 line) *}
{* *}
{* SetOUT1 is provided for reasons of completeness only, since the *}
{* standard PC/XT/AT configurations do not utilize this control signal. *}
{* If [Assert] is TRUE, the OUT1 signal line on the 8250 will be set to a *}
{* LOW logic level (inverted logic). The OUT1 signal is present on pin 34 *}
{* of the 8250 (but not on the port itself). *}
{* *}
{****************************************************************************}

Procedure SetOUT1(ComPort:Byte; Assert:Boolean);

Var
P,X : Integer;

Begin
If (ComPort<1) Or (ComPort>C_MaxCom) Then Exit;
P := C_PortAddr[ComPort];

X := Port[P+C_MCR];
If Assert Then
X := X Or $04
Else
X := X And $FB;
Port[P+C_MCR] := X;
End;

{****************************************************************************}
{* *}
{* Procedure SetOUT2(ComPort:Byte; Assert:Boolean) *}
{* *}
{* ComPort:Byte -> Port # to use (1 - C_MaxCom) *}
{* Call ignored if out-of-range *}
{* Assert:Boolean -> OUT2 assertion flag (set TRUE to assert OUT2 line) *}
{* *}
{* The OUT2 signal line, although not available on the port itself, is *}
{* used to gate the 8250 (interrupt) line and thus acts as a *}
{* redundant means of controlling 8250 interrupts. When [Assert] is TRUE, *}
{* the /OUT2 line on the 8250 is lowered, which allows the passage of the *}
{* signal through a gating arrangement, allowing the 8250 to *}
{* generate interrupts. Int's can be disabled bu unASSERTing this line. *}
{* *}
{****************************************************************************}

Procedure SetOUT2(ComPort:Byte; Assert:Boolean);

Var
P,X : Integer;

Begin
If (ComPort<1) Or (ComPort>C_MaxCom) Then Exit;
P := C_PortAddr[ComPort];

X := Port[P+C_MCR];
If Assert Then
X := X Or $08
Else
X := X And $F7;
Port[P+C_MCR] := X;
End;

{****************************************************************************}
{* *}
{* Function CTSStat(ComPort:Byte) : Boolean *}
{* *}
{* ComPort:Byte -> Port # to use (1 - C_MaxCom) *}
{* Call ignored if out-of-range *}
{* Returns status of Clear-To-Send line (TRUE if CTS asserted) *}
{* *}
{* CTSStat provides a means to interrogate the Clear-To-Send hardware *}
{* handshaking line. In a typical arrangement, when CTS is asserted, this *}
{* signals the host (this computer) that the receiver is ready to accept *}
{* data (in contrast to the DSR line, which signals the receiver as *}
{* on-line but not nessesarily ready to accept data). An automated mech- *}
{* ansim (see CTSMode) is provided to do this, but in cases where this is *}
{* undesirable or inappropriate, the CTSStat function can be used to int- *}
{* terrogate this line manually. *}
{* *}
{****************************************************************************}

Function CTSStat(ComPort:Byte) : Boolean;

Begin
If (ComPort<1) Or (ComPort>C_MaxCom) Then
CTSStat := False
Else
CTSStat := (Port[C_PortAddr[ComPort]+C_MSR] And $10) > 0;
End;

{****************************************************************************}
{* *}
{* Function DSRStat(ComPort:Byte) : Boolean *}
{* *}
{* ComPort:Byte -> Port # to use (1 - C_MaxCom) *}
{* Call ignored if out-of-range *}
{* Returns status of Data Set Ready (DSR) signal line. *}
{* *}
{* The Data Set Ready (DSR) line is typically used by a remote station *}
{* to signal the host system that it is on-line (although not nessesarily *}
{* ready to receive data yet - see CTSStat). A remote station has the DSR *}
{* line asserted if DSRStat returns TRUE. *}
{* *}
{****************************************************************************}

Function DSRStat(ComPort:Byte) : Boolean;

Begin
If (ComPort<1) Or (ComPort>C_MaxCom) Then
DSRStat := False
Else
DSRStat := (Port[C_PortAddr[ComPort]+C_MSR] And $20) > 0;
End;

{****************************************************************************}
{* *}
{* Function RIStat(ComPort:Byte) : Boolean *}
{* *}
{* ComPort:Byte -> Port # to use (1 - C_MaxCom) *}
{* Call ignored if out-of-range *}
{* *}
{* Returns the status of the Ring Indicator (RI) line. This line is *}
{* typically used only by modems, and indicates that the modem has detect- *}
{* ed an incoming call if RIStat returns TRUE. *}
{* *}
{****************************************************************************}

Function RIStat(ComPort:Byte) : Boolean;

Begin
If (ComPort<1) Or (ComPort>C_MaxCom) Then
RIStat := False
Else
RIStat := (Port[C_PortAddr[ComPort]+C_MSR] And $40) > 0;
End;

{****************************************************************************}
{* *}
{* Function DCDStat(ComPort:Byte) : Boolean *}
{* *}
{* ComPort:Byte -> Port # to use (1 - C_MaxCom) *}
{* Call ignored if out-of-range *}
{* *}
{* Returns the status of the Data Carrier Detect (DCD) line from the rem- *}

{* ote device, typically a modem. When asserted (DCDStat returns TRUE), *}
{* the modem indicates that it has successfuly linked with another modem *}
{* device at another site. *}
{* *}
{****************************************************************************}

Function DCDStat(ComPort:Byte) : Boolean;

Begin
If (ComPort<1) Or (ComPort>C_MaxCom) Then
DCDStat := False
Else
DCDStat := (Port[C_PortAddr[ComPort]+C_MSR] And $80) > 0;
End;

{****************************************************************************}
{* *}
{* Procedure SetRTSMode(ComPort:Byte; Mode:Boolean; RTSOn,RTSOff:Word) *}
{* *}
{* ComPort:Byte -> Port # to use (1 - C_MaxCom). *}
{* Request ignored if out of range or unopened. *}
{* Mode:Boolean -> TRUE to enable automatic RTS handshake *}
{* RTSOn:Word -> Buffer-usage point at which the RTS line is asserted *}
{* RTSOff:Word -> Buffer-usage point at which the RTS line is dropped *}
{* *}
{* SetRTSMode enables or disables automated RTS handshaking. If [MODE] is *}
{* TRUE, automated RTS handshaking is enabled. If enabled, the RTS line *}
{* will be DROPPED when the # of buffer bytes used reaches or exceeds that *}
{* of [RTSOff]. The RTS line will then be re-asserted when the buffer is *}
{* emptied down to the [RTSOn] usage point. If either [RTSOn] or [RTSOff] *}
{* exceeds the input buffer size, they will be forced to (buffersize-1). *}
{* If [RTSOn] > [RTSOff] then [RTSOn] will be the same as [RTSOff]. *}
{* The actual handshaking control is located in the interrupt driver for *}
{* the port (see ASYNC12.ASM). *}
{* *}
{****************************************************************************}

Procedure SetRTSMode(ComPort:Byte; Mode:Boolean; RTSOn,RTSOff:Word);

Var
X : Byte;

Begin
If (ComPort<1) Or (ComPort>C_MaxPort) Or (Not C_PortOpen[ComPort]) Then Exit;

X := C_Ctrl[ComPort];
If Mode Then X := X Or $01 Else X := X And $FE;
C_Ctrl[ComPort] := X;

If Mode Then
Begin
If (RTSOff >= C_InSize[ComPort]) Then RTSOff := C_InSize[ComPort] - 1;
If (RTSOn > RTSOff) Then RTSOff := RTSOn;
C_RTSOn[ComPort] := RTSOn;
C_RTSOff[ComPort] := RTSOff;
End;
End;

{****************************************************************************}
{* *}
{* Procedure SetCTSMode(ComPort:Byte; Mode:Boolean) *}
{* *}
{* ComPort:Byte -> Port # to use (1 - C_MaxCom). *}
{* Request ignored if out of range or unopened. *}
{* Mode:Boolean -> Set to TRUE to enable automatic CTS handshake. *}
{* *}
{* SetCTSMode allows the enabling or disabling of automated CTS handshak- *}
{* ing. If [Mode] is TRUE, CTS handshaking is enabled, which means that *}
{* if the remote drops the CTS line, the transmitter will be disabled *}
{* until the CTS line is asserted again. Automatic handshake is disabled *}
{* if [Mode] is FALSE. CTS handshaking and "software" handshaking (pro- *}
{* vided by the SoftHandshake procedure) ARE compatable and may be used *}
{* in any combination. The actual logic for CTS handshaking is located *}
{* in the communications interrupt driver (see ASYNC12.ASM). *}
{* *}
{****************************************************************************}

Procedure SetCTSMode(ComPort:Byte; Mode:Boolean);

Var
X : Byte;

Begin
If (ComPort<1) Or (ComPort>C_MaxPort) Or (Not C_PortOpen[ComPort]) Then Exit;

X := C_Ctrl[ComPort];
If Mode Then X := X Or $02 Else X := X And $FD;
C_Ctrl[ComPort] := X;
End;

{****************************************************************************}
{* *}
{* Procedure SoftHandshake(ComPort:Byte; Mode:Boolean; Start,Stop:Char) *}
{* *}
{* ComPort:Byte -> Port # to use (1 - C_MaxCom). *}
{* Request ignored if out of range or unopened. *}
{* Mode:Boolean -> Set to TRUE to enable transmit software handshake *}
{* Start:Char -> START control character (usually ^Q) *}
{* Defaults to ^Q if character passed is >= *}
{* Stop:Char -> STOP control character (usually ^S) *}
{* Defaults to ^S if character passed is >= *}
{* *}
{* SoftHandshake controls the usage of "Software" (control-character) *}
{* handshaking on transmission. If "software handshake" is enabled *}
{* ([Mode] is TRUE), transmission will be halted if the character in *}
{* [Stop] is received. Transmission is re-enabled if the [Start] char- *}
{* acter is received. Both the [Start] and [Stop] characters MUST be *}
{* CONTROL characters (i.e. Ord(Start) and Ord(Stop) must both be < 32). *}
{* Also, and CANNOT be the same character. If either one *}
{* of these restrictions are violated, the defaults (^Q for and ^S *}
{* for ) will be used. Software handshaking control is implimented *}
{* within the communications interrupt driver (see ASYNC12.ASM). *}
{* *}
{****************************************************************************}

Procedure SoftHandshake(ComPort:Byte; Mode:Boolean; Start,Stop:Char);

Var
X : Byte;

Begin
If (ComPort<1) Or (ComPort>C_MaxPort) Or (Not C_PortOpen[ComPort]) Then Exit;

X := C_Ctrl[ComPort];
If Mode Then
Begin
X := X Or $04;
If Start=Stop Then Begin Start := ^Q; Stop := ^S; End;
If Start>#32 Then Start := ^Q;
If Stop>#32 Then Stop := ^S;
C_StartChar[ComPort] := Start;
C_StopChar[ComPort] := Stop;
End
Else
X := X And $FB;
C_Ctrl[ComPort] := X;
End;

{****************************************************************************}
{* *}
{* Procedure ClearCom(ComPort:Byte); IO:Char) *}
{* *}
{* ComPort:Byte -> Port # to use (1 - C_MaxCom). *}
{* Request ignored if out of range or unopened. *}
{* IO:Char -> Action code; I=Input, O=Output, B=Both *}
{* No action taken if action code unrecognized. *}
{* *}
{* ClearCom allows the user to completely clear the contents of either *}
{* the input (receive) and/or output (transmit) buffers. The "action *}
{* code" passed in determines if the input (I) or output (O) buffer *}
{* is cleared. Action code (B) will clear both buffers. This is useful *}
{* if you wish to cancel a transmitted message or ignore part of a *}
{* received message. *}
{* *}
{****************************************************************************}

Procedure ClearCom(ComPort:Byte; IO:Char);

Var
P,X : Word;

Begin
If (ComPort<1) Or (ComPort>C_MaxCom) Or (Not C_PortOpen[ComPort]) Then Exit;

IO := Upcase(IO);
P := C_PortAddr[ComPort];

Inline($FA);
If (IO='I') Or (IO='B') Then
Begin
C_InHead[ComPort] := 0;
C_InTail[ComPort] := 0;
C_Status[ComPort] := (C_Status[ComPort] And $EC) Or $01;
X := Port[P] + Port[P+C_LSR] + Port[P+C_MSR] + Port[P+C_IIR];
End;
If (IO='O') Or (IO='B') Then
Begin
C_OutHead[ComPort] := 0;
C_OutTail[ComPort] := 0;
C_Status[ComPort] := (C_Status[ComPort] And $D3) Or $04;
X := Port[P+C_LSR] + Port[P+C_MSR] + Port[P+C_IIR];
End;
Inline($FB);
End;

{****************************************************************************}
{* *}
{* Procedure ComBufferLeft(ComPort:Byte; IO:Char) : Word *}
{* *}
{* ComPort:Byte -> Port # to use (1 - C_MaxCom). *}
{* Returns 0 if Port # invalid or unopened. *}
{* IO:Char -> Action code; I=Input, O=Output *}
{* Returns 0 if action code unrecognized. *}
{* *}
{* ComBufferLeft will return a number (bytes) indicating how much space *}
{* remains in the selected buffer. The INPUT buffer is checked if is *}
{* (I), and the output buffer is interrogated when is (O). Any other *}
{* "action code" will return a result of 0. Use this function when it is *}
{* important to avoid program delays due to calls to output procedures or *}
{* to prioritize the reception of data (to prevent overflows). *}
{* *}
{****************************************************************************}

Function ComBufferLeft(ComPort:Byte; IO:Char) : Word;

Begin
ComBufferLeft := 0;
If (ComPort<1) Or (ComPort>C_MaxCom) Or (Not C_PortOpen[ComPort]) Then Exit;
IO := Upcase(IO);

If IO = 'I' Then
If C_InHead[ComPort] >= C_InTail[ComPort] Then
ComBufferLeft := C_InSize[ComPort]-(C_InHead[ComPort]-C_InTail[ComPort])
Else
ComBufferLeft := C_InTail[ComPort]-C_InHead[ComPort];

If IO = 'O' Then
If C_OutHead[ComPort] >= C_OutTail[ComPort] Then
ComBufferLeft := C_OutHead[ComPort]-C_OutTail[ComPort]
Else
ComBufferLeft := C_OutSize[ComPort]-(C_OutTail[ComPort]-C_OutHead[ComPort]);
End;

{****************************************************************************}
{* *}
{* Procedure ComWaitForClear(ComPort:Byte) *}
{* *}
{* ComPort:Byte -> Port # to use (1 - C_MaxCom). *}
{* Exits immediately if out of range or port unopened. *}
{* *}
{* A call to ComWaitForClear will stop processing until the selected out- *}
{* put buffer is completely emptied. Typically used just before a call *}
{* to the CloseCom procedure to prevent premature cut-off of messages in *}
{* transit. *}
{* *}
{****************************************************************************}

Procedure ComWaitForClear(ComPort:Byte);

Var
Empty : Boolean;

Begin
If (ComPort<1) Or (ComPort>C_MaxCom) Or (Not C_PortOpen[ComPort]) Then Exit;
Repeat
Empty := (C_Status[ComPort] And $04) = $04;
Empty := Empty And ((Port[C_PortAddr[ComPort]+C_IER] And $02) = $00);
Until Empty;
End;

{****************************************************************************}
{* *}
{* Procedure ComWrite(ComPort:Byte; St:String) *}
{* *}
{* ComPort:Byte -> Port # to use (1 - C_MaxCom). *}
{* Exits immediately if out of range or port unopened. *}
{* St:String -> String to send *}
{* *}
{* Sends string out communications port . *}
{* *}
{****************************************************************************}

Procedure ComWrite(ComPort:Byte; St:String);

Var
X : Byte;

Begin
If (ComPort<1) Or (ComPort>C_MaxCom) Or (Not C_PortOpen[ComPort]) Then Exit;

For X := 1 To Length(St) Do
ComWriteChW(ComPort,St[X]);
End;

{****************************************************************************}
{* *}
{* Procedure ComWriteln(ComPort:Byte; St:String); *}
{* *}
{* ComPort:Byte -> Port # to use (1 - C_MaxCom). *}
{* Exits immediately if out of range or port unopened. *}
{* St:String -> String to send *}
{* *}
{* Sends string with a CR and LF appended. *}
{* *}
{****************************************************************************}

Procedure ComWriteln(ComPort:Byte; St:String);

Var
X : Byte;

Begin
If (ComPort<1) Or (ComPort>C_MaxCom) Or (Not C_PortOpen[ComPort]) Then Exit;

For X := 1 To Length(St) Do
ComWriteChW(ComPort,St[X]);
ComWriteChW(ComPort,#13);
ComWriteChW(ComPort,#10);
End;

{****************************************************************************}
{* *}
{* Procedure ComWriteWithDelay(ComPort:Byte; St:String; Dly:Word); *}
{* *}
{* ComPort:Byte -> Port # to use (1 - C_MaxCom). *}
{* Exits immediately if out of range or port unopened. *}
{* St:String -> String to send *}
{* Dly:Word -> Time, in milliseconds, to delay between each char. *}
{* *}
{* ComWriteWithDelay will send string to port , delaying *}
{* for milliseconds between each character. Useful for systems that *}
{* cannot keep up with transmissions sent at full speed. *}
{* *}
{****************************************************************************}

Procedure ComWriteWithDelay(ComPort:Byte; St:String; Dly:Word);

Var
X : Byte;

Begin
If (ComPort<1) Or (ComPort>C_MaxCom) Or (Not C_PortOpen[ComPort]) Then Exit;

ComWaitForClear(ComPort);
For X := 1 To Length(St) Do
Begin
ComWriteChW(ComPort,St[X]);
ComWaitForClear(ComPort);
Delay(Dly);
End;
End;

{****************************************************************************}
{* *}
{* Procedure ComReadln(ComPort:Byte; Var St:String; Size:Byte; Echo:Boolean)*}
{* *}
{* ComPort:Byte -> Port # to use (1 - C_MaxCom). *}
{* Exits immediately if out of range or port unopened. *}
{* St:String <- Edited string from remote *}
{* Size:Byte; -> Maximum allowable length of input *}
{* Echo:Boolean; -> Set TRUE to echo received characters *}
{* *}
{* ComReadln is the remote equivalent of the standard Pascal READLN pro- *}
{* cedure with some enhancements. ComReadln will accept an entry of up to *}
{* 40 printable ASCII characters, supporting ^H and ^X editing commands. *}
{* Echo-back of the entry (for full-duplex operation) is optional. All *}
{* control characters, as well as non-ASCII (8th bit set) characters are *}
{* stripped. If is enabled, ASCII BEL (^G) characters are sent *}
{* when erroneous characters are intercepted. Upon receipt of a ^M (CR), *}
{* the procedure is terminated and the final string result returned. *}
{* *}
{****************************************************************************}

Procedure ComReadln(ComPort:Byte; Var St:String; Size:Byte; Echo:Boolean);

Var
Len,X : Byte;
Ch : Char;
Done : Boolean;

Begin
St := '';
If (ComPort<1) Or (ComPort>C_MaxCom) Or (Not C_PortOpen[ComPort]) Then Exit;

Done := False;
Repeat
Len := Length(St);
Ch := Chr(Ord(ComReadChW(ComPort)) And $7F);

Case Ch Of
^H : If Len > 0 Then
Begin
Dec(Len);
St[0] := Chr(Len);
If Echo Then ComWrite(ComPort,#8#32#8);
End
Else
ComWriteChW(ComPort,^G);
^M : Begin
Done := True;
If Echo Then ComWrite(ComPort,#13#10);
End;
^X : Begin
St := '';
If Len = 0 Then ComWriteCh(ComPort,^G);
If Echo Then
For X := 1 to Len Do
ComWrite(ComPort,#8#32#8);
End;
#32..#127 : If Len < Size Then
Begin
Inc(Len);
St[Len] := Ch;
St[0] := Chr(Len);
If Echo Then ComWriteChW(ComPort,Ch);
End
Else
If Echo Then ComWriteChW(ComPort,^G);
Else
If Echo Then ComWriteChW(ComPort,^G)
End;

Until Done;
End;

{****************************************************************************}
{* *}
{* Function ComExist(ComPort:Byte) : Boolean *}
{* *}
{* ComPort:Byte -> Port # to use (1 - C_MaxCom) *}
{* Returns FALSE if out of range *}
{* Returns TRUE if hardware for selected port is detected & tests OK *}
{* *}
{* Function ComExist performs a high-speed short loopback test on the *}
{* selected port to determine if it indeed exists. Use this function *}
{* before attempts to OPEN a port for I/O (although this function is *}
{* called by OpenCom to prevent such an occurance). *}
{* NOTE! Although pains are taken to preserve the 8250 state before the *}
{* port test takes place, it is nonetheless recommended that this function *}
{* NOT be called while a port is actually OPEN. Doing so may cause the *}
{* port to behave erratically. *}
{* *}
{****************************************************************************}

Function ComExist(ComPort:Byte) : Boolean;

Const
TestByte1 : Byte = $0F;
TestByte2 : Byte = $F1;

Var
P : Word;
M,L,B1,B2,X : Byte;

Label
ERROR_EXIT;

Begin
Inline($9C/$FA);
ComExist := False;
If (ComPort<1) Or (ComPort>C_MaxPort) Then Exit;

P := C_PortAddr[ComPort];
M := Port[P+C_MCR]; { Save MCR }
L := Port[P+C_LCR]; { Save LCR }
Port[P+C_MCR] := $10; { Enable loopback mode }
Port[P+C_LCR] := $80; { Enable divisor latch mode }
B1 := Port[P]; { Save current baud rate }
B2 := Port[P+1];
Port[P] := 4; { Set baud rate to 28000 }
Port[P+1] := 0;
Port[P+C_LCR] := $03; { Transmit mode 28000:8N1 }

Delay(20); { Wait a bit }
X := Port[P] + Port[P]; { Clear register }
Port[P] := TestByte1; { Test byte #1 }
Delay(20); { Wait for loopback }
X := Port[P]; { Get byte echoed back }
If X <> TestByte1 Then Goto ERROR_EXIT; { Exit w/error if not echoed }
Port[P] := TestByte2; { Test byte #2 }
Delay(20); { Wait for loopback }
X := Port[P]; { Get echo-back byte }
If X <> TestByte2 Then Goto ERROR_EXIT; { Exit w/error if not echoed }
Port[P] := 0;

ComExist := True; { Test passed: Port exists }

ERROR_EXIT:
Port[P+C_LCR] := $80; { Restore baud rate }
Port[P] := B1;
Port[P+1] := B2;
Port[P+C_LCR] := L; { Restore parameters }
Port[P+C_MCR] := M; { Restore control lines }
Inline($9D);
End;

{****************************************************************************}
{* *}
{* Function ComTrueBaud(Baud:Longint) : Real *}
{* *}
{* Baud:Longint -> User baud rate to test. *}
{* Should be between C_MinBaud and C_MaxBaud. *}
{* Returns the actual baud rate based on the accuracy of the 8250 divider. *}
{* *}
{* The ASYNC12 communications package allows the programmer to select ANY *}
{* baud rate, not just those that are predefined by the BIOS or other *}
{* agency. Since the 8250 uses a divider/counter chain to generate it's *}
{* baud clock, many non-standard baud rates can be generated. However, *}
{* the binary counter/divider is not always capable of generating the *}
{* EXACT baud rate desired by a user. This function, when passed a valid *}
{* baud rate, will return the ACTUAL baud rate that will be generated. *}
{* The baud rate is based on a 8250 input clock rate of 1.73728 MHz. *}
{* *}
{****************************************************************************}

Function ComTrueBaud(Baud:Longint) : Real;

Var
X : Real;
Y : Word;

Begin
X := Baud;
If X < C_MinBaud Then X := C_MinBaud;
If X > C_MaxBaud Then X := C_MaxBaud;
ComTrueBaud := C_MaxBaud / Round($900/(X/50));
End;

{****************************************************************************}
{* *}
{* Procedure ComParams(ComPort:Byte; Baud:Longint; *}
{* WordSize:Byte; Parity:Char; StopBits:Byte); *}
{* *}
{* ComPort:Byte -> Port # to initialize. Must be (1 - C_MaxCom) *}
{* Procedure aborted if port # invalid or unopened. *}
{* Baud:Longint -> Desired baud rate. Should be (C_MinBaud - C_MaxBaud)*}
{* C_MinBaud or C_MaxBaud used if out of range. *}
{* WordSize:Byte -> Word size, in bits. Must be 5 - 8 bits. *}
{* 8-bit word used if out of range. *}
{* Parity:Char -> Parity classification. *}
{* May be N)one, E)ven, O)dd, M)ark or S)pace. *}
{* N)one selected if classification unknown. *}
{* StopBits:Byte -> # of stop bits to pad character with. Range (1-2) *}
{* 1 stop bit used if out of range. *}
{* *}
{* ComParams is used to configure an OPEN'ed port for the desired comm- *}
{* unications parameters, namely baud rate, word size, parity form and *}
{* # of stop bits. A call to this procedure will set up the port approp- *}
{* riately, as well as assert the DTR, RTS and OUT2 control lines and *}
{* clear all buffers. *}
{* *}
{****************************************************************************}

Procedure ComParams(ComPort:Byte; Baud:LongInt; WordSize:Byte; Parity:Char; StopBits:Byte);

Const
C_Stopbit1 = $00; { Bit masks for parity, stopbits }
C_Stopbit2 = $04;
C_NoParity = $00;
C_OddParity = $08;
C_EvenParity = $18;
C_MarkParity = $28;
C_SpaceParity = $38;

Var
X : Real;
Y,P : Word;
DivMSB,DivLSB : Byte;
WS,SB,PTY : Byte;

Begin
If (ComPort<1) Or (ComPort>C_MaxPort) Or (Not C_PortOpen[ComPort]) Then Exit;

Inline($9C/$FA);
P := C_PortAddr[ComPort];

{ Calculate baud rate divisors }

X := Baud;
If X < C_MinBaud Then X := C_MinBaud;
If X > C_MaxBaud Then X := C_MaxBaud;
Y := Round($900/(X/50));
DivMSB := Hi(Y);
DivLSB := Lo(Y);

{ Determine parity mask }
{ Default if unknown: No parity }

Case UpCase(Parity) Of
'N' : PTY := C_NoParity;
'E' : PTY := C_EvenParity;
'O' : PTY := C_OddParity;
'M' : PTY := C_MarkParity;
'S' : PTY := C_SpaceParity;
Else
PTY := C_NoParity;
End;

{ Determine stop-bit mask }
{ Default if out of range: 1 Stop bit }

Case StopBits Of
1 : SB := C_StopBit1;
2 : SB := C_StopBit2;
Else
SB := C_StopBit1;
End;

{ Determine word-size mask }
{ Default if out of range: 8 bit word size }

If (WordSize >= 5) And (WordSize <= 8) Then
WS := WordSize - 5
Else
WS := 3;

{ Initialize line-control register }

Port[P+C_LCR] := WS + SB + PTY;

{ Initialize baud rate divisor latches }

Port[P+C_LCR] := Port[P+C_LCR] Or $80;
Port[P] := DivLSB;
Port[P+1] := DivMSB;
Port[P+C_LCR] := Port[P+C_LCR] And $7F;
X := Port[P] + Port[P+C_LSR] + Port[P+C_MSR] + Port[P+C_IIR];

{ Assert RS323 control lines (DTR,RTS,OUT2) & exit }

Port[P+C_MCR] := $0B;
ClearCom(ComPort,'B');
Inline($9D);
End;

{****************************************************************************}
{* *}
{* Function OpenCom(ComPort:Byte; InBufferSize,OutBufferSize:Word):Boolean *}
{* *}
{* ComPort:Byte -> Port # to OPEN (1 - C_MaxCom) *}
{* Request will fail if out of range or port OPEN *}
{* InBufferSize:Word -> Requested size of input (receive) buffer *}
{* OutBufferSize:Word -> Requested size of output (transmit) buffer *}
{* Returns success/fail status of OPEN request (TRUE if OPEN successful) *}
{* *}
{* OpenCom must be called before any activity (other than existence check, *}
{* see the ComExist function) takes place. OpenCom initializes the *}
{* interrupt drivers and serial communications hardware for the selected *}
{* port, preparing it for I/O. Memory for buffers is allocated on the *}
{* Pascal "heap", thus freeing data-segment memory for larger more data- *}
{* intensive programs. Once a port has been OPENed, a call to ComParams *}
{* should be made to set up communications parameters (baud rate, parity *}
{* and the like). Once this is done, I/O can take place on the port. *}
{* OpenCom will return a TRUE value if the opening procedure was success- *}
{* ful, or FALSE if it is not. *}
{* *}
{****************************************************************************}

Function OpenCom(ComPort:Byte; InBufferSize,OutBufferSize:Word) : Boolean;

Var
TempVec : Pointer;
P : Word;
IntLn,X : Byte;

Begin
{ Ensure that port was not previously open }

OpenCom := False;
If (ComPort<1) Or (ComPort>C_MaxPort) Or C_PortOpen[ComPort] Then Exit;
If Not ComExist(ComPort) Then Exit;

{ Clear any pending activity from 8250 interrupt queue }

Inline($9C/$FA);
P := C_PortAddr[ComPort];
Port[P+C_IER] := $0D;
X := Port[P] + Port[P+C_LSR] + Port[P+C_MSR] + Port[P+C_IIR];

{ Set up interrupt vectors & 8259 PIC }

IntLn := C_PortInt[ComPort];
GetIntVec(8+IntLn,TempVec);
If C_OldINTVec[IntLn] <> TempVec Then
Begin
C_OldINTVec[IntLn] := TempVec;
SetIntVec(8+IntLn,@Int_Handler);
Port[$21] := Port[$21] And (($01 SHL IntLn) XOR $FF);
X := Port[$21];
Port[$20] := $20;
End;

{ Allocate memory for I/O buffers }

C_InSize[ComPort] := InBufferSize;
C_OutSize[ComPort] := OutBufferSize;
GetMem(C_InBufPtr[ComPort],InBufferSize);
GetMem(C_OutBufPtr[ComPort],OutBufferSize);

{ Set up default parameters for port }

C_RTSOn[ComPort] := InBufferSize - 2;
C_RTSOff[ComPort] := InBufferSize - 1;
C_StartChar[ComPort] := ^Q;
C_StopChar[ComPort] := ^S;
C_Ctrl[ComPort] := 0;
C_Status[ComPort] := 5;
C_PortOpen[ComPort] := True;
OpenCom := True;

Inline($9D);
End;

{****************************************************************************}
{* *}
{* Procedure CloseCom(ComPort:Byte) *}
{* *}
{* ComPort:Byte -> Port # to close *}
{* Request ignored if port closed or out of range. *}

{* *}
{* CloseCom will un-link the interrupt drivers for a port, deallocate it's *}
{* buffers and drop the DTR and RTS signal lines for a port opened with *}
{* the OpenCom function. It should be called before exiting your program *}
{* to ensure that the port is properly shut down. *}
{* NOTE: CloseCom shuts down a communications channel IMMEDIATELY, *}
{* even if there is data present in the input or output buffers. *}
{* Therefore, you may wish to call the ComWaitForClear procedure *}
{* before closing the ports. *}
{* *}
{****************************************************************************}

Procedure CloseCom(ComPort:Byte);

Var
ClosePort : Boolean;
P,IntLn,X : Word;

Begin
If (ComPort<1) Or (ComPort>C_MaxPort) Or (Not C_PortOpen[ComPort]) Then Exit;

{ Drop RS232 control lines (DTR,RTS,OUT2) and reset 8250 interrupt mode }

Inline($9C/$FA);
P := C_PortAddr[ComPort];
Port[P+C_MCR] := 0;
Port[P+C_IER] := 0;
C_PortOpen[ComPort] := False;

{ Reset INT vectors & 8259 PIC if all COMs on selected INT are closed }

IntLn := C_PortInt[ComPort];
ClosePort := True;
For X := 1 To C_MaxCom Do
If C_PortOpen[X] And (C_PortInt[X] = IntLn) Then
ClosePort := False;

If ClosePort Then
Begin
X := Port[$21];
Port[$21] := X Or ($01 SHR IntLn);
X := Port[$21];
Port[$20] := $20;
SetIntVec(8+IntLn,C_OldINTVec[IntLn]);
C_OldINTVec[IntLn] := Nil;
End;
X := Port[P] + Port[P+C_LSR] + Port[P+C_MSR] + Port[P+C_IIR];

{ Deallocate buffers }

FreeMem(C_InBufPtr[ComPort],C_InSize[ComPort]);
FreeMem(C_OutBufPtr[ComPort],C_OutSize[ComPort]);
Inline($9D);
End;

{****************************************************************************}
{* *}
{* Procedure CloseAllComs *}
{* *}
{* CloseAllComs will CLOSE all currently OPENed ports. See the CloseCom *}
{* procedure description for more details. *}
{* *}
{****************************************************************************}

Procedure CloseAllComs;

Var
X : Byte;

Begin
For X := 1 To C_MaxCom Do
If C_PortOpen[X] Then
CloseCom(X);
End;

{****************************************************************************}
{* *}
{* UNIT Initialization Code *}
{* *}
{****************************************************************************}

Begin
For x := 1 to C_MaxPort Do
Begin
C_PortOpen[x] := False;
C_InBufPtr[x] := Nil;
C_OutBufPtr[x] := Nil;
C_OldIntVec[x] := Nil;
C_InHead[x] := 0;
C_OutHead[x] := 0;
C_InTail[x] := 0;
C_OutTail[x] := 0;
C_InSize[x] := 0;
C_OutSize[x] := 0;
C_RTSOn[x] := 0;
C_RTSOff[x] := 0;
C_StartChar[x] := ^Q;
C_StopChar[x] := ^S;
C_Status[x] := 5;
C_Ctrl[x] := 0;
C_XL3Ptr[x] := 0;
Port[C_PortAddr[x]+C_MCR] := $00;
End;
End.


  3 Responses to “Category : Pascal Source Code
Archive   : ASYNC12.ZIP
Filename : ASYNC12.PAS

  1. Very nice! Thank you for this wonderful archive. I wonder why I found it only now. Long live the BBS file archives!

  2. This is so awesome! 😀 I’d be cool if you could download an entire archive of this at once, though.

  3. But one thing that puzzles me is the “mtswslnkmcjklsdlsbdmMICROSOFT” string. There is an article about it here. It is definitely worth a read: http://www.os2museum.com/wp/mtswslnk/