home *** CD-ROM | disk | FTP | other *** search
- {Here's a unit for sending and receiving async commands }
-
- { ======================= SERIAL COMMUNICATIONS ============================ }
-
- UNIT Async;
-
- {$D-,V-,B-,S-,R-}
-
- INTERFACE
-
- USES Dos, Crt;
-
- TYPE
-
- BAUD = (B110,B150,B300,B600,B1200,B2400,B4800,B9600);
- PARITY = (PNONE, PODD, PNOTHING, PEVEN);
-
- VAR
- AsyncInstalled : BOOLEAN;
- AsyncActive : BOOLEAN;
-
-
- PROCEDURE InitAsync(Com :BYTE;
- Speed :BAUD;
- Par :PARITY;
- Stop :BYTE;
- Dbits :BYTE);
- PROCEDURE TermAsync;
- FUNCTION CheckAsync :WORD;
- PROCEDURE HangUp;
- PROCEDURE Send(Buffer :STRING);
- PROCEDURE Receive(VAR Buffer :STRING);
-
- IMPLEMENTATION
-
- CONST
-
- THR = 0;
- RBR = 0;
- IER = 1;
- IIR = 2;
- LCR = 3;
- MCR = 4;
- LSR = 5;
- MSR = 6;
- BUFFSIZE = 255;
- TIMOUT = 60000;
- EOI : BYTE = $20;
- IRQ4low : BYTE = $EF;
- IRQ4high : BYTE = $10;
- IRQ3low : BYTE = $F7;
- IRQ3high : BYTE = $08;
- ErrorMask : BYTE = $0E;
- DSRready : BYTE = $20;
- OUT2 : BYTE = $08;
- DTR : BYTE = $01;
- RTS : BYTE = $02;
-
- VAR
-
- Regs : REGISTERS;
- OldVector : POINTER;
- AsyncStatus : WORD;
- IntType : BYTE;
- AsyncDisable : BYTE;
- AsyncEnable : BYTE;
- AsyncBuff : ARRAY [0..BUFFSIZE] OF BYTE;
- Front : INTEGER;
- Rear : INTEGER;
- ComPort : BYTE;
- ComBase : WORD;
-
- {//////////////////////////////////////////////////////////////////////////}
-
- PROCEDURE ZeroDlab;
-
- { -- zero divisor latch access bit allowing access to THR, RBR and IER }
-
- BEGIN
- PORT[ComBase+LCR]:= PORT[ComBase+LCR] AND $7F;
- END;
-
- {//////////////////////////////////////////////////////////////////////////}
-
- PROCEDURE SetDTR;
-
- { -- enable interrupts and set DTR }
-
- BEGIN
- PORT[ComBase+MCR]:= OUT2 + DTR + RTS;
- DELAY(1000)
- END;
-
- {//////////////////////////////////////////////////////////////////////////}
-
- PROCEDURE ReadPorts;
-
- { -- read UART values }
-
- VAR
- Temp : BYTE;
-
- BEGIN
- Temp:= PORT[ComBase];
- Temp:= PORT[ComBase+IIR];
- Temp:= PORT[ComBase+LSR];
- Temp:= PORT[ComBase+MSR];
- END;
-
- {//////////////////////////////////////////////////////////////////////////}
-
- PROCEDURE HangUp;
-
- { -- hang up phone }
-
- BEGIN
- ReadPorts;
- PORT[ComBase+MCR]:= 0;
- DELAY(1000);
- END;
-
- {//////////////////////////////////////////////////////////////////////////}
-
- FUNCTION CheckAsync;
-
- { -- return status MB = Line Status, LB = Modem Status }
-
- VAR
- LSReg : WORD;
-
- BEGIN
- LSReg:= PORT[ComBase+LSR];
- CheckAsync:= (LSReg SHL 8) OR PORT[ComBase+MSR];
- END;
-
- {//////////////////////////////////////////////////////////////////////////}
-
- {$F+}
-
- PROCEDURE AsyncISR;
-
- INTERRUPT;
-
- { -- serial port interrupt routine }
-
- BEGIN
- PORT[$21]:= PORT[$21] AND AsyncDisable;
- INLINE($FB); { enable interrupts }
- IntType:= PORT[ComBase+IIR] AND 6;
- IF IntType = 4 THEN
- BEGIN
- ZeroDlab;
- AsyncBuff[Rear]:= PORT[ComBase+RBR];
- Rear:= SUCC(Rear) MOD BUFFSIZE
- END;
- AsyncStatus:= (PORT[ComBase+LSR] SHL 8) + PORT[ComBase+MSR];
- INLINE($FA); { disable interrupts }
- PORT[$20]:= EOI;
- PORT[$21]:= PORT[$21] AND AsyncEnable
- END;
-
- {$F-}
-
- {//////////////////////////////////////////////////////////////////////////}
-
- PROCEDURE InstallAsync;
-
- { -- replaces interrupt vector by user routine }
-
- BEGIN
- IF NOT(AsyncInstalled) THEN
- BEGIN
- GetIntVec($0C-ComPort,OldVector);
- SetIntVec($0C-ComPort,@AsyncISR);
- AsyncInstalled:=TRUE;
- END;
- END;
-
- {//////////////////////////////////////////////////////////////////////////}
-
- PROCEDURE DeinstallAsync;
-
- { -- restores interrupt vector }
-
- BEGIN
- IF AsyncInstalled THEN
- BEGIN
- SetIntVec($0C-ComPort,OldVector);
- AsyncInstalled:=FALSE;
- END;
- END;
-
- {//////////////////////////////////////////////////////////////////////////}
-
- PROCEDURE InitAsync(Com : BYTE;
- Speed : BAUD;
- Par : PARITY;
- Stop : BYTE;
- Dbits : BYTE);
-
- { -- initialize serial port communications }
-
- BEGIN
- WITH Regs DO
- BEGIN
- IF NOT(AsyncActive) THEN
- BEGIN
- ComPort := Com-1;
- MEMW[0:$400] := $3F8; { to prevent a BIOS bug }
- MEMW[0:$402] := $2F8; { to prevent a BIOS bug }
- IF ComPort = 0 THEN
- BEGIN
- ComBase := $3F8;
- AsyncEnable := IRQ4low;
- AsyncDisable:= IRQ4high;
- END
- ELSE
- BEGIN
- ComBase := $2F8;
- AsyncEnable := IRQ3low;
- AsyncDisable:= IRQ3high
- END;
- Front := 0;
- Rear := 0;
- AsyncStatus := 0;
- InstallAsync;
- DX :=ComPort;
- AX :=ORD(Speed)*32 + ORD(Par)*8 + (Stop-1)*4 + Dbits-5;
- INTR($14,Regs);
- ReadPorts;
- ZeroDlab;
- PORT[ComBase+IER]:= $05;
- INLINE($FA); { disable interrupts }
- PORT[$21] :=PORT[$21] AND AsyncEnable;
- INLINE($FB); { enable interrupts }
- SetDTR;
- AsyncActive := TRUE;
- END
- ELSE
- BEGIN
- HangUp;
- SetDTR;
- END;
- END;
- END;
-
- {//////////////////////////////////////////////////////////////////////////}
-
- PROCEDURE Receive;
-
- { -- get characters from circular buffer }
-
- VAR
- Ch : CHAR;
- NbrChrs : INTEGER;
- Count : LONGINT;
-
- BEGIN
- Buffer := '';
- Count := TIMOUT;
- NbrChrs := 0;
- WHILE Count>0 DO
- BEGIN
- DEC(Count);
- IF Front <> Rear THEN
- BEGIN
- REPEAT
- Ch := CHAR(AsyncBuff[Front]);
- Front := SUCC(Front) MOD BUFFSIZE;
- IF Ch IN [#0..#31] THEN Ch:= #32;
- Buffer := Buffer + Ch;
- INC(NbrChrs);
- UNTIL (Front = Rear) OR (NbrChrs = BUFFSIZE);
- Count:= TIMOUT;
- END;
- END;
- END;
-
- {//////////////////////////////////////////////////////////////////////////}
-
- PROCEDURE Send;
-
- VAR
- Ptr : INTEGER;
- TH : BYTE;
- CH : CHAR;
-
- BEGIN
- IF LENGTH(Buffer)>0 THEN
- BEGIN
- SetDTR;
- FOR Ptr:=1 TO LENGTH(Buffer) DO
- BEGIN
- REPEAT
- TH:= PORT[ComBase+LSR] AND DSRready
- UNTIL TH<>0;
- CH:= Buffer[Ptr];
- IF (CH = '%') THEN
- BEGIN
- DELAY(1000);
- EXIT;
- END;
- IF (CH = '|') THEN CH:= #13;
- IF (CH = '~') THEN
- DELAY(2000)
- ELSE
- PORT[ComBase+THR]:= BYTE(CH);
- END;
- DELAY(1000);
- END;
- END;
-
- {//////////////////////////////////////////////////////////////////////////}
-
- PROCEDURE TermAsync;
-
- { -- terminate communications }
-
- BEGIN
- IF AsyncActive THEN
- BEGIN
- HangUp;
- INLINE($FA); { disable interrupts }
- PORT[$21] := PORT[$21] OR (IRQ4high + IRQ3high);
- INLINE($FB); { enable interrupts }
- ZeroDlab;
- PORT[ComBase+IER]:= 0;
- DELAY(1000);
- DeinstallAsync;
- AsyncActive := FALSE;
- END;
- END;
-
- {//////////////////////////////////////////////////////////////////////////}
-
- BEGIN
- AsyncInstalled := FALSE;
- AsyncActive := FALSE;
- END.
-
- It's a old unit from tp4 but it works well for me. I think it will not
- support the fifo buffers and the specials of the 16550 uart because
- they wern't available at that time but maybe somebody can modify it
-
- Greetings from:
- Niko van Hagen
- Monday, 25 March 1996, 10:19.
- The Haghe, Holland
- Fido : 2:281/909.11
- Internet : nvhagen@worldonline.nl
- PGP KEYID : 6CF49689