home
***
CD-ROM
|
disk
|
FTP
|
other
***
search
/
HAM Radio 3
/
hamradioversion3.0examsandprograms1992.iso
/
mods
/
pk232src
/
sss_asyn.pas
< prev
next >
Wrap
Pascal/Delphi Source File
|
1986-09-09
|
36KB
|
791 lines
{----------------------------------------------------------------------}
{ Asynchronous I/O routines of the Split-Screen Server (SSS) }
{----------------------------------------------------------------------}
{ }
{ Author: Philip R. Burns ("PIBASYNC.PAS", from SIG disk) }
{ Date: January, 1985 }
{ Version: 1.0 }
{ Systems: For MS-DOS on IBM PCs and close compatibles only. }
{ }
{ Modified (adapted) by HB9CVV }
{ }
{----------------------------------------------------------------------}
{ }
{ Routines: }
{ }
{ Async_Init --- Performs initialization. }
{ Async_Open --- Sets up COM port }
{ Async_Close --- Closes down COM port }
{ Async_Buffer_Check --- Checks if character in COM buffer }
{ Async_Receive --- Reads character from COM buffer }
{ Async_Send --- Transmits char over COM port }
{----------------------------------------------------------------------}
{----------------------------------------------------------------------}
{ }
{ COMMUNICATIONS HARDWARE ADDRESSES }
{ }
{ These are specific to IBM PCs and close compatibles. }
{ }
{----------------------------------------------------------------------}
TYPE RegPack =
RECORD AX, BX, CX, DX, BP, SI, DI, DS, ES, FLAGS : Integer
END;
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;
UART_DLL = $00;
UART_DLM = $01;
I8088_IMR = $21; { port address of the Interrupt Mask Register }
COM_Base : ARRAY[1..6] OF Integer =
($03F8, { COM1 } { Address of the UART }
$02F8, { COM2 }
$03E8, { COM3 }
$03E0, { COM4 }
$02F0, { COM5 }
$02E8); { COM6 }
COM_Irq : ARRAY[1..6] OF Integer =
(4, { COM1 } { Interrupt Line for the UART }
3, { COM2 }
4, { COM3 }
3, { COM4 }
4, { COM5 }
3); { COM6 }
CONST
Async_DSeg_Save : Integer = 0; { Save DS reg in Code Segment for }
{ interrupt routine }
{----------------------------------------------------------------------}
{ }
{ COMMUNICATIONS BUFFER VARIABLES }
{ }
{ The Communications Buffer is implemented as a circular (ring) }
{ buffer, or double-ended queue. The asynchronous I/O routines }
{ enter characters in the buffer as they are received. Higher- }
{ level routines may extract characters from the buffer. }
{ }
{ Note that this buffer is used for input only; output is done }
{ on a character-by-character basis. }
{ }
{----------------------------------------------------------------------}
CONST
Async_Buffer_Max = 8191; { Size of Communications Buffer }
Async_Loops_Per_Sec = 6500; { Loops per second -- 4.77 clock }
TimeOut = 256; { TimeOut value }
VAR
{ Communications Buffer Itself }
Async_Buffer : ARRAY[0..Async_Buffer_Max] OF Char;
Async_Open_Flag : Boolean; { true if Open but no Close }
Async_Port : Integer; { current Open port number (1 or 2) }
Async_Base : Integer; { base for current open port }
Async_Irq : Integer; { irq for current open port }
Async_Buffer_Overflow : Boolean; { True if buffer overflow has happened }
Async_Buffer_Used : Integer;
Async_MaxBufferUsed : Integer;
{ Async_Buffer empty if Head = Tail }
Async_Buffer_Head : Integer; { Loc in Async_Buffer to put next char }
Async_Buffer_Tail : Integer; { Loc in Async_Buffer to get next char }
Async_Buffer_NewTail : Integer;
Async_SaveVector_CS : Integer; { Saved segment of Interrupt routine }
Async_SaveVector_IP : Integer; { Saved offset of Interrupt routine }
Async_Blocked : Boolean; { TRUE if ^S received, reset by ^Q }
{----------------------------------------------------------------------}
{ DOS_Set_Intrpt --- Call DOS to set interrupt vector }
{----------------------------------------------------------------------}
PROCEDURE DOS_Set_Intrpt(v, s, o : Integer);
{ }
{ Procedure: DOS_Set_Intrpt }
{ }
{ Purpose: Calls DOS to set interrupt vector }
{ }
{ Calling Sequence: }
{ }
{ DOS_Set_Intrpt( v, s, o : Integer ); }
{ }
{ v --- interrupt vector number to set }
{ s --- segment address of interrupt routine }
{ o --- offset address of interrupt routine }
{ }
{ Calls: MSDOS (to set interrupt) }
{ }
VAR
Regs : Regpack;
BEGIN { DOS_Set_Intrpt }
INLINE($FA); { cli disable interrupts }
WITH Regs DO
BEGIN
Ax := $3500+(v AND $00FF);
MsDos(Regs); { DOS function 35 - get vector }
Ds := s;
Dx := o;
Async_SaveVector_CS := Es;
Async_SaveVector_IP := Bx;
Ax := $2500+(v AND $00FF);
MsDos(Regs);
END;
INLINE($FB); { sti re-enable ints }
END { DOS_Set_Intrpt } ;
{----------------------------------------------------------------------}
{ Async_Isr --- Interrupt Service Routine }
{----------------------------------------------------------------------}
PROCEDURE Async_Isr;
{ }
{ Procedure: Async_Isr }
{ }
{ Purpose: Invoked when UART has received character from }
{ communications line (asynchronous) }
{ }
{ Calling Sequence: }
{ }
{ Async_Isr; }
{ }
{ --- Called asyncronously only!!!!!! }
{ }
{ Remarks: }
{ }
{ This is Michael Quinlan's version of the interrupt handler. }
{ }
BEGIN { Async_Isr }
{ NOTE: on entry, Turbo Pascal has already PUSHed BP and SP }
INLINE(
{ save all registers used }
$50/ { PUSH AX }
$53/ { PUSH BX }
$52/ { PUSH DX }
$1E/ { PUSH DS }
$FB/ { STI }
{ set up the DS register to point to Turbo Pascal's data segment }
$2E/$FF/$36/Async_Dseg_Save/ { PUSH CS:Async_Dseg_Save }
$1F/ { POP DS }
{ get the incomming character }
{ Async_Buffer[Async_Buffer_Head] := Chr(Port[UART_RBR + Async_Base]); }
$8B/$16/Async_Base/ { MOV DX,Async_Base }
$EC/ { IN AL,DX }
$8B/$1E/Async_Buffer_Head/ { MOV BX,Async_Buffer_Head }
$88/$87/Async_Buffer/ { MOV Async_Buffer[BX],AL }
{ if chr=^S THEN Async_Blocked := TRUE
if chr=^Q THEN Async_Blocked := FALSE }
$3C/$13/ { CMP AL,013H }
$75/$07/ { JNE Z001 }
$C6/$06/Async_Blocked/$01/ { MOV Async_Blocked,1 }
$EB/$09/ { JMP Z002 }
{Z001:}
$3C/$11/ { CMP AL,011H }
$75/$05/ { JNE Z002 }
$C6/$06/Async_Blocked/$00/ { MOV Async_Blocked,0 }
{Z002:}
{ Async_Buffer_NewHead := Async_Buffer_Head + 1; }
$43/ { INC BX }
{ if Async_Buffer_NewHead > Async_Buffer_Max then
Async_Buffer_NewHead := 0; }
$81/$FB/Async_Buffer_Max/ { CMP BX,Async_Buffer_Max }
$7E/$02/ { JLE L001 }
$33/$DB/ { XOR BX,BX }
{ if Async_Buffer_NewHead = Async_Buffer_Tail then
Async_Buffer_Overflow := TRUE
else }
{L001:}
$3B/$1E/Async_Buffer_Tail/ { CMP BX,Async_Buffer_Tail }
$75/$08/ { JNE L002 }
$C6/$06/Async_Buffer_Overflow/$01/ { MOV Async_Buffer_Overflow,1 }
$90/ { NOP generated by assembler for some reason }
$EB/$16/ { JMP SHORT L003 }
{ begin
Async_Buffer_Head := Async_Buffer_NewHead;
Async_Buffer_Used := Async_Buffer_Used + 1;
if Async_Buffer_Used > Async_MaxBufferUsed then
Async_MaxBufferUsed := Async_Buffer_Used
end; }
{L002:}
$89/$1E/Async_Buffer_Head/ { MOV Async_Buffer_Head,BX }
$FF/$06/Async_Buffer_Used/ { INC Async_Buffer_Used }
$8B/$1E/Async_Buffer_Used/ { MOV BX,Async_Buffer_Used }
$3B/$1E/Async_MaxBufferUsed/ { CMP BX,Async_MaxBufferUsed }
$7E/$04/ { JLE L003 }
$89/$1E/Async_MaxBufferUsed/ { MOV Async_MaxBufferUsed,BX }
{L003:}
{ disable interrupts }
$FA/ { CLI }
{ Port[$20] := $20; } { use non-specific EOI }
$B0/$20/ { MOV AL,20h }
$E6/$20/ { OUT 20h,AL }
{ restore the registers then use IRET to return }
{ the last two POPs are required because Turbo Pascal PUSHes these regs
before we get control. The manual doesn't say so, but that is what
really happens }
$1F/ { POP DS }
$5A/ { POP DX }
$5B/ { POP BX }
$58/ { POP AX }
$5C/ { POP SP }
$5D/ { POP BP }
$CF) { IRET }
END { Async_Isr } ;
{----------------------------------------------------------------------}
{ Async_Init --- Initialize Asynchronous Variables }
{----------------------------------------------------------------------}
PROCEDURE Async_Init;
{ }
{ Procedure: Async_Init }
{ }
{ Purpose: Initializes variables }
{ }
{ Calling Sequence: }
{ }
{ Async_Init; }
{ }
{ Calls: None }
{ }
BEGIN { Async_Init }
Async_DSeg_Save := DSeg;
Async_Open_Flag := False;
Async_Buffer_Overflow := False;
Async_Buffer_Used := 0;
Async_MaxBufferUsed := 0;
Async_Blocked := False;
END { Async_Init } ;
{----------------------------------------------------------------------}
{ Async_Close --- Close down communications interrupts }
{----------------------------------------------------------------------}
PROCEDURE Async_Close;
{ }
{ Procedure: Async_Close }
{ }
{ Purpose: Resets interrupt system when UART interrupts }
{ are no longer needed. }
{ }
{ Calling Sequence: }
{ }
{ Async_Close; }
{ }
{ Calls: None }
{ }
VAR
i : Integer;
m : Integer;
BEGIN { Async_Close }
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;
DOS_Set_Intrpt(Async_Irq+8, Async_SaveVector_CS, Async_SaveVector_IP);
INLINE($FB); { enable interrupts }
{ re-initialize our data areas so we know }
{ the port is closed }
Async_Open_Flag := False;
END;
END { Async_Close } ;
{----------------------------------------------------------------------}
{ Async_Open --- Open communications port }
{----------------------------------------------------------------------}
FUNCTION Async_Open(ComPort : Integer;
BaudRate : Integer;
Parity : Char;
WordSize : Integer;
StopBits : Integer) : Boolean;
{ }
{ Function: Async_Open }
{ }
{ Purpose: Opens communications port }
{ }
{ Calling Sequence: }
{ }
{ Flag := Async_Open( ComPort : Integer; }
{ BaudRate : Integer; }
{ Parity : Char; }
{ WordSize : Integer; }
{ StopBits : Integer) : Boolean; }
{ }
{ ComPort --- which port (1 or 2) }
{ BaudRate --- Baud rate (110 to 9600) }
{ Parity --- "E" for even, "O" for odd, "N" for none }
{ WordSize --- Bits per character (5 through 8) }
{ StopBits --- How many stop bits (1 or 2) }
{ }
{ Flag returned TRUE if port initialized successfully; }
{ Flag returned FALSE if any errors. }
{ }
{ Calls: }
{ }
{ DOS_Set_Intrpt --- set address of RS232 interrupt routine }
{ }
CONST { Baud Rate Constants }
Async_Num_Bauds = 8;
Async_Baud_Table : ARRAY[1..Async_Num_Bauds] OF RECORD
Baud, Bits : Integer;
END
= ((Baud : 110; Bits : $417),
(Baud : 150; Bits : $300),
(Baud : 300; Bits : $180),
(Baud : 600; Bits : $0C0),
(Baud : 1200; Bits : $060),
(Baud : 2400; Bits : $030),
(Baud : 4800; Bits : $018),
(Baud : 9600; Bits : $00C));
VAR
ComBaud, ComParm : Integer;
i : Integer;
m : Integer;
BEGIN { Async_Open }
{ If port open, close it down first. }
IF Async_Open_Flag THEN Async_Close;
{ Choose communications port }
Async_Port := ComPort;
Async_Base := COM_Base[ComPort];
Async_Irq := COM_Irq[ComPort];
IF (Port[UART_IIR+Async_Base] AND $00F8) <> 0 THEN
Async_Open := False { Serial port not installed }
ELSE
BEGIN { Open the port }
{ Set buffer pointers }
Async_Buffer_Head := 0;
Async_Buffer_Tail := 0;
Async_Buffer_Overflow := False;
{---------------------------------------------------}
{ Build the ComParams to init the UART }
{---------------------------------------------------}
{ Set up the bits for the baud rate }
IF BaudRate > 9600 THEN
BaudRate := 9600
ELSE IF BaudRate <= 0 THEN
BaudRate := 300;
i := 0;
REPEAT
i := i+1
UNTIL ((i >= Async_Num_Bauds) OR
(BaudRate = Async_Baud_Table[i].Baud));
ComBaud := Async_Baud_Table[i].Bits;
{ Choose Parity }
ComParm := $00; { Assume no parity }
IF Parity IN ['E', 'e'] THEN
ComParm := $0018
ELSE IF Parity IN ['O', 'o'] THEN
ComParm := $0008;
{ Choose number of data bits }
WordSize := WordSize-5;
IF (WordSize < 0) OR (WordSize > 3) THEN
WordSize := 3;
ComParm := ComParm OR WordSize;
{ Choose stop bits }
IF StopBits = 2 THEN
ComParm := ComParm OR $0004; { default is 1 stop bit }
DOS_Set_Intrpt(Async_Irq+8, CSeg, Ofs(Async_Isr));
INLINE($FA); { disable interrupts }
{ Set the parity, datalength, stopbits and baudrate }
{ Turn on Divisor Access Latch Bit first }
ComParm := ComParm OR $80;
Port[UART_LCR+Async_Base] := ComParm;
Port[UART_DLM+Async_Base] := Hi(ComBaud);
Port[UART_DLL+Async_Base] := Lo(ComBaud);
{ Read the RBR and reset any pending error conditions. }
{ First turn off the Divisor Access Latch Bit to allow }
{ access to RBR, etc. }
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 OUT2 on 8250 }
i := Port[UART_MCR+Async_Base];
Port[UART_MCR+Async_Base] := i OR $08;
INLINE($FB); { enable interrupts }
Async_Open := True;
Async_Open_Flag := True;
END;
END { Async_Open } ;
{----------------------------------------------------------------------}
{ Async_Buffer_Check --- Check if character in buffer }
{----------------------------------------------------------------------}
FUNCTION Async_Buffer_Check : Boolean;
{ }
{ Function: Async_Buffer_Check }
{ }
{ Purpose: Check if character in buffer }
{ }
{ Calling Sequence: }
{ }
{ Flag := Async_Buffer_Check : Boolean; }
{ }
{ Flag returned TRUE if character received in buffer, }
{ Flag returned FALSE if no character received. }
{ }
{ Calls: None }
{ }
{ Remarks: }
{ }
{ This routine only checks if a character has been received }
{ and thus can be read; it does NOT return the character. }
{ Use Async_Receive to read the character. }
{ }
BEGIN { Async_Buffer_Check }
Async_Buffer_Check := (Async_Buffer_Head <> Async_Buffer_Tail);
END { Async_Buffer_Check } ;
{----------------------------------------------------------------------}
{ Async_Receive --- Return character from buffer }
{----------------------------------------------------------------------}
FUNCTION Async_Receive(VAR C : Char) : Boolean;
{ }
{ Function: Async_Receive }
{ }
{ Purpose: Retrieve character (if any) from buffer }
{ }
{ Calling Sequence: }
{ }
{ Flag := Async_Receive( Var C: Char ) : Boolean; }
{ }
{ C --- character (if any) retrieved from buffer; }
{ set to CHR(0) if no character available. }
{ }
{ Flag returned TRUE if character retrieved from buffer, }
{ Flag returned FALSE if no character retrieved. }
{ }
{ Calls: None }
{ }
BEGIN { Async_Receive }
IF Async_Buffer_Head = Async_Buffer_Tail THEN
BEGIN { No character to retrieve }
Async_Receive := False;
C := Chr(0);
END { No character available }
ELSE
BEGIN { Character available }
{ Turn off interrupts }
INLINE($FA); { CLI --- Turn off interrupts }
{ Get character from buffer }
C := Async_Buffer[Async_Buffer_Tail];
{ Increment buffer pointer. If past }
{ end of buffer, reset to beginning. }
Async_Buffer_Tail := Async_Buffer_Tail+1;
IF Async_Buffer_Tail > Async_Buffer_Max THEN
Async_Buffer_Tail := 0;
{ Decrement buffer use count }
Async_Buffer_Used := Async_Buffer_Used-1;
{ Turn on interrupts }
INLINE($FB); { STI --- Turn on interrupts }
{ Indicate character successfully retrieved }
Async_Receive := True;
END { Character available } ;
C := Chr(Ord(C) AND $7F);
END { Async_Receive } ;
{----------------------------------------------------------------------}
{ Async_Send --- Send character over communications port }
{----------------------------------------------------------------------}
PROCEDURE Async_Send(C : Char);
{ }
{ Procedure: Async_Send }
{ }
{ Purpose: Sends character out over communications port }
{ }
{ Calling Sequence: }
{ }
{ Async_Send( C : Char ); }
{ }
{ C --- Character to send }
{ }
{ Calls: None }
{ }
VAR
i : Integer;
m : Integer;
Counter : Integer;
BEGIN { Async_Send }
{ Turn on OUT2, DTR, and RTS }
Port[UART_MCR+Async_Base] := $0B;
{ Wait for CTS using Busy Wait }
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;
{ Send the character if port clear }
IF Counter <> 0 THEN
BEGIN { Send the Character }
INLINE($FA); { CLI --- disable interrupts }
Port[UART_THR+Async_Base] := Ord(C);
INLINE($FB); { STI --- enable interrupts }
END { Send the Character }
ELSE { Timed Out }
WriteLn('<<< Com-port character write: TIMEOUT >>>');
END { Async_Send } ;
{----------------------------------------------------------------------}
{ Async_Send_String --- Send string over communications port }
{----------------------------------------------------------------------}
PROCEDURE Async_Send_String(S : MaxString);
{ }
{ Procedure: Async_Send_String }
{ }
{ Purpose: Sends string out over communications port }
{ }
{ Calling Sequence: }
{ }
{ Async_Send_String( S : AnyStr ); }
{ }
{ S --- String to send }
{ }
{ Calls: Async_Send }
{ }
VAR
i : Integer;
BEGIN { Async_Send_String }
FOR i := 1 TO Length(S) DO BEGIN
Async_Send(S[i]);
IF (i MOD 80) = 0 THEN Delay(250);
END;
END { Async_Send_String } ;
{----------------------------------------------------------------------}
{ Async_Purge_Buffer --- Purge communications input buffer }
{----------------------------------------------------------------------}
PROCEDURE Async_Purge_Buffer;
{ }
{ Procedure: Async_Purge_Buffer }
{ }
{ Purpose: Purges communications input buffer }
{ }
{ Calling Sequence: }
{ }
{ Async_Purge_Buffer; }
{ }
{ Calls: Async_Receive }
{ }
VAR
C : Char;
BEGIN { Async_Purge_Buffer }
REPEAT
Delay(1);
UNTIL (NOT Async_Receive(C));
END { Async_Purge_Buffer } ;
{----------------------------------------------------------------------}
{ Async_CTS_On --- Check for CTS on }
{----------------------------------------------------------------------}
FUNCTION Async_CTS_On : Boolean;
{ }
{ Function: Async_CTS_on }
{ }
{ Purpose: Looks for CTS line state }
{ }
{ Calling Sequence: }
{ }
{ Flag := Async_CTS_On : Boolean; }
{ }
{ Flag is set TRUE if CTS is On, else FALSE. }
{ }
{ Calls: None }
{ }
VAR Tmp : Boolean;
BEGIN { Async_CTS_On }
Tmp := Odd(Port[UART_MSR+Async_Base] SHR 4);
Async_CTS_On := Tmp AND (NOT Async_Blocked);
END { Async_CTS_On } ;
