[Back to COMM SWAG index] [Back to Main SWAG index] [Original]
{ Unit UART - serielle I/O v3 07/91,08/92,01/93 }
{ by Peter Mandrella, P.Mandrella@HOT.gun.de }
{ Dieser Quelltext ist Public Domain. }
{$B-,R-,S-,V-,F-,I-,A+}
unit uart;
{---------------------------------------------------------------------------)
Zu benutzende Schnittstellen sind zuerst mit SetUart zu initialisieren.
Anschließend können sie mit ActivateCom aktiviert und mit ReleaseCom
wieder freigegeben werden. Beim Aktivieren ist die Größe des COM-Puffers
anzugeben; werden mehr als BufferSize Bytes empfangen und nicht abgeholt,
dann wird der Puffer komplett gelöscht und der Inhalt geht verloren!
Das Desaktivieren ist nicht unbedingt nötig, sondern erfolgt falls
nötig auch automatisch bei Programmende.
Das Empfangen von Daten erfolgt asynchron im Hintergrund. Mit Receive
können empfangene Daten abgeholt werden. Die Funktion liefert FALSE,
falls keine Daten vorhanden waren. Wahlweise kann auch mit Received
getestet werden, ob Daten anliegen, ohne diese zu lesen, oder mit
Peek ein Byte - falls vorhanden - abgeholt, aber nicht aus dem Puffer
entfernt werden.
Das Senden von Daten erfolgt mit SendByte (ohne CTS-Handshake) oder
mit HSendByte (mit CTS-Handshake).
Über die Funktionen RRing und Carrier kann getestet werden, ob ein
Klingelzeichen bzw. ein Carrier am Modem anliegt.
Da für COM3 und COM4 kein Default-IRQ existiert, können mit SetComParams
Adresse und IRQ einzelner Schnittstellen eingestellt werden. Vor dieser
Einstellung werden COM3 und COM4 nicht unterstützt. Default-Adressen
sind $3e8 und $2e8. Die Parameter von COM1 und COM2 sind korrekt
eingestellt und sollten normalerweise nicht geändert werden.
(---------------------------------------------------------------------------}
interface
uses dos;
{$IFNDEF DPMI}
const Seg0040 = $40;
{$ENDIF}
const coms = 4; { Anzahl der unterstützten Schnittstellen }
ua : array[1..coms] of word = ($3f8,$2f8,$3e8,$2e8);
datainout = 0; { UART-Register-Offsets }
intenable = 1;
intids = 2; { Read }
fifoctrl = 2; { Write }
linectrl = 3;
modemctrl = 4;
linestat = 5;
modemstat = 6;
scratch = 7;
UartNone = 0; { Ergebnisse von ComType }
Uart8250 = 1;
Uart16450 = 2;
Uart16550 = 3;
Uart16550A = 4;
NoFifo = $00; { Triggerlevel bei 16550-Chips }
FifoTL1 = $07;
FifoTL4 = $47;
FifoTL8 = $87;
FifoTL14 = $C7;
type paritype = (Pnone,Podd,Pxxxx,Peven); { mögliche Paritäts-Typen }
{ Parameter für Schnittstelle einstellen
{ no : Nummer (1-4)
address : I/O-Adresse, 0 -> Adresse wird beibehalten
_irq : Interrupt-Nummer (z.B. 3 für IRQ3, 4 für IRQ4); 0..15 }
procedure SetComParams(no:byte; address:word; _irq:byte);
{ Schnittstellen-Parameter einstellen
commno : Nummer der Schnittstelle (1-4)
baudrate : Baudrate im Klartext; auch nicht-Standard-Baudraten möglich!
parity : s.o.
wlength : Wort-länge (7 oder 8)
stops : Stop-Bits (1 oder 2) }
function ComType(no:byte):byte; { Typ des UART-Chips ermitteln }
procedure SetUart(comno:byte; baudrate:longint; parity:paritype;
wlength,stops:byte);
{ Schnittstelle aktivieren
no : Nummer der Schnittstelle
buffersize : Größe des Puffers
FifoTL : Falls ein 16550 vorhanden ist, kann man hier die Konstanten
für den Triggerlevel einsetzen (s.o.)}
procedure ActivateCom(no:byte; buffersize:word; FifoTL:Byte);
procedure ReleaseCom(no:byte); { Schnitte desakt., Puffer freig. }
function receive(no:byte; var b:byte):boolean; { Byte holen, falls vorh. }
function peek(no:byte; var b:byte):boolean; {dito, aber Byte bleibt im Puffer}
function received(no:byte):boolean; { Testen, ob Daten vorhanden }
procedure flushinput(no:byte); { Receive-Puffer löschen }
procedure SendByte(no,b:byte); { Byte senden }
procedure hsendbyte(no,b:byte); { Byte senden, mit CTS-Handshake }
procedure putbyte(no,b:byte); { Byte im Puffer hinterlegen }
function rring(no:byte):boolean; { Telefon klingelt }
function carrier(no:byte):boolean; { Carrier vorhanden }
function getCTS(no:byte):boolean; { True = (cts=1) }
procedure DropDtr(no:byte); { DTR=0 setzen }
procedure SetDtr(no:byte); { DTR=1 setzen }
procedure DropRts(no:byte); { RTS=0 setzen }
procedure SetRts(no:byte); { RTS=1 setzen }
procedure SendBreak(no:byte); { Break-Signal }
implementation {-----------------------------------------------------}
const active : array[1..coms] of boolean = (false,false,false,false);
irq : array[1..coms] of byte = ($04,$03,0,0);
intmask : array[1..coms] of byte = ($10,$08,0,0);
intcom2 : array[1..coms] of boolean = (false,false,false,false);
MS_CTS = $10; { Modem-Status-Register }
MS_DSR = $20;
MS_RI = $40; { Ring Indicator: Klingelsignal }
MS_DCD = $80; { Data Carrier Detect }
MC_DTR = $01; { Modem Control Register }
MC_RTS = $02;
type bufft = array[0..65534] of byte;
var savecom : array[1..coms] of pointer;
exitsave : pointer;
bufsize : array[1..coms] of word;
buffer : array[1..coms] of ^bufft;
bufi,bufo : array[1..coms] of word;
procedure error(text:string);
begin
writeln('UART Fehler: ',text);
end;
function strs(l:longint):string;
var s : string;
begin
str(l,s);
strs:=s;
end;
{--- Interrupt-Handler -----------------------------------------------}
procedure cli; inline($fa); { Interrupts sperren }
procedure sti; inline($fb); { Interrupts freigeben }
procedure com1server; interrupt;
begin
if intcom2[1] then port[$a0]:=$20;
port[$20]:=$20; { Interrupt-Controller resetten }
buffer[1]^[bufi[1]]:=port[ua[1]];
inc(bufi[1]); if bufi[1]=bufsize[1] then bufi[1]:=0;
end;
procedure com2server; interrupt;
begin
if intcom2[2] then port[$a0]:=$20;
port[$20]:=$20;
buffer[2]^[bufi[2]]:=port[ua[2]];
inc(bufi[2]); if bufi[2]=bufsize[2] then bufi[2]:=0;
end;
procedure com3server; interrupt;
begin
if intcom2[3] then port[$a0]:=$20;
port[$20]:=$20;
buffer[3]^[bufi[3]]:=port[ua[3]];
inc(bufi[3]); if bufi[3]=bufsize[3] then bufi[3]:=0;
end;
procedure com4server; interrupt;
begin
if intcom2[4] then port[$a0]:=$20;
port[$20]:=$20;
buffer[4]^[bufi[4]]:=port[ua[4]];
inc(bufi[4]); if bufi[4]=bufsize[4] then bufi[4]:=0;
end;
procedure com1FIFOserver; interrupt;
begin
if port[ua[1]+intids] and 4<>0 then
repeat
buffer[1]^[bufi[1]]:=port[ua[1]];
inc(bufi[1]); if bufi[1]=bufsize[1] then bufi[1]:=0;
until not odd(port[ua[1]+linestat]);
if intcom2[1] then port[$a0]:=$20;
port[$20]:=$20; { Interrupt-Controller resetten }
end;
procedure com2FIFOserver; interrupt;
begin
if port[ua[2]+intids] and 4<>0 then
repeat
buffer[2]^[bufi[2]]:=port[ua[2]];
inc(bufi[2]); if bufi[2]=bufsize[2] then bufi[2]:=0;
until not odd(port[ua[2]+linestat]);
if intcom2[2] then port[$a0]:=$20;
port[$20]:=$20;
end;
procedure com3FIFOserver; interrupt;
begin
if port[ua[3]+intids] and 4<>0 then
repeat
buffer[3]^[bufi[3]]:=port[ua[3]];
inc(bufi[3]); if bufi[3]=bufsize[3] then bufi[3]:=0;
until not odd(port[ua[3]+linestat]);
if intcom2[3] then port[$a0]:=$20;
port[$20]:=$20;
end;
procedure com4FIFOserver; interrupt;
begin
if port[ua[4]+intids] and 4<>0 then
repeat
buffer[4]^[bufi[4]]:=port[ua[4]];
inc(bufi[4]); if bufi[4]=bufsize[4] then bufi[4]:=0;
until not odd(port[ua[4]+linestat]);
if intcom2[4] then port[$a0]:=$20;
port[$20]:=$20;
end;
{--- UART-Typ ermitteln ----------------------------------------------}
{ Hinweis: Die Erkennung des 16550A funktioniert nur bei Chips, }
{ die weitgehend kompatibel zum Original-16550A von NS }
{ sind. Das gilt allerdings für die meisten verwendeten }
{ 16500A's - ich schätze, für ca. 97-99% }
function ComType(no:byte):byte; { Typ des UART-Chips ermitteln }
var uart : word;
lsave,ssave : byte;
isave,iir : byte;
begin
uart:=ua[no];
lsave:=port[uart+linectrl];
port[uart+linectrl]:=lsave xor $ff;
if port[uart+linectrl]<>lsave xor $ff then
ComType:=UartNone
else begin
port[uart+linectrl]:=lsave;
ssave:=port[uart+scratch];
port[uart+scratch]:=$5a;
if port[uart+scratch]<>$5a then
ComType:=Uart8250 { kein Scratchpad vorhanden }
else begin
port[uart+scratch]:=$a5;
if port[uart+scratch]<>$a5 then
ComType:=Uart8250 { kein Scratchpad vorhanden }
else begin
isave:=port[uart+intids];
port[uart+fifoctrl]:=1;
iir:=port[uart+intids];
if isave and $80=0 then port[uart+fifoctrl]:=0;
if iir and $40<>0 then ComType:=Uart16550A
else if iir and $80<>0 then ComType:=Uart16550
else ComType:=Uart16450;
end;
end;
port[uart+scratch]:=ssave;
end;
end;
{--- Schnitte einstellen / aktivieren / freigeben --------------------}
procedure SetComParams(no:byte; address:word; _irq:byte);
begin
if (no>=1) and (no<=coms) then begin
if address<>0 then ua[no]:=address;
irq[no]:=_irq;
intmask[no]:=(1 shl (_irq and 7));
intcom2[no]:=(_irq>7); { 2. Interrupt-Controller }
end;
end;
procedure setuart(comno:byte; baudrate:longint; parity:paritype;
wlength,stops:byte);
var uart : word;
begin
uart:=ua[comno];
port[uart+linectrl]:=$80;
port[uart+datainout]:=lo(word(115200 div baudrate));
port[uart+datainout+1]:=hi(word(115200 div baudrate));
port[uart+linectrl]:= (wlength-5) or (stops-1)*4 or ord(parity)*8;
port[uart+modemctrl]:=$0b;
if port[uart+datainout]<>0 then; { dummy }
end;
procedure clearstatus(no:byte);
begin
if port[ua[no]+datainout]<>0 then; { dummy-Read }
if port[ua[no]+linestat]<>0 then;
if port[ua[no]+modemstat]<>0 then;
if intcom2[no] then port[$a0]:=$20;
port[$20]:=$20;
end;
function IntNr(no:byte):byte;
begin
if irq[no]<8 then IntNr:=irq[no]+8
else IntNr:=irq[no]+$68;
end;
procedure ActivateCom(no:byte; buffersize:word; FifoTL:Byte);
var p : pointer;
i : byte;
begin
if active[no] then begin
error('Schnittstelle '+strs(no)+' bereits aktiviert!');
exit;
end
else if (no<1) or (no>coms) or (irq[no]=0) then
error('Schnittstelle '+strs(no)+' (noch) nicht unterstützt!')
else
active[no]:=true;
bufsize[no]:=buffersize; { Puffer anlegen }
getmem(buffer[no],buffersize);
bufi[no]:=0; bufo[no]:=0;
fillchar(buffer[no]^,bufsize[no],0);
IF (fifotl > 0)
THEN BEGIN
Port[(ua[no] + fifoctrl)] := fifotl;
IF ((Port[(ua[no] + intids)] AND $40) = 0)
THEN BEGIN
Port[(ua[no] + fifoctrl)] := 0;
fifotl := NoFifo;
END;
END;
IF (fifotl > 0)
THEN CASE no OF
1 : p:=@com1FIFOserver;
2 : p:=@com2FIFOserver;
3 : p:=@com3FIFOserver;
4 : p:=@com4FIFOserver;
END {CASE}
ELSE CASE no OF
1 : p:=@com1server;
2 : p:=@com2server;
3 : p:=@com3server;
4 : p:=@com4server;
END; {CASE}
getintvec(IntNr(no),savecom[no]); { IRQ setzen }
setintvec(IntNr(no),p);
port[ua[no]+intenable]:=$01; { Int. bei Empfang }
if intcom2[no] then
port[$a1]:=port[$a1] and (not intmask[no]) { Ints freigeben }
else
port[$21]:=port[$21] and (not intmask[no]);
clearstatus(no);
end;
procedure releasecom(no:byte);
begin
if not active[no] then
error('Schnittstelle '+strs(no)+' nicht aktiv!')
else begin
active[no]:=false;
port[ua[no]+intenable]:=0;
if intcom2[no] then
port[$a1]:=port[$a1] or intmask[no] { Controller: COMn-Ints sperren }
else
port[$21]:=port[$21] or intmask[no];
port[ua[no]+fifoctrl]:=0;
setintvec(IntNr(no),savecom[no]);
clearstatus(no);
freemem(buffer[no],bufsize[no]);
end;
end;
{ Exit-Prozedur }
{$F+}
procedure comexit;
var i : byte;
begin
for i:=1 to coms do
if active[i] then begin
DropDtr(i);
releasecom(i);
end;
exitproc:=exitsave;
end;
{$F-}
{--- Daten senden / empfangen ----------------------------------------}
function received(no:byte):boolean; { Testen, ob Daten vorhanden }
begin
received:=(bufi[no]<>bufo[no]);
end;
function receive(no:byte; var b:byte):boolean; { Byte holen, falls vorh. }
begin
if bufi[no]=bufo[no] then
receive:=false
else begin
b:=buffer[no]^[bufo[no]];
inc(bufo[no]);
if bufo[no]=bufsize[no] then bufo[no]:=0;
receive:=true;
end;
end;
function peek(no:byte; var b:byte):boolean;
begin
if bufi[no]=bufo[no] then
peek:=false
else begin
b:=buffer[no]^[bufo[no]];
peek:=true;
end;
end;
procedure sendbyte(no,b:byte); { Byte senden }
begin
while (port[ua[no]+linestat] and $20) = 0 do;
port[ua[no]]:=b;
end;
procedure hsendbyte(no,b:byte); { Byte senden, mit CTS-Handshake }
begin
while (port[ua[no]+modemstat] and $10) = 0 do;
while (port[ua[no]+linestat] and $20) = 0 do;
port[ua[no]]:=b;
end;
procedure putbyte(no,b:byte); { Byte im Puffer hinterlegen }
begin
if bufo[no]=0 then bufo[no]:=bufsize[no]
else dec(bufo[no]);
buffer[no]^[bufo[no]]:=b;
end;
procedure flushinput(no:byte); { Receive-Puffer löschen }
begin
bufo[no]:=bufi[no];
end;
{--- Modem-Status-Lines ----------------------------------------------}
function rring(no:byte):boolean; { Telefon klingelt }
begin
rring:=(port[ua[no]+modemstat] and MS_RI)<>0;
end;
function carrier(no:byte):boolean; { Carrier vorhanden }
begin
carrier:=(port[ua[no]+modemstat] and MS_DCD)<>0;
end;
procedure DropDtr(no:byte); { DTR=0 setzen }
begin
port[ua[no]+modemctrl]:=port[ua[no]+modemctrl] and (not MC_DTR);
end;
procedure SetDtr(no:byte); { DTR=1 setzen }
begin
port[ua[no]+modemctrl]:=port[ua[no]+modemctrl] or MC_DTR;
end;
procedure DropRts(no:byte); { RTS=0 setzen }
begin
port[ua[no]+modemctrl]:=port[ua[no]+modemctrl] and (not MC_RTS);
end;
procedure SetRts(no:byte); { RTS=1 setzen }
begin
port[ua[no]+modemctrl]:=port[ua[no]+modemctrl] or MC_RTS;
end;
{ True -> Modem (oder entsprechendes Gerät) ist bereit, Daten zu empfangen }
function GetCTS(no:byte):boolean;
begin
getcts:=((port[ua[no]+modemstat] and $10)<>0) and
((port[ua[no]+linestat] and $20)<>0);
end;
function ticker:longint;
begin
ticker:=meml[Seg0040:$6c];
end;
procedure SendBreak(no:byte); { Break-Signal }
var teiler : word;
btime : longint;
t0 : longint;
begin
CLI;
port[ua[no]+linectrl]:=port[ua[no]+linectrl] or $80;
teiler:=port[ua[no]] + 256*port[ua[no]+1];
port[ua[no]+linectrl]:=port[ua[no]+linectrl] and $7f;
STI;
btime:=teiler DIV 200;
IF (btime<1) THEN btime:=1;
t0:=ticker;
inc(btime,ticker);
Port[ua[no]+linectrl]:=port[ua[no]+linectrl] or $40; { set break }
repeat
until (ticker>btime) or (ticker<t0);
Port[ua[no]+linectrl]:=port[ua[no]+linectrl] and $bf; { clear break }
end;
begin
exitsave:=exitproc;
exitproc:=@comexit;
end.
[Back to COMM SWAG index] [Back to Main SWAG index] [Original]