Unit Serial;
{ SERIAL.PAS - 14 Jan 91
15 Jan 91 (Last Modification)
This unit is designed to allow the user to use a FOSSIL driver for
a serial unit that is event-driven aware. To do this, the input
from the modem is given an event status number just like the mouse or
keyboard. All input is then routed directly through the event driver
for all your dialogs to use. The output to the modem is in the form
of a series of events that you can use or direct calls via an object.
Note that these calls are the basics and do not halt for buffer
overruns in either Tx or Rx. Your application program will have to
monitor the serCarrier and serTxBuffer events to keep track if there
is a carrier or if there is room in the TX buffer for more to be
sent.
Note that this unit was written to take advantage of many of the
FOSSIL drivers out on the market such as X00.SYS or BNU.COM. If
the system does not detect a FOSSIL driver in memory, then it
resorts to standard interrupt driven serial I/O without the ability
to open up more than one port at a time. (Currently... This may
change in the future)
----------------
REVISION HISTORY
----------------
01-14-91 Designed and created the test version of the FOSSIL only
version. The internal serial routines have not yet been
written to be used with this Unit. Created the Event evSerial.
Added a bunch of BASIC routines to the serial driver and made sure
that the FSerial.Idle routine was passing the correct stuff!
01-15-91 Added Event checks for Carrier and Transmission Buffer
overflow.
01-22-91 Rearranged the LSList system as a TCollection to improve
the disposal procedure. Also created the serCarrierReq and
serTxBufferReq events so that the user can request a port status in
case for some reason he missed the toggle event.
01-27-91 Created a command entry to return a string if the receive
buffer has several characters in it insted of trying to send
each and every one via an event. Also changed the SERIAL.PAS activated
events to seperate procedures so that you can call them directly if you
inherit the Object or use it seperatly. There is also a procedure to
disable this system from creating Command events. You can use it
either way now...
}
{$F+,O+,R-,S-}
{$DEFINE FOSSILDRIVER} {This will check if a FOSSIL driver is in place and
will install a standard serial port if the driver
is not in memory. If this is undefined, then the
FOSSIL routines are not compiled in and you use the
standard Serial routines regardless}
{ DEFINE SERIALDRIVER} {If this is undefined, then all the standard serial
routines are left out. If the FOSSIL driver is not
in memory then you are out of luck...}
Interface
Uses Dos, Drivers, Views, Objects;
{----------------------------------------------------------------------------}
CONST evSerial = $8000; {Define a Serial Event Message}
stDupSerial = 195; {Duplicate Port Requested}
stOpenError = 194; {Error opening the port}
stInvalidPort = 193; {Invalid port number}
stInvalidBaud = 192; {Invalid selected baud rate}
stCharUnavail = 191; {Tried to read a char, but none available}
serBaud = 7100; {Set Baud Rate (Port,Baud)}
{Fmt: InfoByte=Port, InfoLong=+Baud SHL 16}
serSend = 7101; {Send a char (Port,Byte)}
{Fmt: InfoByte=Port, InfoWord=+Byte SHL 8}
serInit = 7104; {Initialize a port (Port)}
serDeInit = 7105; {Remove a port (Port)}
serRaiseDTR = 7106; {Raise the DTR (Port)}
serLowerDTR = 7107; {Lower the DTR (Port)}
serPurgeRx = 7108; {Purge the Recv buf (Port)}
serPurgeTx = 7109; {Purge output buf (Port)}
serFlow = 7115; {Set Flow Control (Port,Flow)}
{Fmt: InfoByte=Port, InfoWord=+Flow SHL 8}
serCarrierReq = 7116; {Request the Carrier Status (Port)}
serTxBufferReq= 7117; {Request Tx Buffer Status (Port)}
serEventGenOn = 7118; {Turn on Serial Event Generation}
serEventGenOff= 7119; {Turn off Serial Event Generation}
serCarrier = 7120; {Carrier Status (Port,Status)}
serTxBuffer = 7121; {TxBuffer Status (Port,Status)}
serRecvChar = 7122; {Received a char (Port,Byte)}
serRecvLine = 7123; {Received a line (Port,Ptr -> String)}
{----------------------------------------------------------------------------}
TYPE FossilList = RECORD
strsiz : WORD;
majver : BYTE;
minver : BYTE;
ident : POINTER;
ibufr : WORD;
ifree : WORD;
obufr : WORD;
ofree : WORD;
swidth : BYTE;
sheight : BYTE;
baud : BYTE;
END;
TYPE PTypes = (SerNone,SerStd,SerFossil);
PSList = ^LSList;
LSList = OBJECT(TObject)
SerialPort : BYTE;
PortType : PTypes;
BaudBits : BYTE;
FlowControl : BYTE;
Carrier : BOOLEAN;
TxBuffer : BOOLEAN;
CONSTRUCTOR Init(Port : BYTE);
CONSTRUCTOR Load(VAR S : TStream);
PROCEDURE Store(VAR S : TStream);
DESTRUCTOR Done; VIRTUAL;
END;
RecvRec = RECORD
Port : BYTE;
St : STRING
END;
TYPE PSerial = ^FSerial;
FSerial = OBJECT(TView)
OpenPorts : PCollection;
LastPort : BYTE;
EventGenerate : BOOLEAN;
{$IFDEF FOSSILDRIVER}
FossilUsed : BOOLEAN;
FossilInfo : FossilList;
{$ENDIF}
ErrorInfo : INTEGER;
CONSTRUCTOR Init;
CONSTRUCTOR Load(VAR S : TStream);
PROCEDURE Store(VAR S : TStream);
PROCEDURE InitPort(Port : BYTE);
PROCEDURE RemovePort(Port : BYTE);
PROCEDURE SetBaud(Port : BYTE; Baud : WORD);
PROCEDURE PurgeOutputBuf(Port : BYTE);
PROCEDURE PurgeInputBuf(Port : BYTE);
PROCEDURE SendChar(Port : BYTE; Ch : BYTE);
PROCEDURE SendLine(Port : BYTE; Ln : STRING);
FUNCTION RecvChar(Port : BYTE) : CHAR;
PROCEDURE DTRState(Port : BYTE; UpDown : BOOLEAN);
PROCEDURE FlowControl(Port : BYTE; Item : BYTE);
PROCEDURE SerialRequest(ReqType : WORD; Port : BYTE);
PROCEDURE GenerateEvents(Action : BOOLEAN);
PROCEDURE Reset;
DESTRUCTOR Done; VIRTUAL;
PROCEDURE Idle; VIRTUAL;
PROCEDURE HandleEvent(VAR Event : TEvent); VIRTUAL;
END;
CONST RSerial: TStreamRec = (
ObjType: 7100;
VmtLink: Ofs(TypeOf(FSerial)^);
Load: @FSerial.Load;
Store: @FSerial.Store
);
RSList: TStreamRec = (
ObjType: 7101;
VmtLink: Ofs(TypeOf(LSList)^);
Load: @LSList.Load;
Store: @LSList.Store
);
PROCEDURE RegisterSerial;
VAR SerialSys : PSerial;
Implementation
CONST Fossil = $14;
MaxPorts = 4;
Bauds : ARRAY [0..7] OF WORD
= (19200,38400,300,600,1200,2400,4800,9600);
VAR Regs : REGISTERS;
FossilPresent : BOOLEAN;
RecvBuf : RecvRec;
{----------------------------------------------------------------------------}
CONSTRUCTOR LSList.Init;
BEGIN
IF (Port < 0) OR (Port >= MaxPorts) THEN
FAIL;
SerialPort := Port;
PortType := serNone;
BaudBits := $03;
FlowControl := $01;
Carrier := FALSE;
TxBuffer := FALSE;
{$IFDEF FOSSILDRIVER}
IF FossilPresent THEN
BEGIN
Regs.AH := $04;
Regs.BX := $0000;
Regs.DX := Port;
INTR(Fossil,Regs);
IF Regs.AX = $1954 THEN
BEGIN
PortType := SerFossil;
Regs.AH := $0F; {Set for Xon/Xoff processing}
Regs.AL := FlowControl;
INTR(Fossil,Regs)
END
END;
{$ENDIF}
{$IFDEF SERIALDRIVER}
IF PortType = SerNone THEN
BEGIN
{Set up standard port with PortType=SerStd}
END;
{$ENDIF}
IF PortType = SerNone THEN
FAIL
END;
{----------------------------------------------------------------------------}
CONSTRUCTOR LSList.Load;
BEGIN
S.Read(SerialPort,SIZEOF(SerialPort));
S.Read(PortType,SIZEOF(PortType));
S.Read(BaudBits,SIZEOF(BaudBits));
S.Read(FlowControl,SIZEOF(FlowControl));
S.Read(Carrier,SIZEOF(Carrier));
S.Read(TxBuffer,SIZEOF(TxBuffer))
END;
{----------------------------------------------------------------------------}
PROCEDURE LSList.Store;
BEGIN
S.Write(SerialPort,SIZEOF(SerialPort));
S.Write(PortType,SIZEOF(PortType));
S.Write(BaudBits,SIZEOF(BaudBits));
S.Write(FlowControl,SIZEOF(FlowControl));
S.Write(Carrier,SIZEOF(Carrier));
S.Write(TxBuffer,SIZEOF(TxBuffer))
END;
{----------------------------------------------------------------------------}
DESTRUCTOR LSList.Done;
BEGIN
{$IFDEF FOSSILDRIVER}
IF PortType = SerFossil THEN
BEGIN
Regs.AH := $05;
Regs.DX := SerialPort;
INTR(Fossil,Regs);
PortType := SerNone
END;
{$ENDIF}
{$IFDEF SERIALDRIVER}
IF PortType = SerStd THEN
BEGIN
{Take out our port!}
PortType := SerNone
END;
{$ENDIF}
END;
{----------------------------------------------------------------------------}
FUNCTION ScanPorts(p : PCollection; Port : BYTE) : PSList;
FUNCTION TestPort(p : PSList) : BOOLEAN ; FAR;
BEGIN
TestPort := (Port = p^.SerialPort)
END;
BEGIN
ScanPorts := p^.FirstThat(@TestPort)
END;
{----------------------------------------------------------------------------}
CONSTRUCTOR FSerial.Init;
VAR R : TRect;
BEGIN
GetExtent(R);
TView.Init(R);
SetState(sfVisible,FALSE);
EventMask := evSerial;
EventGenerate := FALSE;
OpenPorts := NEW(PCollection,Init(4,4));
{$IFDEF FOSSILDRIVER}
FILLCHAR(FossilInfo,SIZEOF(FossilInfo),0);
Regs.AH := $1B;
Regs.CX := SIZEOF(FossilInfo);
Regs.DX := 1;
Regs.ES := SEG(FossilInfo);
Regs.DI := OFS(FossilInfo);
INTR(Fossil,Regs);
FossilPresent := (FossilInfo.majver >= 4) AND (FossilInfo.strsiz > 4);
{$ENDIF}
Reset
END;
{----------------------------------------------------------------------------}
CONSTRUCTOR FSerial.Load;
BEGIN
TView.Load(S);
END;
{----------------------------------------------------------------------------}
PROCEDURE FSerial.Store;
BEGIN
TView.Store(S);
END;
{----------------------------------------------------------------------------}
PROCEDURE FSerial.InitPort;
VAR p : PSList;
BEGIN
Reset;
IF (Port < 0) OR (Port >= MaxPorts) THEN
BEGIN
ErrorInfo := stInvalidPort;
EXIT
END;
IF ScanPorts(OpenPorts,Port) = NIL THEN
p := NEW(PSList,Init(Port))
ELSE
BEGIN
ErrorInfo := stDupSerial;
EXIT
END;
IF p = NIL THEN
ErrorInfo := stOpenError
ELSE
OpenPorts^.Insert(p)
END;
{----------------------------------------------------------------------------}
PROCEDURE FSerial.RemovePort;
VAR p : PSList;
BEGIN
Reset;
p := ScanPorts(OpenPorts,Port);
IF p <> NIL THEN
OpenPorts^.Free(p)
ELSE
ErrorInfo := stInvalidPort;
END;
{----------------------------------------------------------------------------}
PROCEDURE FSerial.SetBaud;
VAR BaudMask : BYTE;
p : PSList;
BEGIN
Reset;
BaudMask := 0;
WHILE (Bauds[BaudMask] <> Baud) AND (BaudMask < 8) DO
INC(BaudMask);
IF BaudMask > 7 THEN
BEGIN
ErrorInfo := stInvalidBaud;
EXIT
END;
p := ScanPorts(OpenPorts,Port);
IF p <> NIL THEN
BEGIN
{$IFDEF FOSSILDRIVER}
IF p^.PortType = SerFossil THEN
BEGIN
p^.BaudBits := BaudMask SHL 5 + p^.BaudBits AND $1F;
Regs.AH := $00;
Regs.AL := p^.BaudBits;
Regs.DX := Port;
INTR(Fossil,Regs)
END;
{$ENDIF}
{$IFDEF SERIALDRIVER}
IF p^.PortType = SerStd THEN
BEGIN
{Change Our Baud Rate!}
END
{$ENDIF}
END
ELSE
ErrorInfo := stInvalidPort
END;
{----------------------------------------------------------------------------}
PROCEDURE FSerial.PurgeOutputBuf;
VAR p : PSList;
BEGIN
Reset;
p := ScanPorts(OpenPorts,Port);
IF p <> NIL THEN
BEGIN
{$IFDEF FOSSILDRIVER}
IF p^.PortType = SerFossil THEN
BEGIN
Regs.AH := $09;
Regs.DX := p^.SerialPort;
INTR(Fossil,Regs)
END;
{$ENDIF}
{$IFDEF SERIALDRIVER}
IF p^.PortType = SerStd THEN
BEGIN
END;
{$ENDIF}
END
ELSE
ErrorInfo := stInvalidPort
END;
{----------------------------------------------------------------------------}
PROCEDURE FSerial.PurgeInputBuf;
VAR p : PSList;
BEGIN
Reset;
p := ScanPorts(OpenPorts,Port);
IF p <> NIL THEN
BEGIN
{$IFDEF FOSSILDRIVER}
IF p^.PortType = SerFossil THEN
BEGIN
Regs.AH := $0A;
Regs.DX := p^.SerialPort;
INTR(Fossil,Regs)
END;
{$ENDIF}
{$IFDEF SERIALDRIVER}
IF p^.PortType = SerStd THEN
BEGIN
END;
{$ENDIF}
END
ELSE
ErrorInfo := stInvalidPort
END;
{----------------------------------------------------------------------------}
PROCEDURE FSerial.SendChar;
VAR p : PSList;
BEGIN
Reset;
p := ScanPorts(OpenPorts,Port);
IF p <> NIL THEN
BEGIN
{$IFDEF FOSSILDRIVER}
IF p^.PortType = SerFossil THEN
BEGIN
Regs.AH := $01;
Regs.AL := ch;
Regs.DX := Port;
INTR(Fossil,Regs); {Check AX returns....}
END;
{$ENDIF}
{$IFDEF SERIALDRIVER}
IF p^.PortType = SerStd THEN
BEGIN
END;
{$ENDIF}
END
ELSE
ErrorInfo := stInvalidPort
END;
{----------------------------------------------------------------------------}
PROCEDURE FSerial.SendLine;
VAR p : PSList;
BEGIN
Reset;
p := ScanPorts(OpenPorts,Port);
IF p <> NIL THEN
BEGIN
{$IFDEF FOSSILDRIVER}
IF (p^.PortType = SerFossil) AND (LENGTH(Ln) > 0) THEN
BEGIN
Regs.AH := $19;
Regs.CX := LENGTH(Ln);
Regs.DX := Port;
Regs.ES := SEG(Ln[1]);
Regs.DI := OFS(Ln[1]);
INTR(Fossil,Regs); {Check AX returns....}
END;
{$ENDIF}
{$IFDEF SERIALDRIVER}
IF p^.PortType = SerStd THEN
BEGIN
END;
{$ENDIF}
END
ELSE
ErrorInfo := stInvalidPort
END;
{----------------------------------------------------------------------------}
PROCEDURE FSerial.DTRState;
VAR p : PSList;
BEGIN
Reset;
p := ScanPorts(OpenPorts,Port);
IF p <> NIL THEN
BEGIN
{$IFDEF FOSSILDRIVER}
IF p^.PortType = SerFossil THEN
BEGIN
Regs.AH := $06;
Regs.AL := BYTE(UpDown);
Regs.DX := Port;
INTR(Fossil,Regs)
END;
{$ENDIF}
{$IFDEF SERIALDRIVER}
IF p^.PortType = SerStd THEN
BEGIN
END;
{$ENDIF}
END
ELSE
ErrorInfo := stInvalidPort
END;
{----------------------------------------------------------------------------}
PROCEDURE FSerial.FlowControl;
VAR p : PSList;
BEGIN
Reset;
p := ScanPorts(OpenPorts,Port);
IF p <> NIL THEN
BEGIN
{$IFDEF FOSSILDRIVER}
IF p^.PortType = SerFossil THEN
BEGIN
Regs.AH := $0F;
Regs.AL := Item;
Regs.DX := p^.SerialPort;
INTR(Fossil,Regs)
END;
{$ENDIF}
{$IFDEF SERIALDRIVER}
IF p^.PortType = SerStd THEN
BEGIN
END;
{$ENDIF}
END
ELSE
ErrorInfo := stInvalidPort
END;
{----------------------------------------------------------------------------}
PROCEDURE FSerial.SerialRequest;
VAR p : PSList;
BEGIN
Reset;
p := ScanPorts(OpenPorts,Port);
IF p <> NIL THEN
CASE ReqType OF
serCarrierReq : p^.Carrier := NOT p^.Carrier;
serTxBufferReq : p^.TxBuffer := NOT p^.TxBuffer
END
ELSE
ErrorInfo := stInvalidPort
END;
{----------------------------------------------------------------------------}
PROCEDURE FSerial.GenerateEvents;
BEGIN
EventGenerate := Action
END;
{----------------------------------------------------------------------------}
FUNCTION FSerial.RecvChar;
VAR p : PSList;
BEGIN
Reset;
p := ScanPorts(OpenPorts,Port);
IF p <> NIL THEN
BEGIN
{$IFDEF FOSSILDRIVER}
IF p^.PortType = SerFossil THEN
BEGIN
Regs.AH := $03;
Regs.DX := p^.SerialPort;
INTR(Fossil,Regs);
IF Regs.AH AND $01 = $01 THEN
BEGIN
Regs.AH := $02;
INTR(Fossil,Regs);
RecvChar := CHAR(Regs.AL)
END
ELSE
BEGIN
RecvChar := #0;
ErrorInfo := stCharUnavail
END
END;
{$ENDIF}
{$IFDEF SERIALDRIVER}
IF p^.PortType = SerStd THEN
BEGIN
END;
{$ENDIF}
END
ELSE
BEGIN
RecvChar := #0;
ErrorInfo := stInvalidPort
END
END;
{----------------------------------------------------------------------------}
PROCEDURE FSerial.Reset;
BEGIN
ErrorInfo := stOk
END;
{----------------------------------------------------------------------------}
DESTRUCTOR FSerial.Done;
BEGIN
DISPOSE(OpenPorts,Done);
TView.Done;
END;
{----------------------------------------------------------------------------}
{ NOTE: The returned event that is created by the IDLE routine consists of }
{ two major parts. First is the identification that this is a serial }
{ event or type whatever (serCarrier,serTxBuffer,serRecv). The }
{ second part is the InfoWord with the high byte being the port that }
{ this message came in from and the low order being what the actual }
{ value was. For Instance: }
{ }
{ serCarrier := HI(InfoWord) = 1 -> Carrier }
{ HI(InfoWord) = 0 -> No Carrier }
{ }
{ serTxBuffer := HI(InfoWord) = 1 -> Room Avail in output buffer }
{ HI(InfoWord) = 0 -> No Room Avail in output buffer }
{ }
{ serRecvChar := HI(InfoWord) -> Character Received }
{ }
{ serRecvLine := InfoPointer -> Points to a port/string record }
{ }
{ InfoByte -> For all, gives the port number }
{ - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - -}
PROCEDURE FSerial.Idle;
VAR Event : TEvent;
p : PSList;
BEGIN
IF (OpenPorts^.Count <> 0) THEN
BEGIN
LastPort := (LastPort + 1) MOD OpenPorts^.Count;
Event.What := evSerial;
p := OpenPorts^.AT(LastPort);
{$IFDEF FOSSILDRIVER}
IF p^.PortType = SerFossil THEN
BEGIN
Regs.AH := $03;
Regs.DX := p^.SerialPort;
Event.InfoByte := Regs.DX;
INTR(Fossil,Regs);
IF p^.Carrier XOR (Regs.AL AND $80 = $80) THEN
BEGIN
p^.Carrier := NOT p^.Carrier;
Event.Command := serCarrier;
INC(Event.InfoWord,BYTE(p^.Carrier) SHL 8);
IF EventGenerate THEN
PutEvent(Event);
EXIT
END;
IF p^.TxBuffer XOR (Regs.AH AND $20 = $20) THEN
BEGIN
p^.TxBuffer := NOT p^.TxBuffer;
Event.Command := serTxBuffer;
INC(Event.InfoWord,BYTE(p^.TxBuffer) SHL 8);
IF EventGenerate THEN
PutEvent(Event);
EXIT
END;
IF EventGenerate AND (Regs.AH AND $01 = $01) THEN
BEGIN
Regs.AH := $18;
Regs.CX := 255;
Regs.ES := SEG(RecvBuf.St[1]);
Regs.DI := OFS(RecvBuf.St[1]);
INTR(Fossil,Regs);
IF Regs.AX = 1 THEN
BEGIN
Event.Command := serRecvChar;
INC(Event.InfoWord,BYTE(RecvBuf.St[1]) SHL 8);
PutEvent(Event)
END;
IF Regs.AX > 1 THEN
BEGIN
Event.Command := serRecvLine;
Event.InfoPtr := ADDR(RecvBuf);
RecvBuf.Port := p^.SerialPort;
RecvBuf.St[0] := CHAR(Regs.AX);
PutEvent(Event)
END
END
END;
{$ENDIF}
{$IFDEF SERIALDRIVER}
IF p^.PortType = SerStd THEN
BEGIN
END
{$ENDIF}
END
END;
{----------------------------------------------------------------------------}
PROCEDURE FSerial.HandleEvent;
BEGIN
TView.HandleEvent(Event);
IF Event.What = evSerial THEN
CASE Event.Command OF
serBaud : SetBaud(Event.InfoByte,Event.InfoLong SHR 16);
serSend : SendChar(Event.InfoByte,HI(Event.InfoWord));
serInit : InitPort(Event.InfoByte);
serDeInit : RemovePort(Event.InfoByte);
serRaiseDTR : DTRState(Event.InfoByte,TRUE);
serLowerDTR : DTRState(Event.InfoByte,FALSE);
serPurgeTx : PurgeOutputBuf(Event.InfoByte);
serPurgeRx : PurgeInputBuf(Event.InfoByte);
serFlow : FlowControl(Event.InfoByte,HI(Event.InfoWord));
serCarrierReq : SerialRequest(serCarrierReq,Event.InfoByte);
serTxBufferReq : SerialRequest(serTxBufferReq,Event.InfoByte);
serEventGenOn : GenerateEvents(TRUE);
serEventGenOff : GenerateEvents(FALSE);
ELSE EXIT;
END
ELSE
EXIT;
ClearEvent(Event)
END;
{----------------------------------------------------------------------------}
PROCEDURE RegisterSerial;
BEGIN
RegisterType(RSerial);
RegisterType(RSList);
END;
{----------------------------------------------------------------------------}
END.
