'===========================================================================
' Subject: READ/CHANGE BAUD RATE             Date: Unknown Date           
' Author:  Douglas Lusher                    Code: QB, QBasic, PDS        
' Origin:  FidoNet QUIK_BAS Echo           Packet: MODEM.ABC
'===========================================================================
' >  BTW, what's MCR???

'  Modem Control Register.

' >  'Douglas Lusher posted some code sometime back showing how
' >  'to read and change the baud rate using INP/OUT.


 FUNCTION UARTpresent% (CommPort%)
 'returns True (-1) if a National Semiconductor UART (8250B,
 '  16450, 16550, or 16550A) is present at the comm port
 '  specified. If communications is in progress on the port,
 '  it will be disrupted by running this proceedure.
 'Based on Pascal code by Jeff Duntemann
 '  in Dr. Dobbs Journal, July 1991
 ' assume False, UART not detected
 UARTpresent% = 0
 ' a constant
 LoopBit% = &H10
 ' get the base address for the specified port
 SELECT CASE CommPort%
   CASE 1: PortBase% = &H3F8
   CASE 2: PortBase% = &H2F8
   CASE 3: PortBase% = &H3E8
   CASE 4: PortBase% = &H2E8
   CASE ELSE: ERROR 5
 END SELECT
 RBRPort% = PortBase%
 THRPort% = RBRPort%
 MCRPort% = RBRPort% + 4
 MSRPort% = RBRPort% + 6
 ' put UART into loopback test mode:
 ' first, save the current value of MCR
 HoldMCR% = INP(MCRPort%)
 ' turn on loopback test mode
 OUT MCRPort%, HoldMCR% OR LoopBit%
 HoldMSR% = INP(MSRPort%)
 ' out a specific pattern of bits
 OUT MCRPort%, &HA OR LoopBit%
 ' see if the correct pattern of bits comes back
 Temp% = INP(MSRPort%) AND &HF0
 IF Temp% = &H90 THEN UARTpresent% = -1
 ' restore the value of MSR
 OUT MSRPort%, HoldMSR%
 ' take the UART out of loopback mode and restore
 ' original value of MCR
 OUT MCRPort%, HoldMCR AND NOT LoopBit%
 END FUNCTION

 FUNCTION UARTtype% (CommPort%)
 'returns the type of UART installed at the specified comm port
 ' 0 = error (bad UART or no UART at this comm port)
 ' 1 = 8250, usually (not always) found in PC or XT
 ' 2 = 16450, usually found in AT class machines
 ' 3 = 16550, found in PS/2 mod 50/60/early 80.  FIFOs don't work!
 ' 4 = 16550A, found in later PS/2's. FIFOs fully operative.
 'Based on Pascal code by Jeff Duntemann
 '  in Dr. Dobbs Journal, July 1991

 ' get the base address for the specified port
 SELECT CASE CommPort%
   CASE 1: PortBase% = &H3F8
   CASE 2: PortBase% = &H2F8
   CASE 3: PortBase% = &H3E8
   CASE 4: PortBase% = &H2E8
   CASE ELSE: ERROR 5
 END SELECT

 FCRport% = PortBase% + 2
 IIRport% = FCRport%
 Scratchport% = PortBase% + 7
 ' write a pattern of bits to the scratch register
 OUT Scratchport%, &HAA
 ' attempt to read it back
 IF INP(Scratchport%) <> &HAA THEN
   ' a UART w/o a scratch register is an 8250
   UARTtype% = 1
 ELSE
   ' setting bit zero of the FCR port enables FIFO buffers
   OUT FCRport%, &H1
   ' get the FIFO status bits
   Temp% = INP(IIRport%) AND &HC0
   SELECT CASE Temp%
     ' if bits 6 & 7 are set it is a 16550A
     CASE &HC0: UARTtype% = 4
     ' if bit 7 is set and bit 6 is clear it is a 16550
     CASE &H80: UARTtype% = 3
     ' neither bit 6 or bit 7 set means it is a 16450
     CASE &H0: UARTtype% = 2
     ' error occured
     CASE ELSE: UARTtype% = 0
   END SELECT
   ' disable the FIFO buffers
   OUT FCRport%, &H0
 END IF

 END FUNCTION

 FUNCTION BaudRate& (CommPort%)
 'returns the current baud rate for the specifed port
 BaudRate& = 0
 SELECT CASE CommPort%
   CASE 1: BaseAddr% = &H3F8
   CASE 2: BaseAddr% = &H2F8
   CASE ELSE: EXIT FUNCTION
 END SELECT
 OUT BaseAddr% + 3, INP(BaseAddr% + 3) OR &H80
 LSB% = INP(BaseAddr%)
 MSB% = INP(BaseAddr% + 1)
 OUT BaseAddr% + 3, INP(BaseAddr% + 3) AND &H7F
 Divisor& = (MSB% * &H100) + LSB%
 IF Divisor& THEN BaudRate& = 115200 \ Divisor&
 EXIT FUNCTION

 SUB SetBaudRate (CommPort%, NewBaudRate&)
 ' Dr. Dobbs Journal, May 1991, pg. 127
 SELECT CASE CommPort%
   CASE 1: BaseAddr% = &H3F8
   CASE 2: BaseAddr% = &H2F8
   CASE ELSE: EXIT SUB
 END SELECT
 LCR% = BaseAddr% + 3
 Divisor% = 115200 \ NewBaudRate&
 Temp% = INP(LCR%)
 OUT LCR%, Temp% OR &H80           ' OUT LCR%, INP(LCR%) OR &H80
 OUT BaseAddr% + 1, Divisor% \ &H100
 OUT BaseAddr%, Divisor% AND &HFF
 OUT LCR%, Temp% AND &H7F          ' OUT LCR%, INP(LCR%) AND &H7F
 END SUB