(*----------------------------------------------------------------------*) (* PIBASYNC.PAS --- Asynchronous I/O for Turbo Pascal *) (*----------------------------------------------------------------------*) (* *) (* Author: Philip R. Burns *) (* *) (* Version: 1.0 (January, 1985) *) (* 2.0 (June, 1985) *) (* 2.1 (July, 1985) *) (* *) (* Systems: For MS-DOS on IBM PCs and close compatibles only. *) (* Note: I have checked these on Zenith 151s under *) (* MSDOS 2.1 and IBM PCs under PCDOS 2.0. *) (* *) (* History: Some of these routines are based upon ones written by: *) (* *) (* Alan Bishop *) (* C. J. Dunford *) (* Michael Quinlan *) (* *) (* I have cleaned up these other authors' code, fixed some *) (* bugs, and added many new features. *) (* *) (* Suggestions for improvements or corrections are welcome. *) (* Please leave messages on Gene Plantz's BBS (312) 882 4145 *) (* or Ron Fox's BBS (312) 940 6496. *) (* *) (* If you use this code in your own programs, please be nice *) (* and give all of us credit. *) (* *) (*----------------------------------------------------------------------*) (* *) (* Routines: *) (* *) (* Async_Init --- Performs initialization. *) (* Async_Clear_Errors --- Clear pending serial port errors *) (* Async_Reset_Port --- Resets UART parameters for port *) (* Async_Open --- Sets up COM port *) (* Async_Close --- Closes down COM port *) (* Async_Carrier_Detect --- Checks for modem carrier detect *) (* Async_Carrier_Drop --- Checks for modem carrier drop *) (* Async_Buffer_Check --- Checks if character in COM buffer *) (* Async_Buffer_Full --- Checks if async buffer nearly full *) (* Async_Term_Ready --- Toggles terminal ready status *) (* Async_Receive --- Reads character from COM buffer *) (* Async_Receive_With_Timeout *) (* --- Receives char. with timeout check *) (* Async_Ring_Detect --- If ringing detected *) (* Async_Send --- Transmits char over COM port *) (* Async_Send_String --- Sends string over COM port *) (* Async_Send_String_With_Delays *) (* --- Sends string with timed delays *) (* Async_Send_Break --- Sends break (attention) signal *) (* Async_Percentage_Used --- Returns percentage com buffer used *) (* Async_Purge_Buffer --- Purges receive buffer *) (* *) (*----------------------------------------------------------------------*) (* *) (*----------------------------------------------------------------------*) (*----------------------------------------------------------------------*) (* *) (* COMMUNICATIONS HARDWARE ADDRESSES *) (* *) (* These are specific to IBM PCs and close compatibles. *) (* *) (*----------------------------------------------------------------------*) 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 *) COM1_Base = $03F8; (* port addresses for the UART *) COM2_Base = $02F8; COM1_Irq = 4; (* Interrupt line for the UART *) COM2_Irq = 3; 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 = 4095; (* Size of Communications Buffer *) 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_XOFF_Sent : BOOLEAN (* If XOFF sent *); Async_Baud_Rate : INTEGER (* Current baud rate *); CONST Async_XON : CHAR = ^Q (* XON character *); Async_XOFF : CHAR = ^S (* XOFF character *); (*----------------------------------------------------------------------*) (* BIOS_RS232_Init --- Initialize UART *) (*----------------------------------------------------------------------*) PROCEDURE BIOS_RS232_Init( ComPort, ComParm : INTEGER ); (*----------------------------------------------------------------------*) (* *) (* Procedure: BIOS_RS232_Init *) (* *) (* Purpose: Issues interrupt $14 to initialize the UART *) (* *) (* Calling Sequence: *) (* *) (* BIOS_RS232_Init( ComPort, ComParm : INTEGER ); *) (* *) (* ComPort --- Communications Port Number (1 or 2) *) (* ComParm --- Communications Parameter Word *) (* *) (* Calls: INTR (to perform BIOS interrupt $14) *) (* *) (*----------------------------------------------------------------------*) VAR Regs: RegPack; BEGIN (* BIOS_RS232_Init *) WITH Regs DO BEGIN Ax := ComParm AND $00FF; (* AH=0; AL=ComParm *) Dx := ComPort; (* Port number to use *) INTR($14, Regs); END; END (* BIOS_RS232_Init *); (*----------------------------------------------------------------------*) (* 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 *) WITH Regs DO BEGIN Ax := $2500 + ( v AND $00FF ); Ds := s; Dx := o; MsDos( Regs ); END; 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/$53/$51/$52/$56/$57/$1E/$06/$FB/ (* 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 incoming 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 *) (* 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 *) $07/$1F/$5F/$5E/$5A/$59/$5B/$58/$8B/$E5/$5D/ $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_XOFF_Sent := FALSE; Async_Buffer_Head := 0; Async_Buffer_Tail := 0; 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; INLINE($FB); (* enable interrupts *) (* re-initialize our data areas so we know *) (* the port is closed *) Async_Open_Flag := FALSE; Async_XOFF_Sent := FALSE; END; END (* Async_Close *); (*----------------------------------------------------------------------*) (* Async_Clear_Errors --- Reset pending errors in async port *) (*----------------------------------------------------------------------*) PROCEDURE Async_Clear_Errors; (*----------------------------------------------------------------------*) (* *) (* Procedure: Async_Clear_Errors *) (* *) (* Purpose: Resets pending errors in async port *) (* *) (* Calling sequence: *) (* *) (* Async_Clear_Errors; *) (* *) (* Calls: None *) (* *) (*----------------------------------------------------------------------*) VAR I: INTEGER; M: INTEGER; BEGIN (* Async_Clear_Errors *) (* Read the RBR and reset any 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 OUT2 on 8250 *) I := Port[UART_MCR + Async_Base]; Port[UART_MCR + Async_Base] := I OR $08; INLINE($FB); (* enable interrupts *) END (* Async_Clear_Errors *); (*----------------------------------------------------------------------*) (* Async_Reset_Port --- Set/reset communications port parameters *) (*----------------------------------------------------------------------*) PROCEDURE Async_Reset_Port( ComPort : INTEGER; BaudRate : INTEGER; Parity : CHAR; WordSize : INTEGER; StopBits : INTEGER ); (*----------------------------------------------------------------------*) (* *) (* Procedure: Async_Reset_Port *) (* *) (* Purpose: Resets communications port *) (* *) (* Calling Sequence: *) (* *) (* Async_Reset_Port( ComPort : INTEGER; *) (* BaudRate : INTEGER; *) (* Parity : CHAR; *) (* WordSize : INTEGER; *) (* StopBits : INTEGER); *) (* *) (* 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) *) (* *) (* Calls: *) (* *) (* Async_Clear_Errors --- Clear async line errors *) (* *) (*----------------------------------------------------------------------*) 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: $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 ) ); VAR I : INTEGER; M : INTEGER; ComParm : INTEGER; BEGIN (* Async_Reset_Port *) (*---------------------------------------------------*) (* Build the ComParm for RS232_Init *) (* See Technical Reference Manual for description *) (*---------------------------------------------------*) (* Set up the bits for the baud rate *) IF BaudRate > 9600 THEN BaudRate := 9600 ELSE IF BaudRate <= 0 THEN BaudRate := 300; (* Remember baud rate for purges *) Async_Baud_Rate := BaudRate; I := 0; REPEAT I := I + 1 UNTIL ( ( I >= Async_Num_Bauds ) OR ( BaudRate = Async_Baud_Table[I].Baud ) ); ComParm := Async_Baud_Table[I].Bits; (* Choose Parity *) IF Parity In ['E', 'e'] THEN ComParm := ComParm or $0018 ELSE IF Parity In ['O', 'o'] THEN ComParm := ComParm or $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 *) (* use the BIOS COM port initialization routine *) BIOS_RS232_Init( ComPort - 1 , ComParm ); (* Clear any pending errors on async line *) Async_Clear_Errors; END (* Async_Reset_Port *); (*----------------------------------------------------------------------*) (* 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: *) (* *) (* Async_Reset_Port --- initialize RS232 port *) (* DOS_Set_Intrpt --- set address of RS232 interrupt routine *) (* *) (*----------------------------------------------------------------------*) BEGIN (* Async_Open *) (* IF port open, close it down first. *) IF Async_Open_Flag THEN Async_Close; (* Choose communications port *) IF ComPort = 2 THEN BEGIN Async_Port := 2; Async_Base := COM2_Base; Async_Irq := COM2_Irq; END ELSE BEGIN Async_Port := 1; (* default to COM1 *) Async_Base := COM1_Base; Async_Irq := COM1_Irq; END; IF (Port[UART_IIR + Async_Base] and $00F8) <> 0 THEN Async_Open := FALSE (* Serial port not installed *) ELSE BEGIN (* Open the port *) (* Set up UART *) Async_Reset_Port( ComPort, BaudRate, Parity, WordSize, StopBits ); (* Set interrupt routine address *) DOS_Set_Intrpt( Async_Irq + 8 , CSeg , Ofs( Async_Isr ) ); (* Clear any pending errors *) Async_Clear_Errors; Async_Open := TRUE; Async_Open_Flag := TRUE; END; END (* Async_Open *); (*----------------------------------------------------------------------*) (* Async_Carrier_Detect --- Check for modem carrier detect *) (*----------------------------------------------------------------------*) FUNCTION Async_Carrier_Detect : BOOLEAN; (*----------------------------------------------------------------------*) (* *) (* Function: Async_Carrier_Detect *) (* *) (* Purpose: Looks for modem carrier detect *) (* *) (* Calling Sequence: *) (* *) (* Flag := Async_Carrier_Detect : BOOLEAN; *) (* *) (* Flag is set TRUE if carrier detected, else FALSE. *) (* *) (* Calls: None *) (* *) (*----------------------------------------------------------------------*) BEGIN (* Async_Carrier_Detect *) Async_Carrier_Detect := ODD( Port[ UART_MSR + Async_Base ] SHR 7 ); END (* Async_Carrier_Detect *); (*----------------------------------------------------------------------*) (* Async_Carrier_Drop --- Check for modem carrier drop/timeout *) (*----------------------------------------------------------------------*) FUNCTION Async_Carrier_Drop : BOOLEAN; (*----------------------------------------------------------------------*) (* *) (* Function: Async_Carrier_Drop *) (* *) (* Purpose: Looks for modem carrier drop/timeout *) (* *) (* Calling Sequence: *) (* *) (* Flag := Async_Carrier_Drop : BOOLEAN; *) (* *) (* Flag is set TRUE if carrier dropped, else FALSE. *) (* *) (* Calls: None *) (* *) (*----------------------------------------------------------------------*) BEGIN (* Async_Carrier_Drop *) Async_Carrier_Drop := NOT ODD( Port[ UART_MSR + Async_Base ] SHR 7 ); END (* Async_Carrier_Drop *); (*----------------------------------------------------------------------*) (* Async_Term_Ready --- Set terminal ready status *) (*----------------------------------------------------------------------*) PROCEDURE Async_Term_Ready( Ready_Status : BOOLEAN ); (*----------------------------------------------------------------------*) (* *) (* Procedure: Async_Term_Ready *) (* *) (* Purpose: Sets terminal ready status *) (* *) (* Calling Sequence: *) (* *) (* Async_Term_Ready( Ready_Status : BOOLEAN ); *) (* *) (* Ready_Status --- Set TRUE to set terminal ready on, *) (* Set FALSE to set terminal ready off. *) (* *) (* Calls: None *) (* *) (*----------------------------------------------------------------------*) VAR Mcr_Value: BYTE; BEGIN (* Async_Term_Ready *) Mcr_Value := Port[ UART_MCR + Async_Base ]; IF ODD( Mcr_Value ) THEN Mcr_Value := Mcr_Value - 1; IF Ready_Status THEN Mcr_Value := Mcr_Value + 1; Port[ UART_MCR + Async_Base ] := Mcr_Value; END (* Async_Term_Ready *); (*----------------------------------------------------------------------*) (* 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 *); END (* Async_Receive *); (*----------------------------------------------------------------------*) (* Async_Receive_With_TimeOut --- Return char. from buffer with delay *) (*----------------------------------------------------------------------*) PROCEDURE Async_Receive_With_Timeout( Secs : INTEGER; VAR C : INTEGER ); (*----------------------------------------------------------------------*) (* *) (* Procedure: Async_Receive_With_Timeout *) (* *) (* Purpose: Retrieve character as integer from buffer, *) (* or return TimeOut if specified delay period *) (* expires. *) (* *) (* Calling Sequence: *) (* *) (* Async_Receive_With_Timeout( Secs: INTEGER; VAR C: INTEGER ); *) (* *) (* Secs --- Timeout period in seconds *) (* C --- ORD(character) (if any) retrieved from buffer; *) (* set to TimeOut if no character found before *) (* delay period expires. *) (* *) (* Calls: Async_Receive *) (* TimeOfDay *) (* *) (* WATCH OUT! THIS ROUTINE RETURNS AN INTEGER, NOT A CHARACTER!!! *) (* *) (*----------------------------------------------------------------------*) VAR Ch : CHAR; Time_Limit : REAL; B : BOOLEAN; BEGIN (* Async_Receive_With_Timeout *) IF Async_Buffer_Head <> Async_Buffer_Tail THEN BEGIN B := Async_Receive( Ch ); C := ORD( Ch ); END ELSE BEGIN (* Convert time to milliseconds *) Time_Limit := Secs * 1000.0; WHILE ( Async_Buffer_Head = Async_Buffer_Tail ) AND ( Time_Limit > 0.0 ) DO BEGIN Delay( 1 ); Time_Limit := Time_Limit - 1.0; END; IF ( Async_Buffer_Head <> Async_Buffer_Tail ) AND ( Time_Limit > 0.0 ) THEN BEGIN B := Async_Receive( Ch ); C := ORD( Ch ); END ELSE C := TimeOut; END; END (* Async_Receive_With_Timeout *); (*----------------------------------------------------------------------*) (* Async_Ring_Detect --- Check for phone ringing *) (*----------------------------------------------------------------------*) FUNCTION Async_Ring_Detect : BOOLEAN; (*----------------------------------------------------------------------*) (* *) (* Function: Async_Ring_Detect *) (* *) (* Purpose: Looks for phone ringing *) (* *) (* Calling Sequence: *) (* *) (* Flag := Async_Ring_Detect : BOOLEAN; *) (* *) (* Flag is set TRUE if ringing detected, else FALSE. *) (* *) (* Calls: None *) (* *) (*----------------------------------------------------------------------*) BEGIN (* Async_Ring_Detect *) Async_Ring_Detect := ODD( Port[ UART_MSR + Async_Base ] SHR 6 ); END (* Async_Ring_Detect *); (*----------------------------------------------------------------------*) (* 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('<<>>'); END (* Async_Send *); (*----------------------------------------------------------------------*) (* Async_Send_Break --- Send break (attention) signal *) (*----------------------------------------------------------------------*) PROCEDURE Async_Send_Break; (*----------------------------------------------------------------------*) (* *) (* Procedure: Async_Send_Break *) (* *) (* Purpose: Sends break signal over communications port *) (* *) (* Calling Sequence: *) (* *) (* Async_Send_Break; *) (* *) (* Calls: None *) (* *) (*----------------------------------------------------------------------*) VAR Old_Lcr : BYTE; Break_Lcr : BYTE; BEGIN (* Async_Send_Break *) Old_Lcr := Port[ UART_LCR + Async_Base ]; Break_Lcr := Old_Lcr; IF Break_Lcr > 127 THEN Break_Lcr := Break_Lcr - 128; IF Break_Lcr <= 63 THEN Break_Lcr := Break_Lcr + 64; Port[ UART_LCR + Async_Base ] := Break_Lcr; Delay( 400 ); Port[ UART_LCR + Async_Base ] := Old_Lcr; END (* Async_Send_Break *); (*----------------------------------------------------------------------*) (* Async_Send_String --- Send string over communications port *) (*----------------------------------------------------------------------*) PROCEDURE Async_Send_String( S : AnyStr ); (*----------------------------------------------------------------------*) (* *) (* 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 Async_Send( S[i] ) END (* Async_Send_String *); (*----------------------------------------------------------------------*) (* Async_Send_String_With_Delays --- Send string with timed delays *) (*----------------------------------------------------------------------*) PROCEDURE Async_Send_String_With_Delays( S : AnyStr; Char_Delay : INTEGER; EOS_Delay : INTEGER ); (*----------------------------------------------------------------------*) (* *) (* Procedure: Async_Send_String_With_Delays *) (* *) (* Purpose: Sends string out over communications port with *) (* specified delays for each character and at the *) (* end of the string. *) (* *) (* Calling Sequence: *) (* *) (* Async_Send_String_With_Delays( S : AnyStr ; *) (* Char_Delay : INTEGER; *) (* EOS_Delay : INTEGER ); *) (* *) (* S --- String to send *) (* Char_Delay --- Number of milliseconds to delay after *) (* sending each character *) (* EOS_Delay --- Number of milleseconds to delay after *) (* sending last character in string *) (* *) (* Calls: Async_Send *) (* Async_Send_String *) (* Length *) (* Delay *) (* *) (* Remarks: *) (* *) (* This routine is useful when writing routines to perform *) (* non-protocol uploads. Many computer systems require delays *) (* between receipt of characters for correct processing. The *) (* delay for end-of-string usually applies when the string *) (* represents an entire line of a file. *) (* *) (* If delays are not required, Async_Send_String is faster. *) (* This routine will call Async_Send_String is no character *) (* delay is to be done. *) (* *) (*----------------------------------------------------------------------*) VAR I : INTEGER; BEGIN (* Async_Send_String_With_Delays *) IF Char_Delay <= 0 THEN Async_Send_String( S ) ELSE FOR I := 1 TO LENGTH( S ) DO BEGIN Async_Send( S[I] ); Delay( Char_Delay ); END; IF EOS_Delay > 0 THEN Delay( EOS_Delay ); END (* Async_Send_String_With_Delays *); (*----------------------------------------------------------------------*) (* Async_Percentage_Used --- Report Percentage Buffer Filled *) (*----------------------------------------------------------------------*) FUNCTION Async_Percentage_Used : REAL; (*----------------------------------------------------------------------*) (* *) (* Function: Async_Percent_Used *) (* *) (* Purpose: Reports percentage of com buffer currently filled *) (* *) (* Calling Sequence: *) (* *) (* Percentage := Async_Percentage_Used : Real; *) (* *) (* Percentage gets how much of buffer is filled; *) (* value goes from 0.0 (empty) to 1.0 (totally full). *) (* *) (* Calls: None *) (* *) (* Remarks: *) (* *) (* This routine is helpful when incorporating handshaking into *) (* a communications program. For example, assume that the host *) (* computer uses the XON/XOFF (DC1/DC3) protocol. Then the *) (* PC program should issue an XOFF to the host when the value *) (* returned by Async_Percentage_Used > .75 or so. When the *) (* utilization percentage drops below .25 or so, the PC program *) (* should transmit an XON. *) (* *) (*----------------------------------------------------------------------*) BEGIN (* Async_Percentage_Used *) Async_Percentage_Used := Async_Buffer_Used / ( Async_Buffer_Max + 1 ); END (* Async_Percentage_Used *); (*----------------------------------------------------------------------*) (* 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; L: INTEGER; BEGIN (* Async_Purge_Buffer *) L := 10000 DIV Async_Baud_Rate; REPEAT Delay( L ); UNTIL ( NOT Async_Receive( C ) ); END (* Async_Purge_Buffer *); (*----------------------------------------------------------------------*) (* Async_Buffer_Full --- Check if com buffer nearly full *) (*----------------------------------------------------------------------*) PROCEDURE Async_Buffer_Full; (*----------------------------------------------------------------------*) (* *) (* Procedure: Async_Buffer_Full *) (* *) (* Purpose: Check if buffer nearly full, issue XOFF if so. *) (* *) (* Calling Sequence: *) (* *) (* Async_Buffer_Full; *) (* *) (* Calls: Async_Send *) (* *) (* Remarks: *) (* *) (* An XOFF if issued if the buffer is nearly full and an XOFF *) (* has not been previously issued. If an XOFF was previously *) (* issued, and the buffer is reasonably empty, then an XON *) (* is issued. *) (* *) (*----------------------------------------------------------------------*) BEGIN (* Async_Buffer_Full *) IF ( Async_Buffer_Used * 4 ) > ( Async_Buffer_Max * 3 ) THEN BEGIN (* Buffer too full -- send XOFF if we already haven't *) IF ( NOT Async_XOFF_Sent ) THEN BEGIN Async_Send( Async_XOFF ); Async_XOFF_Sent := TRUE; END END (* Buffer too full *) ELSE IF ( Async_Buffer_Used * 4 ) < Async_Buffer_Max THEN BEGIN (* Buffer reasonably empty -- send XON if needed *) IF Async_XOFF_Sent THEN BEGIN Async_Send( Async_XON ); Async_XOFF_Sent := FALSE; END; END; END (* Async_Buffer_Full *);