home
***
CD-ROM
|
disk
|
FTP
|
other
***
search
/
Columbia Kermit
/
kermit.zip
/
archives
/
tpdoskermit.zip
/
async.pas
next >
Wrap
Pascal/Delphi Source File
|
1991-04-18
|
14KB
|
505 lines
$R-,S-,I-,D+,T+,F-,V+,B-,N-,L+
UNIT ASYNC;
INTERFACE
Uses Delays;
(**************************** ASYNC.PAS *********************************)
(* *)
(* Modul for bruk av 1,2,3 el. 4 COM-porter samtidig, med interrupt *)
(* bde ved sending og mottak og uavhengige ring-buffere opptil *)
(* 64k for hver retning og port. *)
(* *)
(* Oslo, November 1987 Terje Mathisen, Norsk Hydro *)
(* *)
(**************************** ASYNC.PRO *********************************)
CONST RX_int = 1;
TX_int = 2;
RLS_int = 4;
MODEM_int = 8;
SumOf_int =15;
TYPE
ComPortType = 1..4;
ParityType = (No_Parity, Even_Parity, Odd_Parity, Zero_Parity, One_Parity);
RS_IntSet = 0..SumOf_int;
RS_BufPtrType = ^RS_BufferType;
RS_BufferType = RECORD
ICadr, IntNr : WORD;
oldModemContrReg : BYTE;
oldLevel : BYTE;
oldVector : Pointer;
xin : Pointer;
xout, SizeX, LimitX : WORD;
Tin : WORD;
Tout : Pointer;
SizeT, SendFirst : WORD;
ShowXoffPtr : Pointer;
Toggle_Xoff, RLS_user, MODEM_user : Pointer;
Ctrl_P : BYTE; {0 - > default, 1..4 -> NOTIS}
UseTint, HostXoff : BOOLEAN;
Bufferfilled : BYTE;
AutoXoff, AltXoff : BOOLEAN;
Xoff1C, Xoff2C, Xon1C, Xon2C : CHAR;
Line_Status, MODEM_status : BYTE;
WaitTX : BOOLEAN;
Int_Mask : BYTE;
oldIntEnableReg : BYTE;
END;
VAR
RS_BufPtr : ARRAY [ComPortType] OF RS_BufPtrType;
RS_TimeOut : WORD;
RS_Buffer : ARRAY [ComPortType] OF RS_BufferType; { Must be in data-seg! }
PROCEDURE RS_MakeBuffer(Rsize,Tsize,IOaddr,SWint:WORD; com : WORD);
PROCEDURE RS_Init (baudRate : LongInt;
NbrOfBits, { 5|6|7|8 }
StopBits: WORD; { 1|2 }
Parity: ParityType;
{ (No_Parity, Even_Parity, Odd_Parity, Zero_Parity, One_Parity) }
VAR result: BOOLEAN;
com: ComPortType); { 1..4 }
PROCEDURE RS_Stop(com: ComPortType);
PROCEDURE RS_Start(rs_int: RS_IntSet; com: ComPortType);
PROCEDURE RS_BusyRead(VAR ch:CHAR;VAR done : BOOLEAN; com : WORD);
PROCEDURE RS_ReadBlock(VAR buf;max:WORD;VAR bytes:WORD;com : WORD);
PROCEDURE RS_Write(ch: CHAR;VAR done : BOOLEAN; com: WORD );
PROCEDURE RS_WriteBlock(VAR buf;len: WORD;VAR bytes:WORD; com: WORD);
FUNCTION RS_GetChar(VAR ch : CHAR; com : WORD): BOOLEAN;
FUNCTION RS_Avail(com : WORD): WORD;
FUNCTION RS_Room(com : WORD): WORD;
PROCEDURE RS_Enable(com : WORD);
PROCEDURE RS_WriteFirst(ch:CHAR;com:WORD);
PROCEDURE RS_ClrBuffer(com: WORD);
PROCEDURE RS_Set_TX_Int(rs_int : RS_IntSet; com : WORD);
FUNCTION RS_Empty(com : WORD) : BOOLEAN;
PROCEDURE RS_Break(ms : WORD;com : WORD);
PROCEDURE RS_StopLink(com : WORD);
PROCEDURE RS_StartLink(com : WORD);
PROCEDURE RS_StopAll;
IMPLEMENTATION
CONST
LineContrReg = 3; { to specify format of transmitted data }
LowBaudRateDiv = 0; { lower byte of divisor to select baud rate }
HighBaudRateDiv = 1; { higher byte of divisor }
LineStatusReg = 5; { holds status info on the data transfer }
ReceiverReg = 0; { received CHAR is in this register }
TransmitReg = 0; { CHAR to send is put in this reg }
IntEnableReg = 1; { to enable the selected interrupt }
IntIdentReg = 2;
ModemContrReg = 4; { controls the interface to a modem }
PROCEDURE GetAlignMem(VAR p : Pointer; size : WORD);
VAR temp : ^BYTE;
BEGIN
REPEAT
GetMem(p,size);
IF Ofs(p^) = 0 THEN Exit;
FreeMem(p,size);
New(temp);
UNTIL FALSE;
END;
PROCEDURE RS_MakeBuffer(Rsize, Tsize, IOaddr, SWint, com: WORD);
CONST PortTab : ARRAY [ComPortType] OF WORD = ($3F8,$2F8,$3E8,$2E8);
IntTab : ARRAY [ComPortType] OF BYTE = (12,11,12,11);
VAR c, c0, c1 : WORD;
BEGIN
IF Rsize + Tsize > MemAvail - $100 THEN BEGIN
Halt(1);
END;
IF com = 0 THEN BEGIN
c0 := 1; c1 := 4;
END
ELSE BEGIN
IF com > 4 THEN Halt(1);
c0 := com; c1 := com;
END;
FOR c := c0 TO c1 DO WITH RS_Buffer[c] DO BEGIN
IF (com = 0) AND (c > 1) THEN
RS_Buffer[c] := RS_Buffer[1]
ELSE BEGIN
IF Rsize > 0 THEN BEGIN
GetAlignMem(xin,Rsize);
SizeX := Rsize;
LimitX := Rsize DIV 8;
END;
IF Tsize > 0 THEN BEGIN
GetAlignMem(Tout,Tsize);
SizeT := Tsize;
END;
END;
IF IOaddr = 0 THEN
ICadr := PortTab[c]
ELSE
ICadr := IOaddr;
IF SWint = 0 THEN
IntNr := IntTab[c]
ELSE
IntNr := SWint;
{ Disse variablene er nullstilt allerede!
xin := 0;
xout := 0;
SendFirst := 0;
tin := 0;
tout := 0;
Ctrl_P := 0;
UseTint := FALSE;
Sending := FALSE;
Receiving := FALSE;
HostXoff := FALSE;
BufferFilled := 0;
AltXoff := FALSE;
ShowXoffPtr := NIL;
Toggle_Xoff := 0;
RLS_user := 0;
MODEM_user := 0;
}
{Default to use XON/XOFF!}
AutoXoff := TRUE;
Xoff1C := ^S;
Xon1C := ^Q;
END;
END;
PROCEDURE RS_Init (baudRate : LongInt;
NbrOfBits, { 5|6|7|8 }
StopBits: WORD; { 1|2 }
Parity: ParityType;
{ (No_Parity, Even_Parity, Odd_Parity, Zero_Parity, One_Parity) }
VAR result: BOOLEAN;
com: ComPortType); { 1..4 }
CONST ParityTab : ARRAY [ParityType] OF BYTE = (0,$18,$08,$38,$28);
VAR divisor : WORD;
parameters: BYTE;
BEGIN (* Init *)
result := FALSE;
WITH RS_Buffer[com] DO BEGIN
IF Xin = NIL THEN BEGIN {No buffer allocated!}
Halt(1);
END;
(* load the divisor of the baud rate generator: *)
IF baudrate < 1 THEN Exit;
divisor := (115200 + (baudrate DIV 2)) DIV baudrate;
Port[ICadr+LineContrReg] := $80;
Port[ICadr+HighBaudRateDiv] := Hi(divisor);
Port[ICadr+LowBaudRateDiv] := Lo(divisor);
(* prepare the parameters: *)
parameters := ParityTab[Parity];
IF stopBits = 2 THEN
parameters := parameters + 4
ELSE IF stopBits <> 1 THEN Exit;
IF (nbrOfBits < 5) OR (nbrOfBits > 8) THEN Exit;
Port[ICadr+LineContrReg] := parameters + (nbrOfBits - 5);
(* Disable Interrupts: *)
Port[ICadr+IntEnableReg] := 0;
result := TRUE;
END;
END { Init };
CONST
I8259ContrWord1 = $21; (* Interrupt controller,
Operation Control Word 1 *)
(************************* ASSEMBLER ROUTINES FOR MAX SPEED ****************)
PROCEDURE RS_Com1Int; EXTERNAL;
PROCEDURE RS_Com2Int; EXTERNAL;
PROCEDURE RS_Com3Int; EXTERNAL;
PROCEDURE RS_Com4Int; EXTERNAL;
PROCEDURE RS_BusyRead(VAR ch:CHAR;VAR done : BOOLEAN;
com : WORD); EXTERNAL;
PROCEDURE RS_ReadBlock(VAR buf;max:WORD;
VAR bytes : WORD;com : WORD);EXTERNAL;
PROCEDURE RS_Write(ch: CHAR;VAR done : BOOLEAN;
com: WORD ); EXTERNAL;
PROCEDURE RS_WriteBlock(VAR buf;len: WORD;
VAR bytes : WORD; com: WORD);EXTERNAL;
FUNCTION RS_GetChar(VAR ch : CHAR;
com : WORD): BOOLEAN; EXTERNAL;
FUNCTION RS_Avail(com : WORD): WORD; EXTERNAL;
FUNCTION RS_Room(com : WORD): WORD; EXTERNAL;
PROCEDURE RS_Enable(com : WORD); EXTERNAL;
PROCEDURE RS_WriteFirst(ch:CHAR;com:WORD);EXTERNAL;
{$L ASYNC.OBJ}
(***************************************************************************)
VAR vect_tab : ARRAY [0..255] OF Pointer ABSOLUTE 0:0;
PROCEDURE Disable; Inline($FA);
PROCEDURE Enable; Inline($FB);
PROCEDURE GetVector(vnr : WORD; VAR vector : Pointer);
BEGIN
vector := vect_tab[vnr];
END; {GetVector}
PROCEDURE SetVector(vnr : WORD; vector : Pointer);
BEGIN
Disable;
vect_tab[vnr] := vector;
Enable;
END; {PutVector}
PROCEDURE RS_Start(rs_int : RS_IntSet; com: ComPortType);
VAR
adr : Pointer;
mask, tempSet : BYTE;
dummy : WORD;
ch : CHAR;
ok : BOOLEAN;
BEGIN
WITH RS_Buffer[com] DO
IF OldVector = NIL THEN BEGIN
(* enable interrupts in the interrupt controller (8259): *)
tempSet := Port[I8259ContrWord1];
(* set the interrupt vector *)
GetVector(IntNr,OldVector);
CASE com OF
1 : adr := @RS_Com1int;
2 : adr := @RS_Com2int;
3 : adr := @RS_Com3int;
4 : adr := @RS_Com4int;
END;
SetVector(IntNr,adr);
mask := 1 Shl (IntNr - 8);
oldLevel := tempSet AND mask;
DISABLE;
Port[I8259ContrWord1] := tempSet AND NOT mask;
dummy := Port[ICadr+IntIdentReg] +
Port[ICadr+LineStatusReg] +
Port[ICadr+ModemContrReg] +
Port[ICadr+ReceiverReg]; (* clear the controller *)
WORD(xin) := 0;
xout := 0;
SendFirst := 0;
tin := 0;
WORD(tout) := 0;
HostXoff := FALSE;
WaitTX := FALSE;
AutoXoff := TRUE;
BufferFilled := 0;
Line_Status := 0;
MODEM_Status := 0;
tempSet := Port[ICadr+ModemContrReg];
oldModemContrReg := tempSet AND 11; { DTR and RTS }
Port[ICadr+ModemContrReg] := tempSet OR 11;
Int_Mask := rs_int;
oldIntEnableReg := Port[ICadr+IntEnableReg];
Port[ICadr+IntEnableReg] := rs_int;
UseTint := (TX_int AND rs_int) <> 0;
ENABLE;
END;
dummy := 50;
REPEAT
RS_BusyRead(ch,ok,com); { Remove pending int's }
Dec(dummy);
UNTIL NOT ok OR (dummy = 0);
END {RS_Start};
PROCEDURE RS_Stop(com: ComPortType);
BEGIN
WITH RS_Buffer[com] DO
IF OldVector <> NIL THEN BEGIN
DISABLE;
(* restore old mask in 8259: *)
Port[I8259ContrWord1] := Port[I8259ContrWord1] OR oldLevel;
(* disable interrupts in 8250: *)
Port[ICadr+IntEnableReg] := oldIntEnableReg;
(* restore modem control register in 8250: *)
Port[ICadr+ModemContrReg] :=
(Port[ICadr+ModemContrReg] AND 244) OR oldModemContrReg;
ENABLE;
(* restore the old interrupt vector *)
SetVector(IntNr,OldVector);
OldVector := NIL;
END;
END {RS_Stop};
(*
PROCEDURE RS_Read(VAR ch: CHAR;com: WORD );
VAR done : BOOLEAN;
BEGIN
REPEAT
RS_BusyRead (ch, done, com);
UNTIL done;
END {RS_Read};
*)
PROCEDURE RS_ClrBuffer(com: WORD);
BEGIN
WITH RS_Buffer[com] DO BEGIN
Disable;
WORD(xin) := 0;
xout := 0;
tin := 0;
WORD(tout) := 0;
SendFirst := 0;
Enable;
END;
END; {ClrBuffer}
PROCEDURE RS_Set_TX_Int(rs_int : RS_IntSet; com : WORD);
BEGIN
WITH RS_Buffer[com] DO BEGIN
Disable;
tin := 0;
WORD(tout) := 0;
SendFirst := 0;
Int_Mask := rs_int;
Port[ICadr+IntEnableReg] := rs_int;
UseTint := (TX_int AND rs_int) <> 0;
Enable;
END;
END; {RS_Set_TX_Int}
FUNCTION RS_Empty(com : WORD) : BOOLEAN;
VAR ch : CHAR;
ok : BOOLEAN;
BEGIN
WITH RS_Buffer[com] DO
RS_Empty := WORD(xin) = xout;
END; {EmptyBuffer}
PROCEDURE RS_Break(ms : WORD;com : WORD);
VAR oldreg : BYTE;
BEGIN
WITH RS_Buffer[com] DO BEGIN
WaitTX := TRUE;
WHILE Port[ICadr+LineStatusReg] AND 32 = 0 DO ; { wait for no traffic }
oldreg := Port[ICadr+LineContrReg];
Port[ICadr+LineContrReg]:= oldreg OR 64;
Delay(ms);
Port[ICadr+LineContrReg] := OldReg;
Delay(250);
WaitTX := FALSE;
IF NOT HostXoff THEN RS_Enable(com);
END;
END; {RS_Break}
PROCEDURE RS_StopLink(com : WORD);
VAR bf : BYTE;
BEGIN
WITH RS_Buffer[com] DO
IF AutoXoff THEN BEGIN
Disable;
bf := BufferFilled;
BufferFilled := BufferFilled OR 2;
Enable;
IF bf = 0 THEN BEGIN
RS_WriteFirst(Xoff1C,com);
Delay(10);
END;
END;
END;
PROCEDURE RS_StartLink(com : WORD);
VAR bf : BYTE;
BEGIN
WITH RS_Buffer[com] DO
IF AutoXoff THEN BEGIN
Disable;
BufferFilled := BufferFilled AND 253;
bf := BufferFilled;
Enable;
IF bf = 0 THEN BEGIN
RS_WriteFirst(Xon1C,com);
END;
END;
END;
VAR SaveExit : Pointer;
PROCEDURE RS_StopAll;
BEGIN
RS_Stop(1);
RS_Stop(2);
RS_Stop(3);
RS_Stop(4);
ExitProc := SaveExit;
END;
BEGIN
FillChar(RS_Buffer,SizeOf(RS_Buffer),#0);
RS_BufPtr[1] := Addr(RS_Buffer[1]);
RS_BufPtr[2] := Addr(RS_Buffer[2]);
RS_BufPtr[3] := Addr(RS_Buffer[3]);
RS_BufPtr[4] := Addr(RS_Buffer[4]);
RS_TimeOut := 0;
SaveExit := ExitProc;
ExitProc := @RS_StopAll;
END.