SERIAL
Contents of this page
SERIAL.PAS
{************************************************}
{ }
{ UNIT SERIAL }
{ Copyright (c) 1997 by Tom Wellige }
{ Donated as FREEWARE }
{ }
{ E-Mail: wellige@geocities.com }
{ }
{************************************************}
unit Serial;
interface
uses Objects;
{$I SERIAL.INC}
type
ModeStr = String[3];
const
{----------------------------------
COM Object Version
high byte = major version
low byte = minor version
----------------------------------}
COMVersion : word = $0100;
{----------------------------------
different Modes for COM usage
----------------------------------}
mdNormal = $0; { no special modes }
mdTXBuffered = $1; { use TX interrupt and buffer }
mdModem = $2; { listen to modem interrupts }
mdSignalling = $4; { using the signalling mechanism }
mdRXError = $8; { Receive Error interrupts }
{----------------------------------
Error- and Statusconstants
----------------------------------}
COM_OK = $0000;
COM_ERR_IS_OPEN = $0010;
COM_ERR_NOT_SUPPORTED = $0011;
COM_ERR_ALLOC_RX = $0012;
COM_ERR_ALLOC_TX = $0013;
COM_ERR_NOT_OPEN = $0020;
COM_ERR_FREE_RX = $0021;
COM_ERR_FREE_TX = $0022;
COM_OPEN = $0030;
type
{----------------------------------
Receive and Transmit buffer type
----------------------------------}
PBufferType = ^TBufferType;
TBufferType = array[0..65534] of byte;
{----------------------------------
COM Object
----------------------------------}
PComPort = ^TComPort;
TComPort = object (TObject)
constructor Init(NewPort: Byte; NewBaud: Word;
NewParMode: ModeStr; NewSize: Word;
NewMode: Word; NewBase: Word; NewIRQ: Byte);
function Com_On: Boolean;
function Com_Off: Boolean;
function GetParMode(var m: ModeStr): ModeStr;
function PutC(ch: char): integer;
function WriteBuf(const CBuf; Count: Word): integer;
function WriteStr(CStr: string): integer;
function GetC(var ch: char): integer;
function PeekC(var ch: char): integer;
function ReadBuf(var CBuf; Count: Word): integer;
function ReadStr(var CStr: string): integer;
function BufCount: integer;
procedure FlushRX;
destructor Done; virtual;
private
PortBase: Word;
IRQ: Byte;
BaudRate: Word;
NBits: Byte;
NStopBits: Byte;
Parity: Byte;
BufSize: Word;
ComIsOn: Boolean;
ComIsInit: Boolean;
RX, TX: PBufferType;
intmask: Byte;
intnum: Byte;
intcom2: Boolean;
RX_out: Word;
RX_in: Word;
TX_out: Word;
TX_in: Word;
ComMode: Word;
function SetBaud(NewBaud: Word): Boolean;
function SetMode(NewMode: ModeStr): Boolean;
procedure Clearstatus;
function IntNr: byte;
function Mode(m: word): boolean;
end;
implementation
uses DOS;
type
PChar = ^Char;
const
Com : PComPort = nil;
RXErrorInt = 6;
RXInt = 4;
TXInt = 2;
ModemInt = 0;
var
ExitSave : pointer;
OldComVec: Pointer;
{-------------------------------------
Interrupt Service Routines
-------------------------------------}
procedure HandleInterrupt(IntType: byte);
begin
with Com^ do
case IntType of
RXInt:
begin
RX^[RX_in]:= Port[PortBase+RXR];
inc(RX_in); if RX_in = BufSize then RX_in:=0;
end;
TXInt:
begin
if TX_out <> TX_in then
begin
Port[PortBase+TXR]:= TX^[TX_out];
inc(TX_out); if TX_out = BufSize then TX_out:=0;
end;
end;
ModemInt:
begin
end;
RXErrorInt:
begin
end;
end;
end;
procedure Com_Int; interrupt;
var IntType: byte;
begin
asm cli end;
with Com^ do
begin
if intcom2 then port[ICR2]:= EOI;
port[ICR1]:= EOI;
IntType:= Port[PortBase+IIR];
while ( IntType <> 1 ) do
begin
HandleInterrupt(IntType);
IntType:= Port[PortBase+IIR]
end;
end;
asm sti end;
end;
{-------------------------------------
PUBLIC TComPort Functions
-------------------------------------}
constructor TComPort.Init(NewPort: byte; NewBaud: Word;
NewParMode: ModeStr; NewSize: Word;
NewMode: Word; NewBase: Word; NewIRQ: Byte);
begin
inherited Init;
if ( NewBase = 0 ) then
begin
case NewPort of
COM1: PortBase:= COM1BASE;
COM2: PortBase:= COM2BASE;
COM3: PortBase:= COM3BASE;
COM4: PortBase:= COM4BASE;
end;
end else
PortBase:= NewBase;
if ( NewIRQ = 0 ) then
begin
case NewPort of
COM1, COM3: IRQ:= 4;
COM2, COM4: IRQ:= 3;
end;
end else
IRQ:= NewIRQ;
if (NOT SetBaud(NewBaud)) then
exit;
if (NOT SetMode(NewParMode)) then
exit;
BufSize:= NewSize;
ComMode:= NewMode;
intmask:= 1 shl IRQ;
intcom2:= ( IRQ > 7 );
intnum := IntNr;
ComIsInit:= TRUE;
end;
function TComPort.GetParMode(var m: ModeStr): ModeStr;
begin
m[0]:= #3;
case Parity of
NO_PARITY: m[2]:= 'N';
EVEN_PARITY: m[2]:= 'E';
ODD_PARITY: m[2]:= 'O';
else
m[2]:= ' ';
end;
m[1]:= Char(NBits + $30);
m[3]:= Char(NStopBits + $30);
GetParMode:= m;
end;
function TComPort.Com_On: Boolean; { Tell Modem we are ready to go }
var
Mask: Byte;
d: Byte;
ints: byte;
begin
{ allocate Receive Buffer }
{$I-} GetMem (RX, BufSize); {$I+}
if IOresult <> 0 then
begin
Com_On:= FALSE;
exit;
end;
RX_in:= 0; RX_out:= 0;
FillChar(RX^, BufSize, 0);
if Mode(mdTXBuffered) then
begin
{ allocate Transmit Buffer }
{$I-} GetMem (TX, BufSize); {$I+}
if IOresult <> 0 then
begin
{$I-} FreeMem(RX, BufSize); {$I+}
Com_On:= FALSE;
exit;
end;
TX_in:= 0; TX_out:= 0;
FillChar(TX^, BufSize, 0);
end;
{ disable interrupts }
asm cli end;
{ set new interrupt service routine }
GetIntVec(IntNr, OldComVec);
SetIntVec(IntNr, @Com_Int);
{ setup and release interrupts }
ints:= 1; { Receive Interrupts }
if Mode(mdTXBuffered) then
ints:= ints or $2; { Receive Error Interrupts }
if Mode(mdRXError) then
ints:= ints or $4; { Send Interrupts }
if Mode(mdModem) then
ints:= ints or $8; { Modem Interrupts }
port[PortBase+IER]:= ints;
port[PortBase+IIR]:= 1;
{ enable IRQ on PIC }
if intcom2 then
port[IMR2]:= port[IMR2] and (not intmask)
else
port[IMR1]:= port[IMR1] and (not intmask);
{ reset UART }
ClearStatus;
Com:= PComPort(@self);
{ enable interrupts }
asm sti end;
ComIsOn:= TRUE;
end;
function TComPort.Com_Off: Boolean; { Go Offline }
var
Mask: Byte;
begin
Com := nil;
ComIsOn:= FALSE;
{ dissable interrupts }
asm cli end;
{ disable all interrupts on UART }
port[PortBase+IER]:= 0;
{ disable IRQ on PIC }
if intcom2 then
port[IMR2]:=port[IMR2] or intmask
else
port[IMR1]:=port[IMR1] or intmask;
{port[PortBase+IIR]:= 0;}
{ reset UART }
ClearStatus;
{ set old interrupt service routine }
SetIntVec(IntNr, @OldComVec);
{ enable interrupts }
asm sti end;
{ release RX buffer }
{$I-} FreeMem(RX, BufSize); {$I+}
end;
function TComPort.BufCount: integer;
begin
if (RX_in >= RX_out) then
BufCount:= RX_in - RX_out
else
BufCount:= (BUFSIZE - RX_out) + RX_in;
end;
procedure TComPort.FlushRX;
begin
RX_in:= RX_out;
TX_in:= TX_out;
end;
destructor TComPort.Done;
begin
ComIsInit:= FALSE;
inherited Done;
end;
{-------------------------------------
TComPort's SEND Functions
-------------------------------------}
function TComPort.PutC(ch: char): integer;
const
TTimeOut: Word = 65535;
begin
if (NOT ComIsOn) then
begin
PutC:= 0;
Exit;
end;
{Wait for Transmitter to Clear}
while ( (Port[PortBase+LSR] AND Byte(XMTRDY)) = 0) do
if ( TTimeOut = 0) then
begin
PutC:= 0;
write(#7);
exit;
end else
Dec(TTimeOut);
Port[PortBase+TXR]:= Byte(ch);
PutC:= 1;
end;
{ WriteBuf sends Count bytes to the port. CBUF can be any type
of variable, and need not be a string (in fact it is best to use
WriteStr to send strings. The calling routine must know how many
bytes to send }
function TComPort.WriteBuf(const CBuf; Count: Word): integer;
var
OutCount: Word;
Buf: PChar;
TX_start: word;
begin
if (NOT ComIsOn) then
begin
WriteBuf:= 0;
Exit;
end;
Buf:= PChar(CBuf);
OutCount:= 0;
if Mode(mdTXBuffered) then
begin
TX_start:= TX_in;
while ( Count > 0) do
begin
TX^[TX_in]:= ord(Buf^);
inc(OutCount);
inc(Buf);
dec(Count);
inc(TX_in); if TX_in = BufSize then TX_in:=0;
{ Overrun ? }
if TX_in = TX_out then Count:= 0;
end;
{ have to send the first byte ? }
if TX_start = TX_out then
begin
inc(TX_out); if TX_out = BufSize then TX_out:=0;
PutC(char(TX^[TX_start]));
end;
end else
while (Count > 0) do
begin
if (PutC( Buf^ ) = 0) then
Count:= 0
else
begin
Inc(OutCount);
Inc(Buf);
Dec(Count);
end;
end;
WriteBuf:= OutCount;
end;
{Send a PASCAL string to the COM port }
function TComPort.WriteStr(CStr: string): integer;
var
OutCount: Word;
Buf: PChar;
begin
Buf:= PChar(@CStr[1]); { point to first real ASCII char }
WriteStr:= WriteBuf(Buf, Length(CStr));
end;
{-------------------------------------
TComPort's RECEIVE Functions
-------------------------------------}
function TComPort.GetC(var ch: Char): integer;
begin
if (RX_in = RX_out) then
GetC:= 0
else
begin
ch:= Char( RX^[RX_out] AND $ff );
inc(RX_out); if RX_out = BufSize then RX_out:= 0;
GetC:= 1;
end;
end;
function TComPort.PeekC(var ch: Char): integer;
begin
if (RX_in = RX_out) then
PeekC:= 0
else
begin
ch:= Char( RX^[RX_out] AND $ff );
PeekC:= 1;
end;
end;
{ ReadBuf reads Count bytes from the port. CBUF can be any type
of variable, and need not be a string (in fact it is best to use
ReadStr to send strings. The calling routine must know how many
bytes to read and no type or bounds checking is done so it is possible
to read beyond the end of the array or variable!}
function TComPort.ReadBuf(var CBuf; Count: Word): integer;
var
InCount: Word;
Buf: PChar;
begin
Buf:= PChar(@CBuf);
InCount:= 0;
While (Count > 0) do
begin
if (GetC( Buf^ ) = 0) then
Count := 0
else
begin
Inc(InCount);
Inc(Buf);
Dec(Count);
end;
end;
ReadBuf:= InCount;
end;
{ Read a PASCAL string from the COM port }
function TComPort.ReadStr(var CStr: string): integer;
var
n, i: integer;
begin
n := 1;
While ( GetC(CStr[n]) <> 0 ) do
Inc(n);
CStr[0]:= Chr(n-1);
end;
{-------------------------------------
PRIVATE TComPort Functions
-------------------------------------}
function TComPort.SetBaud(NewBaud: Word): Boolean;
var c: Byte;
begin
if (NewBaud <= 0) OR (PortBase = 0) then
begin
SetBaud:= FALSE;
exit;
end;
Port[PortBase+LCR]:= $80;
Port[PortBase+DLL]:= Lo(word(115200 div NewBaud));
port[PortBase+DLH]:= Hi(word(115200 div NewBaud));
port[PortBase+MCR]:= $0B;
SetBaud:= TRUE;
end;
function TComPort.SetMode(NewMode: ModeStr): Boolean;
var
OK: Boolean;
tst: Byte;
begin
OK:= TRUE;
case NewMode[2] of
'N': Parity:= NO_PARITY;
'E': Parity:= EVEN_PARITY;
'O': Parity:= ODD_PARITY;
else
OK:= FALSE;
end;
NBits:= Byte(NewMode[1]) - $30;
NStopBits:= Byte(NewMode[3]) - $30;
if (NBits > 8) OR (NBits < 5) then
OK:= FALSE;
if (NStopBits > 2) OR (NStopBits < 1) then
OK:= FALSE;
if (OK <> FALSE) AND (PortBase <> 0) then
begin
Port[PortBase+LCR]:= Parity OR (NBits-5) OR (4*(NStopBits-1));
{ Make sure it got there right }
tst:= Port[PortBase+LCR];
if ( Parity <> (tst AND $18) )
OR ( NBits <> (tst AND $03 + 5) )
OR ( NStopBits <> ((tst AND $04) div 4 + 1) ) then
OK:= FALSE;
end;
SetMode:= OK;
end;
procedure TComPort.Clearstatus;
begin
if port[PortBase+RXR] <> 0 then; { dummy-Read }
if port[PortBase+LSR] <> 0 then;
if port[PortBase+MSR] <> 0 then;
if intcom2 then port[ICR2]:= EOI;
port[ICR1]:= EOI;
end;
function TComPort.IntNr: byte;
begin
if IRQ < 8 then IntNr:= IRQ + 8
else IntNr:= IRQ + $68;
end;
function TCOMPort.Mode(m: word): boolean;
begin
Mode:= ComMode and m <> 0;
end;
{-------------------------------------
EXIT Procedure
-------------------------------------}
{$F+}
procedure comexit;
begin
if assigned(Com) then Com^.Com_Off;
exitproc:= exitsave;
end;
{$F-}
begin
exitsave:=exitproc;
exitproc:=@comexit;
end.
SERIAL.INC
{---------------------------------------------------------------------*
FILENAME: SERIAL.INC
Some definitions used by SERIAL.PAS
*--------------------------------------------------------------------}
const
COM1 = 1;
COM2 = 2;
COM3 = 3;
COM4 = 4;
COM1BASE = $3F8; { Default Base port address for COM1 }
COM2BASE = $2F8; { Default Base port address for COM2 }
COM3BASE = $3E8; { Default Base port address for COM3 }
COM4BASE = $2E8; { Default Base port address for COM4 }
{
The 8250 UART has 10 registers accessible through 7 port addresses.
Here are their addresses relative to COM1BASE and COM2BASE. Note
that the baud rate registers, (DLL) and (DLH) are active only when
the Divisor-Latch Access-Bit (DLAB) is on. The (DLAB) is bit 7 of
the (LCR).
o TXR Output data to the serial port.
o RXR Input data from the serial port.
o LCR Initialize the serial port.
o IER Controls interrupt generation.
o IIR Identifies interrupts.
o MCR Send contorl signals to the modem.
o LSR Monitor the status of the serial port.
o MSR Receive status of the modem.
o DLL Low byte of baud rate divisor.
o DHH High byte of baud rate divisor.
}
TXR = 0; { Transmit register (WRITE) }
RXR = 0; { Receive register (READ) }
IER = 1; { Interrupt Enable }
IIR = 2; { Interrupt ID }
LCR = 3; { Line control }
MCR = 4; { Modem control }
LSR = 5; { Line Status }
MSR = 6; { Modem Status }
DLL = 0; { Divisor Latch Low }
DLH = 1; { Divisor latch High }
{-------------------------------------------------------------------*
Bit values held in the Line Control Register (LCR).
bit meaning
--- -------
0-1 00=5 bits, 01=6 bits, 10=7 bits, 11=8 bits.
2 Stop bits.
3 0=parity off, 1=parity on.
4 0=parity odd, 1=parity even.
5 Sticky parity.
6 Set break.
7 Toggle port addresses.
*-------------------------------------------------------------------}
NO_PARITY = $00;
EVEN_PARITY = $18;
ODD_PARITY = $08;
{-------------------------------------------------------------------*
Bit values held in the Line Status Register (LSR).
bit meaning
--- -------
0 Data ready.
1 Overrun error - Data register overwritten.
2 Parity error - bad transmission.
3 Framing error - No stop bit was found.
4 Break detect - End to transmission requested.
5 Transmitter holding register is empty.
6 Transmitter shift register is empty.
7 Time out - off line.
*-------------------------------------------------------------------}
RCVRDY = $01;
OVRERR = $02;
PRTYERR = $04;
FRMERR = $08;
BRKERR = $10;
XMTRDY = $20;
XMTRSR = $40;
TIMEOUT = $80;
{-------------------------------------------------------------------*
Bit values held in the Modem Output Control Register (MCR).
bit meaning
--- -------
0 Data Terminal Ready. Computer ready to go.
1 Request To Send. Computer wants to send data.
2 auxillary output #1.
3 auxillary output #2.(Note: This bit must be
set to allow the communications card to send
interrupts to the system)
4 UART ouput looped back as input.
5-7 not used.
*------------------------------------------------------------------}
DTR = $01;
RTS = $02;
MC_INT = $08;
{------------------------------------------------------------------*
Bit values held in the Modem Input Status Register (MSR).
bit meaning
--- -------
0 delta Clear To Send.
1 delta Data Set Ready.
2 delta Ring Indicator.
3 delta Data Carrier Detect.
4 Clear To Send.
5 Data Set Ready.
6 Ring Indicator.
7 Data Carrier Detect.
*------------------------------------------------------------------}
CTS = $10;
DSR = $20;
DCD = $80;
{------------------------------------------------------------------*
Bit values held in the Interrupt Enable Register (IER).
bit meaning
--- -------
0 Interrupt when data received.
1 Interrupt when transmitter holding reg. empty.
2 Interrupt when data reception error.
3 Interrupt when change in modem status register.
4-7 Not used.
*------------------------------------------------------------------}
RX_INT = $01;
{------------------------------------------------------------------*
Bit values held in the Interrupt Identification Register (IIR).
bit meaning
--- -------
0 Interrupt pending
1-2 Interrupt ID code
00=Change in modem status register,
01=Transmitter holding register empty,
10=Data received,
11=reception error, or break encountered.
3-7 Not used.
*------------------------------------------------------------------}
RX_ID = $04;
RX_MASK = $07;
{
These are the port addresses of the 8259 Programmable Interrupt
Controller (PIC).
}
IMR1 = $21; { Interrupt Mask Register port }
ICR1 = $20; { Interrupt Control Port }
{
These are the port addresses of the second 8259 Programmable Interrupt
Controller (PIC2).
}
IMR2 = $A1; { Interrupt Mask Register port }
ICR2 = $A0; { Interrupt Control Port }
{
An end of interrupt needs to be sent to the Control Port of
the 8259 when a hardware interrupt ends.
}
EOI = $20; { End Of Interrupt }
{
The (IMR) tells the (PIC) to service an interrupt only if it
is not masked (FALSE).
}
IRQ3 = $0B; { Actual IRQ Number }
IRQ4 = $0C;
IRQ5 = $0D;
IRQ7 = $0F;
IRQ3MASK = $F7; { COM2, bit 3 }
IRQ4MASK = $EF; { COM1, bit 4 }
{ IRQ5MASK = $DF; { LPT2 or BUS MOUSE, bit 5 }
{ IRQ7MASK = $7F; { LPT1, bit 7 }
COMTEST.PAS
uses serial, crt;
var
Com: TComPort;
cs, cr: Char;
str: string;
begin
clrscr;
Com.Init(2, 19200, '8N1', $4000, mdNormal, 0, 0);
Com.Com_On;
cs := #0;
cr := #0;
str:= 'at&v'#13;
while cs <> #27 do
begin
if keypressed then
begin
cs:= readkey;
if cs <> #27 then
if cs = '#' then
begin
Com.WriteStr('atdt 06071284420'#13);
end else
if Com.PutC(cs) = 1 then
begin
if cs = #13 then write(#10);
end;
end;
if Com.GetC(cr) = 1 then write(cr);
end;
Com.Com_Off;
Com.Done;
end.
