{
 ***************************************************************************
 *                                                                         *
 *                              SAMPLE 1                                   *
 *                       LOOP BACK TEST PROGRAM                            *
 *                                                                         *
 * This program uses the loop back feature of the 16450 chip to transmit   *
 * a sequence of characters and in turn receive them.  No external jumpers *
 * are required to run this program.                                       *
 *                                                                         *
 *                                                                         *
 ***************************************************************************
}
USES
  Crt;

CONST
  Base : Word = $2A8;    { Base Address }

  RECEIVE    =  0;      { Receiver buffer register              }
  TRANSMIT   =  0;      { Transmitter holding register          }
  L_DIVISOR  =  0;      { Divisor latch, least significant byte }
  U_DIVISOR  =  1;      { Divisor latch, most significant byte  }
  INT_ENB    =  1;      { Interrupt enable register             }
  INT_ID     =  2;      { Interupt identification register      }
  LINE_CTRL  =  3;      { Line control register                 }
  MODEM_CTRL =  4;      { Modem control register                }
  LINE_STAT  =  5;      { Line status register                  }
  MODEM_STAT =  6;      { Modem status register                 }

{
 **************************************************************************
 * PROCEDURE initialize - Performs the setup and initialization of the    *
 *                        16450 chip.                                     *
 **************************************************************************
}

PROCEDURE initialize;
VAR
  Ch : INTEGER;
BEGIN
   { First, set up the divisor latches for 9600 baud.  A divisor of 12 is
      required since the 1.8432 clock is used.  The upper divisor is set to
      0 and the lower to 12. }
   port[Base + LINE_CTRL] := $80;   { Set DLAB high for Divisor latch enable }
   port[Base + L_DIVISOR] := 12;    { Load lower latch with 12 }
   port[Base + U_DIVISOR] := 0;     { Load upper latch with 0  }

   { Now set the line control register for the following communications
      protocol
		   bit0, bit1 = 1 -- character is eight bits
		         bit2 = 0 -- one stop bit
		         bit3 = 0 -- no parity is enabled
		         bit4 = 0 -- doesn't matter with parity disabled
		         bit5 = 0 -- doesn't matter with parity disabled
		         bit6 = 0 -- disable break control
		         bit7 = 0 -- DLAB bit, 0 disables divisor latches    }
   port[Base + LINE_CTRL] := $03;

   { Enable the loop back feature of the chip with bit 4 of modem control
      register, now all transmitted characters will be looped back to the
      receiver, without external connections. }
   port[Base + MODEM_CTRL] := $10;

   { these inputs are to just insure that both the receiver buffer register
      and receiver shift register are clear. }

   delay(50);
   Ch := port[Base + RECEIVE];   { clear rx registers }
   delay(50);
   Ch := port[Base + RECEIVE];
END;

function AskForBaseAddress(OldOne : String) : Word;
const
   Msg : string[4] = '0';
var
   NewOne, Success, Dummy, Error : Word;
   AddrInputPosX, AddrInputPosY : Word;
begin
   if (OldOne = 'OLD') then OldOne := Msg;
   WriteLn('Please enter the Base Address (0000-FFFF) for your card (in hex)');
   WriteLn('or press ENTER for ', OldOne, '.  ');
   Write('>');
   AddrInputPosX := WhereX; AddrInputPosY := WhereY;
   repeat
      GotoXY(AddrInputPosX, AddrInputPosY);
      ClrEol;
      Readln(Msg);
      Val('$' + Msg, NewOne, Error);
      if (error=0) then begin
         Success := 1;
         Dummy := NewOne;
      end else if (Msg = '') then begin
         GotoXY(AddrInputPosX, AddrInputPosY);
         WriteLn(OldOne);
         Msg := OldOne;
         Success := 1;
         Val('$' + Msg, Dummy, Error);
      end;
   until (Success = 1);
   AskForBaseAddress := Dummy;
end;  { end of AskForBaseAddress }


{
 ***********************************************************
 *                                                         *
 *     Transmit the letters 'A' through 'Z', and in turn,  *
 *  receive the characters, and check if the correct char  *
 *  is received.  The program will print an error message  *
 *  for each bad character received. If no errors occur,   *
 *  the program will indicate so at the end of program     *
 *  execution.                                             *
 *                                                         *
 ***********************************************************
}
VAR
  Ch : CHAR;
  ch1, flag, c : INTEGER;
  Home : WORD;

BEGIN

ClrScr;
WriteLn('              SAMPLE 1.PAS  :  Internal Loopback test.');
WriteLn;
WriteLn('This program uses the loop back feature of the 16450 chip to transmit a');
WriteLn('sequence of characters and in turn receive them.  No other jumpers are');
WriteLn('required to run this program.  All other settings are irrelevant.');
GotoXY(1, 7);
WriteLn('COM ADDRESS');
Base := AskForBaseAddress('2A8');

ClrScr;
GotoXY(1,4);
WriteLn('Board Configuration:');
WriteLn;
WriteLn(' -- All remaining jumper settings are irrelevant.');
WriteLn;
WriteLn;
WriteLn('Press a key to continue');
Ch := readkey;
ClrScr;
initialize;                 { setup the 16450 chip }

flag := 0;
FOR Ch := 'A' TO 'Z' DO
  BEGIN
    port[Base + TRANSMIT] := ord(Ch);
    REPEAT
      ch1 := port[Base + LINE_STAT]; { send the char }
    UNTIL ((ch1 AND 1) <> 0);  { check if bit 1 is a 1, if so, data is ready }
    ch1 := port[Base + RECEIVE];     { read the input char }

    { check if char received is the one we sent }
    IF (ch1 <> ord(Ch)) THEN
    BEGIN
      Writeln('error with character',Ch,', received char ',chr(ch1),'.');
      flag := 1;
    END;
  END;
  IF (flag = 0) THEN { then no errors occured }
  BEGIN
    Writeln('All characters were transmitted without error. ');
  END
END.