Mannie@cup.portal.com (William Allison Guynes) (02/12/89)
I got such a response for this Turbo Pascal spooler code that I decided to
share it with everyone. Too many people have been wanting it and it is easier
just to upload the source.
Also included is a small "dumb terminal" program to show you how
ASYNC operates.
If you have any questions. Leave me a message.
----- cut here and all above -----
{ This version of Michael Quinlan's ASYNC.PAS is compatible with IBM PC and
Compatibles. It gives interrupt-driven buffered communications capabilities to
Turbo Pascal programs written for the IBM PC. It is heavily dependent on that
hardware.
The Async_ITR routine was taken from N. Arley Dealey's Async4 procedures, to
make this set of routines work with version 4.0 of Turbo Pascal.
The following example routines are public domain programs that have been
uploaded to our Forum on CompuServe. As a courtesy to our users that do not
have immediate access to CompuServe, Technical Support distributes these
routines free of charge.
However, because these routines are public domain programs, not developed by
Borland International, we are unable to provide any technical support or
assistance using these routines. If you need assistance using these routines,
or are experiencing difficulties, we recommend that you log onto CompuServe and
request assistance from the Forum members that developed these routines. }
UNIT Async;
INTERFACE
USES DOS;
{-----------------------------------------------------------------------------}
{ ASYNC.INC }
{ }
{ Async Communication Routines }
{ by Michael Quinlan }
{ with a bug fixed by Scott Herr }
{ with Async_ISR update to 4.0 by N. Arley Dealey substituted }
{ by Keith Hawes }
{ made PCjr-compatible by W. M. Miller }
{ Highly dependent on the IBM PC and PC DOS 2.0 or later }
{ }
{ based on the DUMBTERM program by CJ Dunford }
{ in the January 1984 }
{ issue of PC Tech Journal. }
{ }
{ Entry points: }
{-----------------------------------------------------------------------------}
PROCEDURE Async_Init;
{-----------------------------------------------------------------------------}
{ Performs initialization. }
{ }
{-----------------------------------------------------------------------------}
FUNCTION Async_Open (ComPort : Word;
BaudRate : Word;
Parity : Char;
WordSize : Word;
StopBits : Word) : Boolean;
{-----------------------------------------------------------------------------}
{ Sets up interrupt vector, initialize the COM port for processing, sets }
{ pointers to the buffer. Returns FALSE if COM port not installed. }
{-----------------------------------------------------------------------------}
FUNCTION Async_Buffer_Check (var C : Char) : Boolean;
{-----------------------------------------------------------------------------}
{ If a character is available, returns TRUE and moves the character from }
{ a buffer to the parameter. Otherwise, returns FALSE. }
{-----------------------------------------------------------------------------}
PROCEDURE Async_Send (C : Char);
{-----------------------------------------------------------------------------}
{ Transmits the character. }
{-----------------------------------------------------------------------------}
PROCEDURE Async_Send_String (s : string);
{-----------------------------------------------------------------------------}
{ Calls Async_Send to send each character of S. }
{-----------------------------------------------------------------------------}
PROCEDURE Async_Close;
{-----------------------------------------------------------------------------}
{ Turns off the COM port interrupts. ** MUST ** BE CALLED BEFORE EXITING }
{ YOUR PROGRAM; otherwise you will see some really strange errors and to }
{ re-boot. }
{-----------------------------------------------------------------------------}
PROCEDURE Async_Change (BaudRate : Word;
Parity : Char;
WordSize : Word;
StopBits : Word);
{-----------------------------------------------------------------------------}
{ Changes communication parameters "on the fly". You cannot use the BIOS }
{ routines because they drop DTR. }
{-----------------------------------------------------------------------------}
VAR
Async_Buffer_Overflow : Boolean; { True if buffer overflow has happened }
Async_Buffer_Used : Word;
Async_MaxBufferUsed : Word;
IMPLEMENTATION { global declarations }
CONST
UART_THR = $00; { offset from base of UART Registers for IBM PC }
UART_RBR = $00;
UART_IER = $01;
UART_IIR = $02;
UART_LCR = $03;
UART_MCR = $04;
UART_LSR = $05;
UART_MSR = $06;
I8088_IMR = $21; { port address of the Interrupt Mask Register }
CONST
Async_Buffer_Max = 4095;
VAR
Async_Interrupt_Save : Pointer;
Async_ExitProc_Save : Pointer;
Async_Buffer : ARRAY [0..Async_Buffer_Max] OF Char;
Async_Open_Flag : Boolean;
Async_Port : Word; { current open port number (1 or 2) }
Async_Base : Word; { base for current open port }
Async_Irq : Word; { irq for current open port }
{ Async_Buffer is empty if Head = Tail }
Async_Buffer_Head : Word; { Locn in Async_Buffer to put next char }
Async_Buffer_Tail : Word; { Locn in Async_Buffer to get next char }
Async_Buffer_NewTail : Word;
Async_BIOS_port_table : ARRAY [1..2] OF Word absolute $40:0;
{-----------------------------------------------------------------------------}
{ This table is initialized by BIOS equipment determination code at boot }
{ time to contain the base addresses for the installed async adapters. A }
{ value of 0 means "not installed." }
{-----------------------------------------------------------------------------}
CONST
Async_Num_Bauds = 8;
Async_Baud_Table : ARRAY [1..Async_Num_Bauds] OF record
Baud,Bits : Word;
END
=((Baud:110; Bits:$00),
(Baud:150; Bits:$20),
(Baud:300; Bits:$40),
(Baud:600; Bits:$60),
(Baud:1200; Bits:$80),
(Baud:2400; Bits:$A0),
(Baud:4800; Bits:$C0),
(Baud:9600; Bits:$E0));
PROCEDURE BIOS_RS232_Init (Comport,Comparm : Word);
{-----------------------------------------------------------------------------}
{ Issue Interrupt $14 to initialize the UART format of ComParm: }
{ (From IBM Technical Reference) }
{ }
{ 7 6 5 4 3 2 1 0 }
{ --Baud Rate-- -Parity StopBit Word Len }
{ 000 = 110 x0 = None 0 = 1 10 = 7 }
{ 001 = 150 01 = Odd 1 = 2 11 = 8 }
{ 010 = 300 11 = Even }
{ 011 = 600 }
{ 100 = 1200 }
{ 101 = 2400 }
{ 110 = 4800 }
{ 111 = 9600 }
{ }
{-----------------------------------------------------------------------------}
VAR
Regs : Registers;
BEGIN
WITH Regs DO
BEGIN
ax := ComParm and $00FF; { AH=0; AL=ComParm }
dx := ComPort;
intr($14,regs)
END;
END;
{-----------------------------------------------------------------------------}
{ ISR - Interrupt Service Routine }
{-----------------------------------------------------------------------------}
PROCEDURE Async_ISR ; INTERRUPT;
{-----------------------------------------------------------------------------}
{ Interrupt Service Routine }
{ Invoked when the USART has received a byte of data from the comm line }
{ re-written 9/10/84 in machine language ; original source left as }
{ comments re-written 1987 to work under Turbo Pascal Version 4.0 }
{-----------------------------------------------------------------------------}
BEGIN
inline($FB/ { STI }
{ get the incoming character }
{ Async_Buffer[Async_Buffer_Head] := CHR(port[Async_Base+UART_RBR]); }
$8B/$16/Async_Base/ { MOV DX,Base }
$EC/ { IN AL,DX }
$8B/$1E/Async_Buffer_Head/ { MOV BX,BufferHead }
$88/$87/Async_Buffer/ { MOV Buffer[BX],AL }
{ Async_Buffer_NewHead := SUCC(Async_Buffer_Head); }
$43/ { INC BX }
{ IF Async_Buffer_NewHead > Async_Buffer_Max
THEN Async_Buffer_NewHead := 0; }
$81/$FB/Async_Buffer_Max/ { CMP BX,BufferMax }
$7E/$02/ { JLE L001 }
$33/$DB/ { XOR BX,BX }
{ IF Async_Buffer_NewHead = Async_Buffer_Tail THEN overflow := TRUE }
{ L001: }
$3B/$1E/Async_Buffer_Tail/ { CMP BX,cbuffer_Tail }
$75/$08/ { JNE L002 }
$C6/$06/Async_Buffer_Overflow/$01/ { MOV Overflow,1 }
$90/ { NOP generated by }
{ Assembler }
$EB/$16/ { JMP SHORT L003 }
{ ELSE }
{ BEGIN }
{ Async_Buffer_Head := Async_Buffer_NewHead; }
{ Async_Buffer_Used := SUCC(Async_Buffer_Used); }
{ IF Async_Buffer_Used > Async_MaxBufferUsed THEN }
{ Async_MaxBufferUsed := Async_BufferUsed }
{ END; }
{ L002: }
$89/$1E/Async_Buffer_Head/ { MOV BufferHead,BX }
$FF/$06/Async_Buffer_Used/ { INC cbufferUsed }
$8B/$1E/Async_Buffer_Used/ { MOV BX,cbufferUsed }
$3B/$1E/Async_MaxBufferUsed/ { CMP BX,cmaxbufferused }
$7E/$04/ { JLE L003 }
$89/$1E/Async_MaxBufferUsed/ { MOV cmaxbufferused,BX }
{ L003: }
$FA/ { CLI }
{ issue non-specific EOI }
{ port[$20] := $20; }
$B0/$20/ { MOV AL,20h }
$E6/$20 { OUT 20h,AL }
)
END { Async_ISR };
PROCEDURE Async_Init;
{ initialize variables }
BEGIN
Async_Open_Flag := FALSE;
Async_Buffer_Overflow := FALSE;
Async_Buffer_Used := 0;
Async_MaxBufferUsed := 0;
END { Async_Init };
PROCEDURE Async_Close;
{ reset the interrupt system when UART interrupts no longer needed }
VAR
i,m : word;
BEGIN
IF Async_Open_Flag THEN
BEGIN
{ disable the IRQ on the 8259 }
Inline($FA); { disable interrupts }
i := Port[I8088_IMR]; { get the interrupt mask register }
m := 1 shl Async_Irq; { set mask to turn off interrupt }
Port[I8088_IMR] := i or m;
{ disable the 8250 data ready interrupt }
Port[UART_IER + Async_Base] := 0;
{ disable OUT2 on the 8250 }
Port[UART_MCR + Async_Base] := 0;
Inline($FB); { enable interrupts }
{ re-initialize our data areas so we know the port is closed }
Async_Open_Flag := FALSE;
{ Version 4 support by Keith Hawes next 2 lines }
SetIntVec(Async_IRQ+8,@Async_Interrupt_Save); { Restore old interrupt }
ExitProc := Async_ExitProc_Save; { Restore Exit{roc chain }
END
END { Async_Close };
FUNCTION Async_Open (ComPort : Word;
BaudRate : Word;
Parity : Char;
WordSize : Word;
StopBits : Word);
{ open a communications port }
VAR
ComParm : Word;
i,m : Word;
BEGIN
IF Async_Open_Flag then Async_Close;
IF (ComPort = 2) and (Async_BIOS_Port_Table[2] <> 0)
THEN Async_Port := 2
ELSE Async_Port := 1; { default to COM1 }
Async_Base := Async_BIOS_Port_Table[Async_Port];
Async_Irq := Hi(Async_Base) + 1;
IF (Port[UART_IIR + Async_Base] and $00F8) <> 0
THEN
Async_Open := FALSE
ELSE
BEGIN
Async_Buffer_Head := 0;
Async_Buffer_Tail := 0;
Async_Buffer_Overflow := FALSE;
{ Build the ComParm for RS232_Init }
{ See Technical Reference Manual for description }
ComParm := $0000;
{ Set up the bits for the baud rate }
i := 0;
REPEAT
i := i + 1;
UNTIL (Async_Baud_Table[i].Baud = BaudRate)
OR (i = Async_Num_Bauds);
ComParm := ComParm or Async_Baud_Table[i].Bits;
IF Parity in ['E','e']
THEN ComParm := ComParm or $0018
ELSE IF Parity in ['O','o']
THEN ComParm := ComParm or $0008
ELSE ComParm := ComParm or $0000; { default to no parity }
IF WordSize = 7
THEN ComParm := ComParm or $0002
ELSE ComParm := ComParm or $0003; { default to 8 data bits }
IF StopBits = 2
THEN ComParm := ComParm or $0004
ELSE ComParm := ComParm or $0000;
{ use the BIOS ROM port initialization routine to save typing }
{ the code }
BIOS_RS232_Init(Async_Port - 1,ComParm);
GetIntVec(Async_Irq + 8,Async_Interrupt_Save);
{ version 4 support KH }
Async_ExitProc_Save := ExitProc; { version 4 support KH }
ExitProc := @Async_Close; { version 4 support KH }
SetIntVec(Async_Irq + 8,@Async_Isr); { version 4 support KH }
{ read the RBR and reset any possible pending error conditions. }
{ First turn off the Divisor Access Latch Bit to allow access to }
{ RBR, etc. }
Inline($FA); { disable interrupts }
Port[UART_LCR + Async_Base] := Port[UART_LCR + Async_Base] and $7F;
{ read the Line Status Register to reset any errors it indicates }
i := Port[UART_LSR + Async_Base];
{ read the receiver buffer register in case it contains a character }
i := Port[UART_RBR + Async_Base];
{ enable the irq on the 8259 controller }
i := Port[I8088_IMR]; { get the interrupt mask register }
m := (1 shl Async_Irq) xor $00FF;
Port[I8088_IMR] := i and m;
{ enable the data ready interrupt on the 8250 }
Port[UART_IER + Async_Base] := $01;
{ enable data ready interrupt }
{ enable OUT2 on 8250 }
i := Port[UART_MCR + Async_Base];
Port[UART_MCR + Async_Base] := i or $08;
Inline($FB); { enable interrupts }
Async_Open_Flag := TRUE
END;
END { Async_Open };
FUNCTION Async_Buffer_Check (VAR C : Char) : Boolean;
{ see if a character has been received; return it if yes }
BEGIN
IF Async_Buffer_Head = Async_Buffer_Tail
THEN Async_Buffer_Check := FALSE
ELSE
BEGIN
C := Async_Buffer[Async_Buffer_Tail];
Async_Buffer_Tail := Async_Buffer_Tail + 1;
IF Async_Buffer_Tail > Async_Buffer_Max
THEN Async_Buffer_Tail := 0;
Async_Buffer_Used := Async_Buffer_Used - 1;
Async_Buffer_Check := TRUE
END
END { Async_Buffer_Check};
PROCEDURE Async_Send (C : Char); { transmit a character }
VAR
i,m,Counter : Word;
BEGIN
Port[UART_MCR + Async_Base] := $0B; { turn on OUT2, DTR, and RTS }
{ wait for CTS }
Counter := MaxInt;
WHILE (Counter <> 0) AND ((Port[UART_MSR+Async_Base] and $10) = 0)
DO Counter := Counter - 1;
{ wait for Transmit Hold Register Empty (THRE) }
IF Counter <> 0 THEN Counter := MaxInt;
WHILE (Counter <> 0) AND ((Port[UART_LSR+Async_Base] and $20) = 0)
DO Counter := Counter - 1;
IF Counter <> 0
THEN
BEGIN { send the character }
Inline($FA); { disable interrupts }
Port[UART_THR + Async_Base] := Ord(C);
Inline($FB); { enable interrupts }
END
ELSE WriteLn('<<<TIMEOUT>>>');
END { Async_Send };
PROCEDURE Async_Send_String (s : string); { transmit a string }
VAR
i : Word;
BEGIN
FOR i := 1 TO Length(S)
DO Async_Send(S[i])
END { Async_Send_String };
PROCEDURE Async_Change (BaudRate : Word;
Parity : Char;
WordSize : Word;
StopBits : Word);
{ change communications parameters "on the fly" you cannot use the BIOS }
{ routines because they drop DTR }
CONST num_bauds = 15;
divisor_table : ARRAY [1..num_bauds] OF record
baud,divisor : word
END
= ((Baud:50; Divisor:2304),
(Baud:75; Divisor:1536),
(Baud:110; Divisor:1047),
(Baud:134; Divisor:857),
(Baud:150; Divisor:768),
(Baud:300; Divisor:384),
(Baud:600; Divisor:192),
(Baud:1200; Divisor:96),
(Baud:1800; Divisor:64),
(Baud:2000; Divisor:58),
(Baud:2400; Divisor:48),
(Baud:3600; Divisor:32),
(Baud:4800; Divisor:24),
(Baud:7200; Divisor:16),
(Baud:9600; Divisor:12));
VAR
i : Word;
dv : Word;
lcr : Word;
BEGIN
{ Build the Line Control Register and find the divisor }
{ (for the baud rate) }
{ Set up the divisor for the baud rate }
i := 0;
REPEAT
i := i + 1
UNTIL (Divisor_Table[i].Baud = BaudRate) OR (i = num_bauds);
dv := Divisor_Table[i].divisor;
lcr := 0;
CASE Parity OF
'E' : lcr := lcr or $18; { even parity }
'O' : lcr := lcr or $08; { odd parity }
'N' : lcr := lcr or $00; { no parity }
'M' : lcr := lcr or $28; { Mark parity }
'S' : lcr := lcr or $38; { Space parity }
ELSE
lcr := lcr or $00; { default to no parity }
END;
CASE WordSize OF
5 : lcr := lcr or $00;
6 : lcr := lcr or $01;
7 : lcr := lcr or $02;
8 : lcr := lcr or $03;
ELSE
lcr := lcr or $03; { default to 8 data bits }
END;
IF StopBits = 2
THEN lcr := lcr or $04
ELSE lcr := lcr or $00; { default to 1 stop bit }
lcr := lcr and $7F; { make certain that DLAB is off }
Inline($FA); { disable interrupts }
{ turn on DLAB to access the divisor }
Port[UART_LCR + Async_Base] := Port[UART_LCR + Async_Base] or $80;
{ set the divisor }
Port[Async_Base] := Lo(dv);
Port[Async_Base + 1] := Hi(dv);
{ turn off the DLAB and set the new comm. parameters }
Port[UART_LCR + Async_Base] := lcr;
Inline($FB); { enable interrupts }
END { Async_Change };
END. { Unit }
************************* split here ************************************
{ Test program... place in a seperate file }
PROGRAM tty;
USES Crt,Async;
VAR
c : Char;
BEGIN
Async_Init; { Initialize variables }
IF NOT Async_Open(2,1200,'E',7,1) THEN { open communications port }
BEGIN
Writeln('**ERROR: Async_Open failed');
Halt
END;
Writeln('TTY Emulation begins now...');
Writeln('Press ESC key to terminate...');
REPEAT
IF Async_Buffer_Check(c) THEN
CASE c OF
#000 : ; { strip incoming nulls }
#010 : ; { strip incoming line feeds }
#012 : ClrScr; { clear screen on a form feed }
#013 : Writeln { handle carriage return as CR/LF }
ELSE
Write(c) { else write incoming char to the screen }
END { CASE };
IF KeyPressed THEN
BEGIN
c := ReadKey;
IF c = #027 THEN { Trap Esc Key }
BEGIN
Async_Close; { reset the interrupt system, etc. }
Writeln('End of TTY Emulation...');
Halt; { terminate the program }
END
ELSE
Async_Send(c)
END;
UNTIL FALSE;
END.