(* Async support, and yes i know there is crap in here for fossil. *)
(* But the fossil support crap hasnt been taken out yet. And the *)
(* real fossil support is in FOSSIL.pas *)
Unit async;
Interface
procedure aModemWrite(s : string;display : boolean);
Procedure SetBaud (NewRate : LongInt);
Function GetBaud : LongInt;
Function Comm_Init (Baud : LongInt; ThePort : Byte) : Boolean;
Procedure ModemDeInit;
Procedure SetDTR (OnOff : Boolean);
Function SendReady: Boolean;
Function Carrier : Boolean;
Function DataAvailable : Boolean;
Function GetChar : Char;
Procedure HangUp;
Function Ringing : Boolean;
Procedure SendByte (Ch : Char);
Procedure AsyncFlushOutput;
Procedure AsyncPurgeOutput;
Procedure AsyncPurgeInput;
Procedure SendBreak;
Procedure CTS_RTS (OnOff : Boolean);
Procedure AWrite (S : String);
Procedure AWriteLn (S : String);
Var CanUseFossil : Boolean;
UsedPort : Byte;
Implementation
Uses Crt, { Borland CRT Routines }
Dos, { Borland Disk I/O Routines }
genTypes;
Const MaxPhysPort = 7;
BufferSize = 8196;
BufferMax = 8195;
CommInterrupt = $14 ;
I8088_IMR = $21 ; { port address of the Interrupt Mask Register }
IBM_UART_THR = $00 ;
IBM_UART_RBR = $00 ;
IBM_UART_IER = $01 ;
IBM_UART_IIR = $02 ;
IBM_UART_LCR = $03 ;
IBM_UART_MCR = $04 ;
IBM_UART_LSR = $05 ;
IBM_UART_MSR = $06 ;
PortTable : Array [0..MaxPhysPort] Of Record
Base : Word;
IRQ : Byte
End = ((Base : $3F8; IRQ : 4),
(Base : $2F8; IRQ : 3),
(Base : $3E8; IRQ : 4),
(Base : $2E8; IRQ : 3),
(Base : 0; IRQ : 0),
(Base : 0; IRQ : 0),
(Base : 0; IRQ : 0),
(Base : 0; IRQ : 0));
Var BIOS_Ports, IRQ : Byte;
Old_IER, Old_IIR, Old_LCR, Old_MCR, Old_IMR : Byte;
ExitSave, OriginalVector : Pointer;
IsOpen, OverFlow, UseFossil, CTS_RTS_On : Boolean;
Base, BufferHead, BufferTail, BufferNewTail : Word;
Status, RxWord, CtsTimer : Word;
Buffer : Array [0..BufferMax] Of
Byte; Regs : Registers;
Procedure Comm_SetBios (NewRate : LongInt);
Var BaudRate : Byte;
Temp0 : Integer;
Begin
{$IFNDEF TEST}
Temp0 := NewRate Div 10;
Case Temp0 of
30 : BaudRate := $43;
60 : BaudRate := $63;
120 : BaudRate := $83;
240 : BaudRate := $A3;
480 : BaudRate := $C3;
960 : BaudRate := $E3;
1920 : BaudRate := $03;
3840 : BaudRate := $23;
5760 : BaudRate := $23;
End;
Regs.AH := 0;
Regs.AL := BaudRate;
Regs.DX := UsedPort;
Intr ($14, Regs);
{$ENDIF}
End;
Procedure Comm_SetDirect (NewRate : LongInt);
Var I, J, K : Word;
Temp : LongInt;
Begin
{$IFNDEF TEST}
Temp := 115200;
Temp := Temp DIV Newrate;
Move (Temp, J, 2);
K := Port [IBM_UART_LCR + Base];
port [IBM_UART_LCR + Base] := $80;
Port [IBM_UART_THR + Base] := Lo (J);
Port [IBM_UART_IER + Base] := Hi (J);
Port [IBM_UART_LCR + Base] := 3;
{$ENDIF}
End;
Procedure SetBaud (NewRate : LongInt);
Begin
{$IFNDEF TEST}
If UseFossil Then Comm_SetBios (NewRate) Else Comm_SetDirect (NewRate);
{$ENDIF}
End;
Function Getbaud : LongInt;
Var I, J, K : Word;
Temp : LongInt;
begin
{$IFNDEF TEST}
K := Port [ibm_UART_LCR + Base];
Port [IBM_UART_LCR + Base] := K OR $80;
i := Port [IBM_UART_THR + Base];
J := Port [IBM_UART_IER + Base];
J := J * $100;
J := J + I;
Port [IBM_UART_LCR + base] := k;
Temp := 115200;
Temp := Temp DIV J;
GetBaud := Temp;
{$ELSE}
GetBaud := 4800;
{$ENDIF}
End;
Function Carrier : Boolean;
Begin
{$IFNDEF TEST}
Carrier := Port [IBM_UART_MSR + Base] AND $80 = $80;
{$ELSE}
Carrier := False;
{$ENDIF}
End;
Procedure DisableInterrupts; Inline ($FA);
Procedure EnableInterrupts; Inline ($FB);
Procedure ISR; Interrupt;
Begin
{$IFNDEF TEST}
Inline(
$FB/ { sti }
{Start: }
{ get the incoming character }
{ Buffer[BufferHead] := chr(port[base + ibm_uart_rbr]); }
$8B/$16/Base/ { mov dx,Base }
$EC/ { in al,dx }
$8B/$1E/BufferHead/ { mov bx,BufferHead }
$88/$87/Buffer/ { mov Buffer[bx],al }
{ BufferNewHead := Succ (BufferHead); }
$43/ { inc bx }
{ if BufferNewHead > BufferMax then BufferNewHead := 0 ; }
$81/$FB/BufferMax/ { cmp bx,BufferMax }
$7E/$02/ { jle l001 }
$33/$DB/ { xor bx,bx }
{ if BufferNewHead = BufferTail then Overflow := true }
{L001: }
$3B/$1E/BufferTail/ { cmp bx,BufferTail }
$75/$07/ { jne L002 }
$C6/$06/Overflow/$01/ { mov overflow,1 }
$EB/$0E/ { jmp short L003 }
{ ELSE BEGIN }
{ BufferHead := BufferNewHead; }
{ Async_BufferUsed := succ(Async_BufferUsed); }
{ IF Async_BufferUsed > Async_MaxBufferUsed then }
{ Async_MaxBufferUsed := Async_BufferUsed }
{ END ; }
{L002: }
$89/$1E/BufferHead/ { mov BufferHead,bx }
$83/$C2/$05/ { Add dx,5 }
{ Check FIFO - And process if more bytes. }
$EC/ { In al,dx }
$24/$01/ { And al,$01 }
$3C/$01/ { cmp al,$01 }
$74/$CF/ { je start: }
{L003: }
$FA/ { cli }
{ issue non-specific EOI }
{ port[$20] := $20 ; }
$B0/$20/ { mov al,20h }
$E6/$20); { out 20h,al }
{$ENDIF}
End;
Procedure Async_Close;
Begin
{$IFNDEF TEST}
If IsOpen Then
Begin
DisableInterrupts;
Port [I8088_IMR] := (Port[I8088_IMR] OR (1 SHL IRQ));
Port [IBM_UART_IER + Base] := Old_IER;
EnableInterrupts;
Port [IBM_UART_MCR + Base] := Old_MCR;
Port [IBM_UART_LCR + Base] := Old_lCR;
SetIntVec (IRQ + 8, OriginalVector);
IsOpen := False;
End;
{$ENDIF}
End;
Function Init_fossil (Baud : LongInt; ThePort : Byte) : Boolean;
Begin
{$IFNDEF TEST}
UsedPort := ThePort - 1;
Regs.AH := 4;
Regs.DX := UsedPort;
Intr ($14, Regs);
If Regs.AX <> $1954 Then Init_Fossil := False Else
Begin
Init_Fossil := True;
UseFossil := True;
SetBaud (Baud);
End;
{$ELSE}
Init_Fossil := True;
{$ENDIF}
End;
Function Async_Open(Baud : Longint; LogicalPortNum: byte): boolean;
Var I, OldIIR : Byte;
Fifos, PortThere : Boolean;
Begin
{$IFNDEF TEST}
If Not IsOpen Then
Begin
BufferHead := 0;
BufferTail := 0;
Overflow := False;
UsedPort := Pred (LogicalPortNum);
Fifos := False;
IsOpen := False;
If PortTable [UsedPort].Base <> 0 Then
Begin
Base := PortTable [UsedPort].Base;
IRQ := PortTable [UsedPort].IRQ;
Old_IER := Port [IBM_UART_IER + Base];
Old_MCR := Port [IBM_UART_MCR + Base];
Old_LCR := Port [IBM_UART_LCR + Base];
Port [IBM_UART_LCR + Base] := $75;
PortThere := (Port [IBM_UART_LCR + Base] = $75);
Port [IBM_UART_LCR + Base] := $3;
If PortThere Then
Begin
Comm_SetDirect (Baud);
Port [IBM_UART_MCR + Base] := $0B;
OldIIR := Port [IBM_UART_IIR + Base];
Port [IBM_UART_IIR + Base] := 1;
Fifos := (Port [IBM_UART_IIR + Base] AND $C0 = $C0);
If Not Fifos Then Port [IBM_UART_IIR + Base] := OldIIR;
GetIntVec (IRQ + 8, OriginalVector);
SetIntVec (IRQ + 8, @ISR);
DisableInterrupts;
Port [I8088_IMR] := (Port [I8088_IMR] AND ((1 SHL IRQ) XOR $FF));
Port [IBM_UART_IER + Base] := 1;
EnableInterrupts;
IsOpen := True;
End;
End;
End;
Async_Open := IsOpen
{$ELSE}
Async_Open := True;
{$ENDIF}
End;
{$F+}
Procedure TerminateUnit;
{$F-}
Begin
Async_Close;
ExitProc := ExitSave
End;
Function Comm_init (Baud : Longint; ThePort : Byte) : Boolean;
Begin
{$IFNDEF TEST}
UseFossil := False;
If Not IsOpen Then
Begin
If (CanUseFossil) AND (Init_Fossil (Baud, ThePort)) Then
Begin
Comm_Init := True;
IsOpen := True;
Base := PortTable [UsedPort].Base;
End Else
Begin
If Async_Open (Baud, ThePort) Then
Begin
Comm_Init := true;
IsOpen := True;
End Else Comm_Init := False;
End;
End;
UsedPort := ThePort;
{$ELSE}
Comm_Init := True;
{$ENDIF}
End;
Function DataAvailable : Boolean;
Var AHigh : Byte;
Begin
{$IFNDEF TEST}
If UseFossil Then
Begin
Inline ($B4/$03/ { MOV AH, 3 }
$8b/$16/UsedPort/ { MOV DX, Usedport }
$cd/$14/ { INT 14h }
$a3/Status); { MOV [Status], AL }
DataAvailable := ((Status AND $100) <> 0);
End Else DataAvailable := (Bufferhead <> BufferTail);
{$ELSE}
DataAvailable := False;
{$ENDIF}
End;
Procedure ModemDeInit;
Begin
{$IFNDEF TEST}
If IsOpen Then
Begin
If UseFossil Then
Begin
Regs.AH := 5;
Regs.DX := UsedPort;
Intr ($14, Regs);
End Else Async_Close;
IsOpen := False;
End;
{$ENDIF}
End;
Function GetChar : char;
Begin
{$IFNDEF TEST}
If UseFossil Then
Begin
Inline ($B4/$02/ { MOV AH, 3 }
$8b/$16/UsedPort/ { MOV Dx, Usedport }
$CD/$14/ { INT 14h }
$A3/RXWord); { Mov [Status], AL }
GetChar := chr(Lo (RXWord));
End Else
Begin
GetChar := chr(Buffer [BufferTail]) ;
BufferTail := (Succ (BufferTail) MOD BufferSize) ;
End;
{$ENDIF}
End;
Function SendReady : boolean;
Var Ahigh : Byte;
Carr, CTS, THR : boolean;
Begin
{$IFNDEF TEST}
If UseFossil Then
Begin
Inline ($B4/$03/ { MOV AH, 3 }
$8B/$16/UsedPort/ { MOV DX, Usedport }
$CD/$14/ { INT 14h }
$A3/Status); { MOV Status, AX }
THR := (Status AND $2000) <> 0;
Carr := (Status AND $0080) <> 0;
SendReady := THR OR (Not Carr);
End Else
Begin
THR := ((Port [IBM_UART_LSR + Base] AND $20) <> 0);
CTS := (Port [IBM_UART_MSR + Base] AND $10 = $10);
If CTS_RTS_On AND Carrier Then SendReady := THR AND Cts Else SendReady :=
THR; End;
{$ELSE}
SendReady := False;
{$ENDIF}
End;
Procedure SendByte (Ch : Char);
Begin
{$IFNDEF TEST}
Repeat Until SendReady;
If UseFossil then
Begin
Regs.AH := 1;
Regs.AL := Ord (Ch);
Regs.DX := UsedPort;
intr($14,regs);
End Else Port [IBM_UART_THR + Base] := Ord (Ch);
{$ENDIF}
End;
Procedure AsyncFlushOutput;
Begin
{$IFNDEF TEST}
If Usefossil Then
Begin
Regs.AH := 8;
Regs.DX := UsedPort;
Intr ($14, Regs);
End;
{$ENDIF}
End;
Procedure AsyncPurgeOutput;
Begin
{$IFNDEF TEST}
If UseFossil Then
Begin
Regs.AH := 9;
Regs.DX := UsedPort;
Intr ($14, Regs);
End;
{$ENDIF}
End;
Procedure AsyncPurgeInput;
Begin
{$IFNDEF TEST}
If UseFossil then
Begin
Regs.AH := $0A;
Regs.DX := UsedPort;
Intr ($14, Regs);
End Else
Begin
BufferHead := 0;
BufferTail := 0;
OverFlow := False;
End;
{$ENDIF}
End;
Procedure SendBreak;
Var I, J : Byte;
Begin
{$IFNDEF TEST}
If UseFossil then
Begin
Regs.AX := $1A01;
Regs.DX := UsedPort;
Intr ($14, Regs);
Delay (100);
Regs.AX := $1A00;
Regs.DX := UsedPort;
Intr ($14, Regs);
End Else
Begin
I := Port [IBM_UART_LCR + Base];
J := I;
I := I AND $7F;
I := I OR $40;
Port [IBM_UART_LCR + Base] := I;
delay (100);
Port [IBM_UART_LCR + Base] := J;
End;
{$ENDIF}
End;
Procedure SetDTR (OnOff : Boolean);
Var I : Byte;
Begin
{$IFNDEF TEST}
If UseFossil then
Begin
Regs.AH := $06;
If OnOff Then Regs.AL := 1 Else Regs.AL := 0;
Regs.DX := UsedPort;
Intr ($14, Regs);
End Else
Begin
If OnOff Then Port [IBM_UART_MCR + Base] := $0B Else Port [IBM_Uart_MCR +
Base] := $0A; End;
{$ENDIF}
End;
Procedure CTS_RTS (OnOff : Boolean);
Begin
{$IFNDEF TEST}
If UseFossil Then
Begin
Regs.DX := UsedPort;
If OnOff Then Regs.AL := 2 Else Regs.AL := 0;
Regs.AH := $0F;
Intr ($14, Regs);
End Else CTS_RTS_On := OnOff;
{$ENDIF}
End;
Procedure AWrite (S : String);
Var I : Integer;
Begin
{$IFNDEF TEST}
For I := 1 To Length (S) Do SendByte ((S[I]));
{$ENDIF}
End;
procedure aModemWrite(s : string;display : boolean);
begin
Awrite(s);
end;
Procedure AWriteLn (S : String);
Begin
{$IFNDEF TEST}
AWrite (S + #10#13);
{$ENDIF}
End;
Function Ringing : Boolean;
Begin
{$IFNDEF TEST}
Case UsedPort of
1 : Ringing := Boolean (Port[$3FE] And 64);
2 : Ringing := Boolean (Port[$2FE] And 64);
3 : Ringing := Boolean (Port[$3EE] And 64);
4 : Ringing := Boolean (Port[$2EE] And 64);
Else Ringing := False;
End;
{$ELSE}
Ringing := False;
{$ENDIF}
End;
Procedure Hangup;
Begin
{$IFNDEF TEST}
SetDTR (False);
Delay (250);
SetDTR (True);
{$ENDIF}
End;
Begin
{$IFNDEF TEST}
ExitSave := ExitProc;
ExitProc := @TerminateUnit;
IsOpen := FALSE;
Overflow := FALSE;
CanUseFossil := False;
CTS_RTS_On := True;
Bios_Ports := 4;
{$ENDIF}
End.