[Back to COMM SWAG index] [Back to Main SWAG index] [Original]
{
>doors. But, i have one little problem: I don't know how to hang-up the modem
>- I am using a ready-made TPU that does all the port tasks, but it just can'
>hang up!
Here is some code I pulled out of this conference a While ago:
}
Unit EtAsync;
{****************************************************************************}
{* EtAsync V.1.04, 9/4 1992 Et-Soft *}
{* *}
{* Turbo Pascal Unit With support For up to 8 serial ports. *}
{****************************************************************************}
{$A-} {- Word alignment -}
{$B-} {- Complete Boolean evaluation -}
{$D-} {- Debug inFormation -}
{$E-} {- Coprocessor emulation -}
{$F+} {- Force Far calls -}
{$I-} {- I/O checking -}
{$L-} {- Local debug symbols -}
{$N-} {- Coprocessor code generation -}
{$O-} {- Overlayes allowed -}
{$R-} {- Range checking -}
{$S-} {- Stack checking -}
{$V-} {- Var-String checking -}
{$M 16384,0,655360} {- Stack size, min heap, max heap -}
{****************************************************************************}
Interface
{****************************************************************************}
Uses
Dos;
{****************************************************************************}
{- Standard baudrates: -}
{- 50, 75, 110, 134 (134.5), 150, 300, 600, 1200, 1800, 2000, 2400, 3600, -}
{- 4800, 7200, 9600, 19200, 38400, 57600, 115200 -}
Function OpenCOM {- Open a COMport For communication -}
(Nr : Byte; {- Internal portnumber: 0-7 -}
Address : Word; {- Port address in hex: 000-3F8 -}
IrqNum : Byte; {- Port Irq number: 0-7 (255 For no Irq) -}
Baudrate : LongInt; {- Baudrate: (see table) -}
ParityBit : Char; {- Parity : 'O','E' or 'N' -}
Databits : Byte; {- Databits: 5-8 -}
Stopbits : Byte; {- Stopbits: 1-2 -}
BufferSize : Word; {- Size of input buffer: 0-65535 -}
Handshake : Boolean) {- True to use hardware handshake -}
: Boolean; {- Returns True if ok -}
Procedure CloseCOM {- Close a open COMport -}
(Nr : Byte); {- Internal portnumber: 0-7 -}
Procedure ResetCOM {- Reset a open COMport incl. buffer -}
(Nr : Byte); {- Internal portnumber: 0-7 -}
Procedure COMSettings {- Change settings For a open COMport -}
(Nr : Byte; {- Internal portnumber: 0-7 -}
Baudrate : LongInt; {- Baudrate: (see table) -}
Paritybit : Char; {- Parity : 'O','E' or 'N' -}
Databits : Byte; {- Databits: 5-8 -}
Stopbits : Byte; {- Stopbits: 1-2 -}
Handshake : Boolean); {- True to use hardware handshake -}
Function COMAddress {- Return the address For a COMport (BIOS) -}
(COMport : Byte) {- COMport: 1-8 -}
: Word; {- Address found For COMport (0 if none) -}
Function WriteCOM {- Writes a Character to a port -}
(Nr : Byte; {- Internal portnumber: 0-7 -}
Ch : Char) {- Character to be written to port -}
: Boolean; {- True if Character send -}
Function WriteCOMString {- Writes a String to a port -}
(Nr : Byte; {- Internal portnumber: 0-7 -}
St : String) {- String to be written to port -}
: Boolean; {- True if String send -}
Function CheckCOM {- Check if any Character is arrived -}
(Nr : Byte; {- Internal portnumber: 0-7 -}
Var Ch : Char) {- Character arrived -}
: Boolean; {- Returns True and Character if any -}
Function COMError {- Returns status of the last operation -}
: Integer; {- 0 = Ok -}
{- 1 = not enough memory -}
{- 2 = Port not open -}
{- 3 = Port already used once -}
{- 4 = Selected Irq already used once -}
{- 5 = Invalid port -}
{- 6 = Timeout -}
{- 7 = Port failed loopback test -}
{- 8 = Port failed IRQ test -}
Function TestCOM {- PerForms a loopback and IRQ test on a port -}
(Nr : Byte) {- Internal port number: 0-7 -}
: Boolean; {- True if port test ok -}
{- note: This is perFormed during OpenCOM -}
{- if enabled (TestCOM is by default enabled -}
{- during OpenCOM, but can be disabled With -}
{- the DisableTestCOM routine) -}
Procedure EnableTestCOM; {- Enable TestCOM during Openport (Default On) }
Procedure DisableTestCOM; {- Disable TestCOM during Openport -}
Function COMUsed {- Check whether or not a port is open -}
(Nr : Byte) {- Internal port number: 0-7 -}
: Boolean; {- True if port is open and in use -}
{- note: This routine can not test -}
{- whether or not a COMport is used by
{- another application -}
Function IrqUsed {- Check whether or not an Irq is used -}
(IrqNum : Byte) {- Irq number: 0-7 -}
: Boolean; {- True if Irq is used -}
{- note: This routine can not test -}
{- whether or not an IRQ is used by -}
{- another application -}
Function IrqInUse {- Test IRQ in use on the PIC -}
(IrqNum : Byte) {- Irq number: 0-7 -}
: Boolean; {- True if Irq is used -}
Procedure SetIrqPriority {- Set the Irq priority level on the PIC -}
(IrqNum : Byte); {- Irq number: 0-7 -}
{- The IrqNum specified will get the highest -}
{- priority, the following Irq number will
{- then have the next highest priority -}
{- and so on -}
Procedure ClearBuffer {- Clear the input buffer For a open port -}
(Nr : Byte); {- Internal port number: 0-7 -}
{****************************************************************************}
Implementation
{****************************************************************************}
Type
Buffer = Array[1..65535] of Byte; {- Dummy Type For Interrupt buffer -}
PortRec = Record {- Portdata Type -}
InUse : Boolean; {- True if port is used -}
Addr : Word; {- Selected address -}
Irq : Byte; {- Selected Irq number -}
OldIrq : Byte; {- Status of Irq beFore InitCOM -}
HShake : Boolean; {- Hardware handshake on/off -}
Buf : ^Buffer; {- Pointer to allocated buffer -}
BufSize : Word; {- Size of allocated buffer -}
OldVec : Pointer; {- Saved old interrupt vector -}
Baud : LongInt; {- Selected baudrate -}
Parity : Char; {- Selected parity -}
Databit : Byte; {- Selected number of databits -}
Stopbit : Byte; {- Selected number of stopbits -}
InPtr : Word; {- Pointer to buffer input index -}
OutPtr : Word; {- Pointer to buffer output index -}
Reg0 : Byte; {- Saved UART register 0 -}
Reg1 : Array[1..2] of Byte; {- Saved UART register 1's -}
Reg2 : Byte; {- Saved UART register 2 -}
Reg3 : Byte; {- Saved UART register 3 -}
Reg4 : Byte; {- Saved UART register 4 -}
Reg6 : Byte; {- Saved UART register 6 -}
end;
Var
COMResult : Integer; {- Last Error (Call COMError) -}
ExitChainP : Pointer; {- Saved Exitproc Pointer -}
OldPort21 : Byte; {- Saved PIC status -}
Ports : Array[0..7] of PortRec; {- The 8 ports supported -}
Const
PIC = $20; {- PIC control address -}
EOI = $20; {- PIC control Byte -}
TestCOMEnabled : Boolean = True; {- Test port during OpenCOM -}
{****************************************************************************}
Procedure DisableInterrupts; {- Disable interrupt -}
begin
Inline($FA); {- CLI (Clear Interruptflag) -}
end;
{****************************************************************************}
Procedure EnableInterrupts; {- Enable interrupts -}
begin
Inline($FB); {- STI (Set interrupt flag) -}
end;
{****************************************************************************}
Procedure Port0Int; Interrupt; {- Interrupt rutine port 0 -}
begin
With Ports[0] Do
begin
Buf^[InPtr] := Port[Addr]; {- Read data from port -}
Inc(InPtr); {- Count one step Forward.. }
if InPtr > BufSize then
InPtr := 1; { .. in buffer -}
end;
Port[PIC] := EOI; {- Send EOI to PIC -}
end;
{****************************************************************************}
Procedure Port1Int; Interrupt; {- Interrupt rutine port 1 -}
begin
With Ports[1] Do
begin
Buf^[InPtr] := Port[Addr]; {- Read data from port -}
Inc(InPtr); {- Count one step Forward.. }
if InPtr > BufSize then
InPtr := 1; { .. in buffer -}
end;
Port[PIC] := EOI; {- Send EOI to PIC -}
end;
{****************************************************************************}
Procedure Port2Int; Interrupt; {- Interrupt rutine port 2 -}
begin
With Ports[2] Do
begin
Buf^[InPtr] := Port[Addr]; {- Read data from port -}
Inc(InPtr); {- Count one step Forward.. }
if InPtr > BufSize then
InPtr := 1; { .. in buffer -}
end;
Port[PIC] := EOI; {- Send EOI to PIC -}
end;
{****************************************************************************}
Procedure Port3Int; Interrupt; {- Interrupt rutine port 3 -}
begin
With Ports[3] Do
begin
Buf^[InPtr] := Port[Addr]; {- Read data from port -}
Inc(InPtr); {- Count one step Forward.. }
if InPtr > BufSize then
InPtr := 1; { .. in buffer -}
end;
Port[PIC] := EOI; {- Send EOI to PIC -}
end;
{****************************************************************************}
Procedure Port4Int; Interrupt; {- Interrupt rutine port 4 -}
begin
With Ports[4] Do
begin
Buf^[InPtr] := Port[Addr]; {- Read data from port -}
Inc(InPtr); {- Count one step Forward.. }
if InPtr > BufSize then
InPtr := 1; { .. in buffer -}
end;
Port[PIC] := EOI; {- Send EOI to PIC -}
end;
{****************************************************************************}
Procedure Port5Int; Interrupt; {- Interrupt rutine port 5 -}
begin
With Ports[5] Do
begin
Buf^[InPtr] := Port[Addr]; {- Read data from port -}
Inc(InPtr); {- Count one step Forward.. }
if InPtr > BufSize then
InPtr := 1; { .. in buffer -}
end;
Port[PIC] := EOI; {- Send EOI to PIC -}
end;
{****************************************************************************}
Procedure Port6Int; Interrupt; {- Interrupt rutine port 6 -}
begin
With Ports[6] Do
begin
Buf^[InPtr] := Port[Addr]; {- Read data from port -}
Inc(InPtr); {- Count one step Forward.. }
if InPtr > BufSize then
InPtr := 1; { .. in buffer -}
end;
Port[PIC] := EOI; {- Send EOI to PIC -}
end;
{****************************************************************************}
Procedure Port7Int; Interrupt; {- Interrupt rutine port 7 -}
begin
With Ports[7] Do
begin
Buf^[InPtr] := Port[Addr]; {- Read data from port-}
Inc(InPtr); {- Count one step Forward..}
if InPtr > BufSize then
InPtr := 1; { .. in buffer-}
end;
Port[PIC] := EOI; {- Send EOI to PIC-}
end;
{****************************************************************************}
Procedure InitPort(Nr : Byte; SaveStatus : Boolean); {- Port initialize -}
Var
divider : Word; {- Baudrate divider number -}
CtrlBits : Byte; {- UART control Byte -}
begin
With Ports[Nr] Do
begin
divider := 115200 div Baud; {- Calc baudrate divider -}
CtrlBits := DataBit - 5; {- Insert databits -}
if Parity <> 'N' then
begin
CtrlBits := CtrlBits or $08; {- Insert parity enable -}
if Parity = 'E' then {- Enable even parity -}
CtrlBits := CtrlBits or $10;
end;
if Stopbit = 2 then
CtrlBits := CtrlBits or $04; {- Insert stopbits -}
if SaveStatus then
Reg3 := Port[Addr + $03]; {- Save register 3 -}
Port[Addr + $03] := $80; {- Baudrate change -}
if SaveStatus then
Reg0 := Port[Addr + $00]; {- Save Lo Baud -}
Port[Addr + $00] := Lo(divider); {- Set Lo Baud -}
if SaveStatus then
Reg1[2] := Port[Addr + $01]; {- Save Hi Baud -}
Port[Addr + $01] := Hi(divider); {- Set Hi Baud -}
Port[Addr + $03] := CtrlBits; {- Set control reg. -}
if SaveStatus then
Reg6 := Port[Addr + $06]; {- Save register 6 -}
end;
end;
{****************************************************************************}
Function IrqUsed(IrqNum : Byte) : Boolean;
Var
Count : Byte;
Found : Boolean;
begin
Found := False; {- Irq not found -}
Count := 0; {- Start With port 0 -}
While (Count <= 7) and not Found Do {- Count the 8 ports -}
With Ports[Count] Do
begin
if InUse then
Found := IrqNum = Irq; {- Check Irq match -}
Inc(Count); {- Next port -}
end;
IrqUsed := Found; {- Return Irq found -}
end;
{****************************************************************************}
Procedure EnableTestCOM;
begin
TestCOMEnabled := True;
end;
{****************************************************************************}
Procedure DisableTestCOM;
begin
TestCOMEnabled := False;
end;
{****************************************************************************}
Function TestCOM(Nr : Byte) : Boolean;
Var
OldReg0 : Byte;
OldReg1 : Byte;
OldReg4 : Byte;
OldReg5 : Byte;
OldReg6 : Byte;
OldInPtr : Word;
OldOutPtr : Word;
TimeOut : Integer;
begin
TestCOM := False;
With Ports[Nr] Do
begin
if InUse then
begin
OldInPtr := InPtr;
OldOutPtr := OutPtr;
OldReg1 := Port[Addr + $01];
OldReg4 := Port[Addr + $04];
OldReg5 := Port[Addr + $05];
OldReg6 := Port[Addr + $06];
Port[Addr + $05] := $00;
Port[Addr + $04] := Port[Addr + $04] or $10;
OldReg0 := Port[Addr + $00];
OutPtr := InPtr;
TimeOut := MaxInt;
Port[Addr + $00] := OldReg0;
While (Port[Addr + $05] and $01 = $00) and (TimeOut <> 0) Do
Dec(TimeOut);
if TimeOut <> 0 then
begin
if Port[Addr + $00] = OldReg0 then
begin
if IRQ In [0..7] then
begin
TimeOut := MaxInt;
OutPtr := InPtr;
Port[Addr + $01] := $08;
Port[Addr + $04] := $08;
Port[Addr + $06] := Port[Addr + $06] or $01;
While (InPtr = OutPtr) and (TimeOut <> 0) Do
Dec(TimeOut);
Port[Addr + $01] := OldReg1;
if (InPtr <> OutPtr) then
TestCOM := True
else
COMResult := 8;
end
else
TestCOM := True;
end
else
COMResult := 7; {- Loopback test failed -}
end
else
COMResult := 6; {- Timeout -}
Port[Addr + $04] := OldReg4;
Port[Addr + $05] := OldReg5;
Port[Addr + $06] := OldReg6;
For TimeOut := 1 to MaxInt Do;
if Port[Addr + $00] = 0 then;
InPtr := OldInPtr;
OutPtr := OldOutPtr;
end
else
COMResult := 2; {- Port not open -}
end;
end;
{****************************************************************************}
Procedure CloseCOM(Nr : Byte);
begin
With Ports[Nr] Do
begin
if InUse then
begin
InUse := False;
if Irq <> 255 then {- if Interrupt used -}
begin
FreeMem(Buf,BufSize); {- Deallocate buffer -}
DisableInterrupts;
Port[$21] := Port[$21] or ($01 Shl Irq) and OldIrq;
{-restore-}
Port[Addr + $04] := Reg4; {- Disable UART OUT2 -}
Port[Addr + $01] := Reg1[1]; {- Disable UART Int. -}
SetIntVec($08+Irq,OldVec); {- Restore Int.Vector -}
EnableInterrupts;
end;
Port[Addr + $03] := $80; {- UART Baud set -}
Port[Addr + $00] := Reg0; {- Reset Lo Baud -}
Port[Addr + $01] := Reg1[2]; {- Reset Hi Baud -}
Port[Addr + $03] := Reg3; {- Restore UART ctrl. -}
Port[Addr + $06] := Reg6; {- Restore UART reg6 -}
end
else
COMResult := 2; {- Port not in use -}
end;
end;
{****************************************************************************}
Function OpenCOM
(Nr : Byte; Address : Word; IrqNum : Byte; Baudrate : LongInt;
ParityBit : Char; Databits, Stopbits : Byte; BufferSize : Word;
HandShake : Boolean) : Boolean;
Var
IntVec : Pointer;
OldErr : Integer;
begin
OpenCOM := False;
if (IrqNum = 255) or
((IrqNum In [0..7]) and (MaxAvail >= LongInt(BufferSize))
and not IrqUsed(IrqNum)) then
With Ports[Nr] Do
begin
if not InUse and (Address <= $3F8) then
begin
InUse := True; {- Port now in use -}
Addr := Address; {- Save parameters -}
Irq := IrqNum;
HShake := HandShake;
BufSize := BufferSize;
Baud := Baudrate;
Parity := Paritybit;
Databit := Databits;
Stopbit := Stopbits;
InPtr := 1; {- Reset InputPointer -}
OutPtr := 1; {- Reset OutputPointer -}
if (Irq In [0..7]) and (BufSize > 0) then
begin
GetMem(Buf,BufSize); {- Allocate buffer -}
GetIntVec($08+Irq,OldVec); {- Save Interrupt vector -}
Case Nr of {- Find the interrupt proc. -}
0 : IntVec := @Port0Int;
1 : IntVec := @Port1Int;
2 : IntVec := @Port2Int;
3 : IntVec := @Port3Int;
4 : IntVec := @Port4Int;
5 : IntVec := @Port5Int;
6 : IntVec := @Port6Int;
7 : IntVec := @Port7Int;
end;
Reg1[1] := Port[Addr + $01]; {- Save register 1 -}
Reg4 := Port[Addr + $04]; {- Save register 4 -}
OldIrq := Port[$21] or not ($01 Shl Irq);{- Save PIC Irq -}
DisableInterrupts; {- Disable interrupts -}
SetIntVec($08+Irq,IntVec); {- Set the interrupt vector -}
Port[Addr + $04] := $08; {- Enable OUT2 on port -}
Port[Addr + $01] := $01; {- Set port data avail.int. -}
Port[$21] := Port[$21] and not ($01 Shl Irq);{- Enable Irq-}
EnableInterrupts; {- Enable interrupts again -}
end;
InitPort(Nr,True); {- Initialize port -}
if TestCOMEnabled then
begin
if not TestCOM(Nr) then
begin
OldErr := COMResult;
CloseCOM(Nr);
COMResult := OldErr;
end
else
OpenCOM := True;
end
else
OpenCOM := True;
if Port[Addr + $00] = 0 then; {- Remove any pending Character-}
if Port[Addr + $05] = 0 then; {- Reset line status register-}
Port[Addr + $04] := Port[Addr + $04] or $01; {- Enable DTR-}
end
else if InUse then
COMResult := 3 {- Port already in use-}
else if (Address > $3F8) then
COMResult := 5; {- Invalid port address-}
end
else if (MaxAvail >= BufferSize) then {- not enough memory-}
COMResult := 1
else if IrqUsed(IrqNum) then {- Irq already used -}
COMResult := 4;
end;
{****************************************************************************}
Procedure ResetCOM(Nr : Byte);
begin
With Ports[Nr] Do
begin
if InUse then {- Is port defined ?-}
begin
InPtr := 1; {- Reset buffer Pointers-}
OutPtr := 1;
InitPort(Nr,False); {- Reinitialize the port-}
if Port[Addr + $00] = 0 then; {- Remove any pending Character-}
if Port[Addr + $05] = 0 then; {- Reset line status register-}
end
else
COMResult := 2; {- Port not open-}
end;
end;
{****************************************************************************}
Procedure COMSettings(Nr : Byte; Baudrate : LongInt; ParityBit : Char;
Databits, Stopbits : Byte; HandShake : Boolean);
begin
With Ports[Nr] Do
begin
if InUse then {- Is port in use-}
begin
Baud := Baudrate; {- Save parameters-}
Parity := Paritybit;
Databit := Databits;
Stopbit := Stopbits;
HShake := HandShake;
InitPort(Nr,False); {- ReInit port-}
end
else
COMResult := 2; {- Port not in use-}
end;
end;
{****************************************************************************}
Function COMAddress(COMport : Byte) : Word;
begin
if Comport In [1..8] then
COMAddress := MemW[$40:(Pred(Comport) Shl 1)] {- BIOS data table-}
else
COMResult := 5; {- Invalid port-}
end;
{****************************************************************************}
Function WriteCOM(Nr : Byte; Ch : Char) : Boolean;
Var
Count : Integer;
begin
WriteCom := True;
With Ports[Nr] Do
if InUse then
begin
While Port[Addr + $05] and $20 = $00 Do; {- Wait Until Char send-}
if not HShake then
Port[Addr] := ord(Ch) {- Send Char to port-}
else
begin
Port[Addr + $04] := $0B; {- OUT2, DTR, RTS-}
Count := MaxInt;
While (Port[Addr + $06] and $10 = 0) and (Count <> 0) Do
Dec(Count); {- Wait For CTS-}
if Count <> 0 then {- if not timeout-}
Port[Addr] := ord(Ch) {- Send Char to port-}
else
begin
COMResult := 6; {- Timeout error-}
WriteCom := False;
end;
end;
end
else
begin
COMResult := 2; {- Port not in use-}
WriteCom := False;
end;
end;
{****************************************************************************}
Function WriteCOMString(Nr : Byte; St : String) : Boolean;
Var
Ok : Boolean;
Count : Byte;
begin
if Length(St) > 0 then {- Any Chars to send ?-}
begin
Ok := True;
Count := 1;
While (Count <= Length(St)) and Ok Do {- Count Chars-}
begin
Ok := WriteCOM(Nr,St[Count]); {- Send Char-}
Inc(Count); {- Next Character-}
end;
WriteCOMString := Ok; {- Return status-}
end;
end;
{****************************************************************************}
Function CheckCOM(Nr : Byte; Var Ch : Char) : Boolean;
begin
With Ports[Nr] Do
begin
if InPtr <> OutPtr then {- Any Char in buffer ?-}
begin
Ch := Chr(Buf^[OutPtr]); {- Get Char from buffer-}
Inc(OutPtr); {- Count outPointer up-}
if OutPtr > BufSize then
OutPtr := 1;
CheckCOM := True;
end
else
CheckCOM := False; {- No Char in buffer-}
end;
end;
{****************************************************************************}
Function COMError : Integer;
begin
COMError := COMResult; {- Return last error-}
COMResult := 0;
end;
{****************************************************************************}
Function COMUsed(Nr : Byte) : Boolean;
begin
COMUsed := Ports[Nr].InUse; {- Return used status-}
end;
{****************************************************************************}
Function IrqInUse(IrqNum : Byte) : Boolean;
Var
IrqOn : Byte;
Mask : Byte;
begin
IrqInUse := False;
if IrqNum In [0..7] then
begin
IrqOn := Port[$21]; {-1111 0100-}
Mask := ($01 Shl IrqNum);
IrqInUse := IrqOn or not Mask = not Mask;
end;
end;
{****************************************************************************}
Procedure SetIrqPriority(IrqNum : Byte);
begin
if IrqNum In [0..7] then
begin
if IrqNum > 0 then
Dec(IrqNum)
else IrqNum := 7;
DisableInterrupts;
Port[PIC] := $C0 + IrqNum;
EnableInterrupts;
end;
end;
{****************************************************************************}
Procedure ClearBuffer(Nr : Byte);
begin
With Ports[Nr] Do
if InUse and (BufSize > 0) then
OutPtr := InPtr;
end;
{****************************************************************************}
Procedure DeInit;
Var
Count : Byte;
begin
For Count := 0 to 7 Do
CloseCOM(Count); {- Close open ports-}
DisableInterrupts;
Port[$21] := OldPort21; {- Restore PIC status-}
Port[$20] := $C7; {- IRQ0 1. priority-}
EnableInterrupts;
ExitProc := ExitChainP; {- Restore ExitProc-}
end;
{****************************************************************************}
Procedure Init;
Var
Count : Byte;
begin
COMResult := 0;
ExitChainP := ExitProc; {- Save ExitProc-}
ExitProc := @DeInit; {- Set ExitProc-}
For Count := 0 to 7 Do
Ports[Count].InUse := False; {- No ports open-}
OldPort21 := Port[$21]; {- Save PIC status-}
end;
{****************************************************************************}
begin
Init;
end.
[Back to COMM SWAG index] [Back to Main SWAG index] [Original]