{****************************************************************************}
{*                               RS_232.PAS                                 *}
{*                              version 1.05                                *}
{*                                                                          *}
{*    - This unit performs required duties to manipulate an asynchronous    *}
{*       RS-232 serial port. The unit will transmit and receive ASCII       *}
{*       data using the communications parameters listed in the table       *}
{*       below. Enter the desired parameters into the OpenCom statement     *}
{*       to initialize the asynchronous serial communications port.         *}
{*                                                                          *}
{*    - RS_232.PAS unit provides all necessary programming to transmit and  *}
{*       receive data via serial ports COM1: or COM2:.                      *}
{*                                                                          *}
{*    - RS_232.PAS provides an active Request to Send(RTS) signal on the    *}
{*       selected COM port. This signal can be used to control the data     *}
{*       direction on some internal(Cards) or external RS-232 to RS-485     *}
{*       converters.                                                        *}
{*                                                                          *}
{*    - Additional support is provided for the Metrabyte COM-485 internal   *}
{*       serial port board. If this support is not required all references  *}
{*       to the procedures Com485_Tx_Mode and Com485_Rx_Mode can be removed.*}
{*                                                                          *}
{*    - REVISIONS LIST                                                      *}
{*        1.00   released  11/30/89                                         *}
{*        1.01   revised                                                    *}
{*        1.02   revised   11/7/90 - Changed Intr_Proc; Tx and Rx code.     *}
{*                                   Removed MOD function that incremented  *}
{*                                   buffer pointers. Done to improve       *}
{*                                   speed of interrupt routine.            *}
{*        1.03   revised   3/25/91 - TX_String previously enabled TX        *}
{*                                   interrupt if empty string passed.      *}
{*        1.04   revised   6/01/92 - Modified Intr_Proc to handle echoed    *}
{*                                   characters. Previously, the routine    *}
{*                                   would not receive every echoed         *}
{*                                   character.                             *}
{*                                                                          *}
{*        1.05   revised   6/01/94 - 57.6K and 115.2K baud rates added.     *}
{*                                   Additional math conversion routines.   *}
{*                                                                          *}
{*    - Copyright Dutile, Glines & Higgins Corporation (c) 1989,95          *}
{*                                                                          *}
{*    - The following communications options exist within this unit:        *}
{*                                                                          *}
{*             1    2    3     4     5     6      7      8      9     10    *}
{*             -    -    -     -     -     -      -      -      -     --    *}
{* COM Port :  1    2                                                       *}
{* BAUD Rate: 300  600  1200  2400  4800  9600  19200  38400  57.6K  115.2K *}
{* PARITY   : Odd       Even  None  Mark        Space                       *}
{* DATA Bits:  5    6    7     8                                            *}
{* STOP Bits:  1    2                                                       *}
{*                                                                          *}
{****************************************************************************}
Unit RS_232;

Interface

Uses Crt, Dos;

Const
     { - Define Transmit & Receive maximum data buffer size}
      BufferSize = 512;

     { - Define TIMEOUT string}
      NoComm     = 'TIMEOUT';

     { - Define NULL character}
      Null       = #0;

Var   Com,
      { - Value to control selected COM port}
      Baud,
      { - Value set for desired baudrate}
      Parity,
      { - Value set for desired parity type}
      DtBits,
      { - Value set for desired number of data bits}
      StBits : Integer;
      { - Value set for desired number of stop bits}

Function OpenCom(COMX,BaudRate,ParityType,Dbits,Sbits : Integer) : Boolean;
 { - Open the serial communications port using defined parameters}

Function Rx_Char : Char;
{ - Get a character from the RECEIVE data buffer}

Function LenRxBuf : LongInt;
{ - Return the number of characters in Receive data buffer}

Function LenTxBuf : LongInt;
{ - Return the number of characters in Transmit buffer}

Function Rx_String : String;
{ - Return a response string from receive buffer, '*' and <CR> Stripped}

Procedure Clear_Buffers;
{ - Initialize the transmit and receive buffer pointers}

Procedure Tx_Char(C : Char);
{ - Transmit one character and enable the Transmit Interrupt}

Procedure Tx_String(Command : String);
{ - Transmit a string of characters, <CR> appended to end of string}

Procedure Set_Baud(Rate : Integer);
{ - Set correct baud rate}

Procedure Terminal;
{ - Communicate with remote device via keyboard}

Function Get_Response(Start : Char) : String;
{ - Get response from module, Start = First Char}

Function Numeric : Real;
{ - Get response from first module and convert to REAL number}

Function Hex2Int(Hex : String) : LongInt;
{ - Convert Hexadecimal strings to integer values}

Function Int2Hex(Decimal : LongInt) : String;
{ - Convert integer numbers to hexadecimal}

Function FormatReal(X : Real) : String;
{ - Convert real values into formatted strings, [-99999.99 .. +99999.99]}

Procedure Set_Communications(Baud, Parity_Data_Stop : Integer);
{- Set All communications parameters, Baud rate, Parity, Data and Stop bits}

Procedure CloseCom(ComPort : Integer);
{ - Close communications port and restore old interrupt vector}

IMPLEMENTATION

Const
    Stat_changed : Boolean = False;          {Initialize COM port status}
    Hexs : Array[0..15] of Char = '0123456789ABCDEF';

Type
    HexRec = Record
              LowWord,
              HighWord : Word;
             End;

Var
    RxBuffer : Array[0..BufferSize] of Byte; {Define receive data buffer}
    TxBuffer : Array[0..BufferSize] of Char; {Define transmit data buffer}
    LineStatus,                              {Line status variable}
    ModemStatus,                             {Modem status variable}
    IntEnable    : Byte;
    Intno,                                   {Hardware interrupt number}
    Offset       : Integer;                  {COM port address variable}
    Oldvec       : Pointer;                  {Hold old interrupt vector value}
    Rxchars,                                 {# of received chars in buffer}
    Txchars,                                 {# of chars in buffer to transmit}
    Rfront,                                  {Communications buffer pointers}
    Tfront,                                  {      "          "       "    }
    Rback,                                   {      "          "       "    }
    Tback        : Integer;                  {      "          "       "    }

Procedure Disable_Intrs;
{ - Disable Interrupts}
 Inline($FA);

Procedure Enable_Intrs;
{ - Enable Interrupts}
 Inline($FB);

Procedure Com485_Tx_Mode;
{ - Set COM-485 board in transmit mode}
 Begin
  Port[Offset+7] := $02;
 End;

Procedure Com485_Rx_Mode;
{ - Set COM-485 board in receive mode}
 Begin
  Port[Offset+7] := $01;
 End;

Procedure RTS_Enable;
{ - Turn ON com. port RTS signal}
 Begin
  Com485_Tx_Mode;
  Port[Offset+4] := $0B;
 End;

Procedure RTS_Disable;
{ - Turn OFF com. port RTS signal}
 Begin
  Com485_Rx_Mode;
  Port[Offset+4] := $09;
 End;

Procedure Enable_8259(N : Byte);
{ - Enable communications port hardware interrupt}
 Begin
  Port[$21] := (Port[$21] and Not(1 SHL N));
 End;

Procedure Disable_8259(N : Byte);
{ - Disable communications port hardware interrupt}
 Begin
  Port[$21] := (Port[$21] or (1 SHL N));
 End;

Procedure TxIntr_Enable;
{ - Enable Transmit data interrupt}
 Begin
  RTS_Enable;
  Port[Offset + 1] := Port[Offset+1] or $0F;
 End;

Procedure TxIntr_Disable;
{ - Disable Transmit data interrupt}
 Begin
  Port[Offset + 1] := Port[Offset+1] and $0D;
  RTS_Disable;
 End;

Procedure Set_Baud(Rate : Integer);
{ - Set correct baud rate, allow for quick change without re-opening port}
Var Old : Integer;
 Begin
 { - Compute new baud rate divisor}
  Case Rate of
   09 : { - 57.6K baud}
         Rate := $0002;
   10 : { - 115K baud}
         Rate := $0001;
  Else
   { - All other baud rates}
    Rate := (384 div (1 SHL (Rate - 1)));
  End;

  Old  := Port[Offset + 3];
  Port[Offset+3] := $80;
  Port[Offset]   := Rate and $FF;
  Port[Offset+1] := Rate div 256;
  Port[Offset+3] := Old;
 End;

Procedure Set_Communications(Baud, Parity_Data_Stop : Integer);
{- Set All communications parameters, Baud rate, Parity, Data and Stop bits}
 Begin
  Set_Baud(Baud);
  Port[Offset+3] := Parity_Data_Stop;
 End;

Function LenRxBuf : LongInt;
{ - Return the number of characters in Receive data buffer}
 Begin
  LenRxBuf := RxChars;
 End;

Function LenTxBuf : LongInt;
{ - Return the number of characters in Transmit buffer}
 Begin
  LenTxBuf := TxChars;
 End;

Procedure Clear_Buffers;
{ - Initialize the transmit and receive buffer pointers}
 Begin
  Rfront    := 0;
  Rback     := 0;
  Rxchars   := 0;
  FillChar(RxBuffer, SizeOf(RxBuffer), Chr(0));
  Tfront    := 0;
  Tback     := 0;
  Txchars   := 0;
  FillChar(TxBuffer, SizeOf(TxBuffer), Chr(0));
 End;

Function PortAddress(PortBase : Integer) : Word;
{ - Determine base address of selected communications port, 0 = not installed}
Var Hi, Lo : Word;
 Begin
  Case PortBase of
   1 : Begin
        Hi := MemW[$0040:0001];
        Lo := MemW[$0040:0000];
       End;
   2 : Begin
        Hi := MemW[$0040:0003];
        Lo := MemW[$0040:0002];
       End;
  End;
  PortAddress := (Hi Shl 8) or Lo;
 End;

Function Rx_Char : Char;
{ - Get a character from the RECEIVE data buffer}
 Begin
  If Rxchars < 1 then
    Rx_Char := #0
     Else
      Begin
       Disable_Intrs;
       Rx_Char := Chr(RxBuffer[Rfront] and $7F);
       Inc(Rfront);
       If Rfront > BufferSize Then
         Rfront := 0;
       Dec(Rxchars);
       Enable_Intrs;
      End;
 End;

Function Rx_String : String;
{ - Return a response string from Receive buffer, '*' and <CR> stripped}
Var S  : String[50];
    Ch : Char;
 Begin
  S := '';
  Repeat
   If LenRxBuf > 0 Then
     Begin
      Ch := Rx_Char;
      If Ch > #0 Then
       If (Ch = #13) or (Ch = '*') or (Ch = ' ') Then
         {}
          Else
           S := S + Ch;
     End;
  Until (Ch = #13) or KeyPressed;
  Rx_String := S;
 End;

Procedure Send_Char(C : Char);
{ - Place character in Tx Buffer}
 Begin
  If (Txchars > (BufferSize - 1)) then
    Begin
     Delay(50);
     If (Txchars > (BufferSize - 1)) then
       Exit;
    End;
  Disable_Intrs;
  TxBuffer[Tback] := C;
  Inc(Tback);
  If Tback > BufferSize Then
    Tback := 0;
  Inc(Txchars);
  Enable_Intrs;
 End;

Procedure Set_Stats;
{ - Initialize, Read present serial port status}
 Begin
  LineStatus   := Port[Offset];              {Dummy Read/Clear Input Register}
  LineStatus   := Port[Offset + 5];          {Read Line Status register}
  ModemStatus  := Port[Offset + 6];          {Read Modem Status register}
  IntEnable    := Port[Offset + 1];          {Read Interrupt Enable register}
  Stat_Changed := True;
 End;

Procedure Tx_Char(C : Char);
{ - Transmit one character and enable the Transmit Interrupt}
 Begin
  Send_Char(C);
  TxIntr_Enable;
 End;

Procedure Tx_String(Command : String);
{ - Transmit a string of characters, <CR> appended to end of string}
Var I : Integer;
 Begin
  If Length(Command) > 0 Then
    Begin
     I := 0;
      Repeat
       Inc(I);
       Send_Char(Command[I]);
      Until I = Length(Command);
     Send_Char(#13);
     TxIntr_Enable;
    End;
 End;

Procedure Intr_Proc; Interrupt;
{ - Interrupt procedure which transmits and receives ASCII data}
Label Start;
 Begin
 Start:
  Port[$20] := $20;
  Case Port[Offset + 2] of
   6: Begin
       LineStatus := Port[Offset+5];         {Read Line status register}
       Goto Start;
      End;
   4: Begin                                  {Receive a character}
       RxBuffer[Rback] := Port[Offset];
       Inc(Rback);
       If Rback > BufferSize Then
         Rback := 0;
       Inc(RxChars);
       Goto Start;
      End;
   2: If Txchars > 0  then                   {Transmit a character}
        Begin
         While Port[Offset+5] and $20 = $00 do
          { - Nothing};
         Port[Offset] := Ord(TxBuffer[Tfront]);
         If (TxBuffer[TFront] = Chr(13)) or (TxChars <= 1) Then
           Begin
            While (Port[Offset+5] and $60) <> $60 do {Nothing};
            TxIntr_Disable;
           End;
         Inc(Tfront);
         If Tfront > BufferSize Then
           Tfront := 0;
         Dec(Txchars);
         Goto Start;
        End;
   0: Begin
       ModemStatus := Port[Offset+6];        {Read modem status register}
       Goto Start;
      End;
  End;
 End;

Procedure Init_Port(Intno, ComPort : Integer);
{ - Initialize serial communications port interrupt vector, NO error checks}
 Begin
  Clear_Buffers;                             {Clear Tx,Rx Buffers & Ptrs}
  Getintvec(ComPort,OLDVEC);                 {Save Old Interrupt Vector}
  Setintvec(ComPort,@Intr_Proc);             {Set New Interrupt Vector}
  Port[Offset+4] := $0D;                     {Disable LoopBack, bits 4-7 = 0}
                                             {Enable INTR style Commun.}
  Port[Offset+1] := $0D;                     {Set Receive Interrupt Mask}
  Enable_8259(Intno);                        {Enable Interrupt Number}
  Set_stats;                                 {Initialize Status Regs.}
 End;

Procedure CloseCom(ComPort : Integer);
{ - Close communications port and restore old interrupt vector}
 Begin
  If ComPort = 1 then
    Intno := 4
     Else
      Intno := 3;
  Disable_Intrs;                             {Disable Interrupts}
  Disable_8259(Intno);                       {Turn Comm. interrupt off}
  Setintvec($0D - ComPort, @OLDVEC);         {Restore Old Interrupt Vector}
  Enable_Intrs;                              {Enable Interrupts}
 End;

Procedure Terminal;
{ - Communicate with remote device via keyboard}
Var C : Char;
 Begin
   Repeat
      Repeat                                 {Repeat until Key pressed}
       C := Rx_Char;                         {Check Rec. Buffer while waiting}
       If C > #0  then write(C);             {If NULL Char. then disregard}
       If C = #13 then writeln;              {New line if Ch = <CR>}
      Until keypressed;
     C := Readkey;                           {Get Keyboard Entry}
     If C = #13 then                         {Check for <CR>, advance line ?}
       Writeln
        Else
         Write(C);
     Tx_Char(C);                             {Transmit keyboard entry, RS-232}
   Until C = #27;
 End;

Function OpenCom(COMX, BaudRate, ParityType, DBits, Sbits : Integer) : Boolean;
{ - Open the serial communications port using defined parameters}
 Begin
  If (COMX < 1) or (COMX > 2) Then           {Check for invalid COM port}
    OpenCom := False
     Else
      Begin
       Offset := PortAddress(COMX);          {Get port base address}
       If COMX = 1 Then
         Intno  := 4
          Else
           Intno := 3;
       If Offset = 0 Then                    {If baseaddr=0 then not installed}
         OpenCom := False
          Else
           Begin                             {Initialize Port}
            Set_Communications(Baudrate, (DBits - 1) + (4 * (SBits - 1))
                                 + (ParityType * 8));
            Init_Port(Intno, $0D - COMX);
           End;
      End;
 End;

Function Get_Response(Start : Char) : String; {Start = Trigger on First Char}
Var Ch : Char;
    R  : String[15];
 Begin
  Repeat
   Ch := Rx_Char;
  Until ((Ch = Start) or (Ch = Chr(45)) or KeyPressed);
  R := Ch;
  Repeat
   Ch := Rx_Char;
   If Ch <> #0 Then
     R := R + Ch;
  Until (Ch = #13) or KeyPressed;
  Delete(R,Length(R),1);
  Get_Response := R;
 End;

Function Numeric : Real;
Var Ch     : Char;
    Number : String[10];
    Loop   : Integer;
    R      : Real;
 Begin
  Repeat
   Ch := Rx_Char;
  Until ((Ch = '+') or (Ch = '-') or KeyPressed);
  Number := Ch;
  Repeat
   Ch := Rx_Char;
   If Ch > #0 Then
     Number := Number + Ch;
  Until (Ch = #13) or Keypressed;
  Delete (Number, Length(Number), 1);
  Val(Number, R, Loop);
  If Loop <> 0 Then
    Numeric := 0
     Else
      Numeric := R;
 End;

Function Power2(Factor : Byte) : LongInt;
{ - Power of 2 conversion routine}
Var L : LongInt;
 Begin
  L := 1;
  While Factor >= 1 do
   Begin
    L := L * 2;
    Dec(Factor);
   End;
  Power2 := L;
 End;

Function Hex2Int(Hex : String) : LongInt;
{ - Convert Hexadecimal strings to integer values}
Var Ex, I, Ind : Byte;
    L          : LongInt;
 Begin
  Ex := 0;  L := 0;
  For I := Length(Hex) Downto 1 do
   Begin
    For Ind := 0 to $0F do
      If Hex[I] = Hexs[Ind] Then
        L := L + (Ind * Power2(Ex));
    Inc(Ex, 4);
   End;
  Hex2Int := L;
 End;

Function HexW(Value : Word) : String;
{ - Return hex string value of a word}
 Begin
  HexW[0] := #4;
  HexW[1] := Hexs[Hi(Value) shr 4];
  HexW[2] := Hexs[Hi(Value) and $F];
  HexW[3] := Hexs[Lo(Value) shr 4];
  HexW[4] := Hexs[Lo(Value) and $F];
 End;

Function Int2Hex(Decimal : LongInt) : String;
{ - Convert integer numbers to hexadecimal}
 Begin
  With HexRec(Decimal) do
   Int2Hex := HexW(HighWord) + HexW(LowWord);
 End;

Function FormatReal(X : Real) : String;
{ - Convert real values into formatted strings, [-99999.99 .. +99999.99]}
Var S : String[10];
    Index1, Index2, FirstChar : Byte;
 Begin
   FormatReal := '+00000.00';        {Preload resultant string with zero}
   FirstChar := 2;                   {All negatives and numbers <= +9.99}
   Str(X : 5 : 2, S);                {Convert value to string}

   If (S[1] <> ' ') And (X > 0) Then {Positive numbers >= +10.00}
     FirstChar := 1;

  { - Shift numeric data into resultant string}
   Index1 := 9;
   For Index2 := Length(S) Downto FirstChar do
    Begin
     FormatReal[Index1] := S[Index2];
     Dec(Index1);
    End;

   If X < 0 Then                   {Insert minus sign if negative number}
     FormatReal[1] := '-';
 End;

Begin
 Com    := 1;         {Select COM port 1}
 Baud   := 1;         {Select 300 Baud}
 Parity := 5;         {Force Parity type to MARK condition}
 DtBits := 3;         {Force data bits to 7-Bits}
 StBits := 1;         {Force stop bits to 1 bit}
End.