[Back to COMM SWAG index] [Back to Main SWAG index] [Original]

    program TERMINAL;

    { ************************************************************************** }
    { TERMINAL                                                                   }
    { Turbo Pascal 7.0 Demo Programm                                             }
    { Written 1995 by Stephan A. Maciej                                          }
    { Internet: stephan@maciej.muc.de                                            }
    { For any questions, please mail to support@maciej.muc.de !                  }
    { WWW: http://www.muc.de/~stephanm                                           }
    { ************************************************************************** }
    { This program is for demonstration purpose only. Any commercial use with-   }
    { out the written permission of the author is illegal. Please report bugs,   }
    { corrections or any other ideas to stephan@maciej.muc.de. You are allowed   }
    { to distribute this program as often as you want as long as you do not      }
    { change it or edit it anyway. The author is not responsible for any damage  }
    { or destruction caused - directly or indirectly - by this program.          }
    { ************************************************************************** }

    uses Crt;

    const
      TxDataReg = 0;                { transmitter data register            }
      RxDataReg = 0;                { reciever data register               }
      DivLow = 0;                   { divisor latch, low byte              }
      DivHigh = 1;                  { divisor latch, high byte             }
      IntrEnable = 1;               { interrupt enable register            }
      IntrId = 2;                   { interrupt identification register    }
      FifoCtrl = 2;                 { first-in/first-out buffer controller }
      LineCtrl = 3;                 { line controll register               }
      ModemCtrl = 4;                { modem controll register              }
      LineStatus = 5;               { line status register                 }
      ModemStatus = 6;              { modem status register                }
      ScratchReg = 7;               { scratch pad (free useable)           }

    const
      QueueLen = 1024;              { Length of a queue in bytes }

    type
      { The TQueue type }
      TQueue = record
        Content: array[0..QueueLen - 1] of byte;
        Start: word;
        Stop: word;
        end;

    type
      { The TQuadString type }
      TQuadString = string[4];      { For the Hex-function }

    var
      { The two queues, one for incoming characters, the other for }
      { outgoing characters.                                       }
      InQueue: TQueue;              { The two queues: one for input buffering, }
      OutQueue: TQueue;             { the other for output buffering           }

    const
      SpeedCount = 19;              { Number of valid speeds stored below }

    const
      AllowedSpeeds: array[0..SpeedCount] of longint =
        (    50,      75,    110,    150,    300,    600,     900,    1200,
           1800,    2400,   3600,   4800,   7200,   9600,   14400,   19200,
          28800,   38400,  57600, 115200);

        { Just add any other speeds supported by your UART/Modem - don't }
        { forget to increase the SpeedCount                              }

    var
      { Some global variables... }
      PortNr: byte;                 { Number of the used port (1, 2 etc.)       }
      PortBase: word;               { I/O base address of the used port         }
      Speed: longint;               { Speed in baud                             }
      UARTType: byte;               { UART type (one of the UART_xxxx constants }
      UsedIRQ: byte;                { The number of the used IRQ                }

    procedure SendEOI; assembler;
    { Send a EOI to the Interrupt Controller }
    asm
            mov     al, 20h
            out     20h, al
    end;

    function GetPortBase(N: byte): word; assembler;
    { Read the I/O base address of the desired port from the BIOS data segment }
    asm
            { Load the segment address of the BIOS data segment into ES }
            mov     ax, 0040h
            mov     es, ax
            { Calculate the offset of the I/O port base address }
            xor     ax, ax
            mov     al, N
            dec     al
            shl     ax, 1
            mov     si, ax
            { Read the desired value and return }
            mov     ax, es:[si]
    end;

    procedure SetIntVec(N: byte; P: pointer); assembler;
    { Set an interrupt vector to the given address }
    asm
            push    ds
            { Just use the MS-DOS function 25h to set the vector }
            mov     ah, 25h
            mov     al, N
            { ds:dx contains the vector to set }
            lds     dx, P
            int     21h
            pop     ds
    end;

    function GetIntVec(N: byte): pointer; assembler;
    { Get the interrupt vector }
    asm
            push    es
            { Use the MS-DOS function 35h to read the vector }
            mov     ah, 35h
            mov     al, N
            int     21h
            { Move the vector from es:bx to dx:ax }
            mov     ax, bx
            mov     dx, es
            pop     es
    end;

    procedure ResetQueue(var Q: TQueue);
    { Resets a Queue }
    begin
      Q.Start := 0;
      Q.Stop := 0;
    end;

    procedure PutQueueByte(var Q: TQueue; B: byte);
    { Put a byte into the Queue }
    begin
      { Put the byte into the Queue before incrementing the Queue end }
      Q.Content[Q.Stop] := B;

      { Now increment the Queue end position. When Q.Stop reaches QueueLen, }
      { be sure you don't increment Q.Stop but wrap it around to 0 again !  }
      inc(Q.Stop);
      if (Q.Stop = QueueLen) then
        Q.Stop := 0;

    end;

    function GetQueueByte(var Q: TQueue; var B: byte): boolean;
    { Get a byte out of the Queue }
    begin
      if (Q.Stop = Q.Start) then
        { If the Queue is empty, just return false. Don't set B anyway. }
        GetQueueByte := false
      else
        begin
          { Queue is not empty: return true. }
          GetQueueByte := true;

          { Get the first byte out of the Queue and return it in B. }
          B := Q.Content[Q.Start];

          { Now increment the Queue position. Be sure to wrap it to zero }
          { if the Q.Start field reaches the QueueLen constant.         }
          inc(Q.Start);
          if (Q.Start = QueueLen) then
            Q.Start := 0;
        end;
    end;

    procedure SerialInterrupt; interrupt;
    { This procedure handles any incoming events from the UART. }
    var
      Id: byte;
      Trash: byte;
    begin
      repeat
        { Now read the Interrupt Identification register }
        Id := Port[PortBase + IntrId];

        { Check if there's any pending interrupt. }
        if ((Id and 1) = 0) then
          begin

            { Now select the event. }
            case ((Id and 6) shr 1) of
              $03:
                { The Line Status register changed. }
                begin
                  { Just read the LSR to clear the event. }
                  Trash := Port[PortBase + LineStatus];
                end;
              $02:
                { Data arrived at the UART. }
                begin
                  { Read out the data from the RxD register and store }
                  { it in the incoming Queue.                         }
                  Trash := Port[PortBase + RxDataReg];
                  PutQueueByte(InQueue, Trash);
                end;
              $01:
                { The TxD register is empty. }
                begin
                  { If there's any byte in the outgoing Queue, send it to the }
                  { UART, else disable this interrupt.                        }
                  if (GetQueueByte(OutQueue, Trash)) then
                    Port[PortBase + TxDataReg] := Trash
                  else
                    Port[PortBase + IntrEnable] := $0D;

                end;
              $00:
                { The Modem Status register changed. }
                begin
                  { Just read the MSR to clear the event. }
                  Trash := Port[PortBase + ModemStatus];
                end;
              end;
            end;

        { Handle all interrupts ! Just check if there's }
        { one more interrupt pending.                   }
      until ((Id and 1) = 1);

      { Now tell the PIC our interrupt handler has finished it's work. }
      SendEOI;
    end;

    procedure SendChar(C: char);
    { Send a char to the modem }
    begin
      { Put the character into the outgoing queue. }
      PutQueueByte(OutQueue, byte(C));

      { Enable the "Transmitter register empty" interrupt }
      Port[PortBase + IntrEnable] := $0F;
    end;

    const
      UART_Bad = 0;                 { Bad UART: not working or unidentifieable }
      UART_8250 = 1;                { Standart 8250 UART                       }
      UART_16450 = 2;               { 16450 UART (faster than 8250)            }
      UART_16550 = 3;               { 16550 UART (with buggy 16-byte FIFO)     }
      UART_16550A = 4;              { 16550A UART (with working FIFO)          }

    function GetUARTType(Base: word): byte; assembler;
    { Check which UART type is assigned to the appropriate port }
    asm
            { First difference: The 16450 has a scratch register which is }
            { readable and writeable. Check if it's there. If not, we've  }
            { got a 8250 UART.                                            }
            mov     dx, Base
            add     dx, ScratchReg
            mov     al, 0AAh
            out     dx, al
            in      al, dx
            cmp     al, 0AAh
            je      @@1
            mov     ax, UART_8250
            jmp     @@5
    @@1:    { Now check out if the UART has got a FIFO. If it has none, it's  }
            { a 16450, if it has one but it's not working it's a 16550.       }
            { The UART will be identified as a 16550A if the FIFO is working. }
            mov     dx, Base
            add     dx, FifoCtrl
            mov     al, 01h
            out     dx, al
            nop
            mov     dx, Base
            add     dx, IntrId
            in      al, dx
            and     al, 0C0h
            cmp     al, 0C0h
            jne     @@2
            mov     al, UART_16550A
            jmp     @@5
    @@2:    cmp     al, 80h
            jne     @@3
            mov     al, UART_16550
            jmp     @@5
    @@3:    cmp     al, 0
            jne     @@4
            mov     al, UART_16450
            jmp     @@5
    @@4:    mov     al, UART_Bad
    @@5:    nop
    end;

    procedure UpCaseStr(var S: string); assembler;
    { Convert all chars in a string to uppercase letters }
    asm
            les     di, S
            xor     cx, cx
            mov     cl, es:[di]
            inc     di
    @@1:    mov     al, es:[di]
            cmp     al, 'a'
            jb      @@2
            cmp     al, 'z'
            ja      @@2
            { Chars between 'a' and 'z' will be uppercased here. }
            sub     al, 20h
    @@2:    mov     es:[di], al
            inc     di
            loop    @@1
    end;

    function IsAllowedSpeed(Speed: longint): boolean;
    { Check if a speed is valid or not }
    var
      I: byte;
    begin
      { Return false by default. }
      IsAllowedSpeed := false;

      { Check if you can find the desired speed in the speeds table. }
      { If you found it, return "true".                              }
      for I := 0 to SpeedCount do
        if (AllowedSpeeds[I] = Speed) then
          begin
            IsAllowedSpeed := true;
            exit;
          end;

      { The default value ("false") will be returned if the speed wasn't }
      { found in the table.                                              }
    end;

    procedure GetCommandLine(var PortId: byte; var Speed: longint);
    { Check the command line and extract all parameters }
    var
      S: string;
      I: byte;
      J: integer;
    begin
      { If less than 1 parameter is specified, print a little help and }
      { terminate the programm.                                        }
      if (ParamCount <=0) THEN
         BEGIN
          writeln(' is one out of COM1, COM2, COM3 or COM4.');
          writeln(' is the desired communication speed. The default value is 9600.');
          writeln;

          { Halt the programm immediately. }
          halt;
        end;

      S := '';

      { Just create one long string from all parameters }
      for I := 1 to ParamCount do
        S := S + ParamStr(I);

      { Convert all lower-cased characters in that string to uppercased-chars }
      UpCaseStr(S);

      { The first three bytes of the string must be 'COM'. If not, }
      { there's an error in the command line.                      }
      if (copy(S, 1, 3) <> 'COM') or (S[5] <> '/') then
        begin
          writeln('Error in command line. Call TERMINAL without options to see the help text.');
          halt;
        end;

      { Extract the number of the COM port that shall be used. }
      I := byte(S[4]) - ord('0');

      { Check for it's boundaries ! }
      if (i > 4) then
        begin
          writeln('Wrong COM port specified.');
          halt;
        end
      else
        PortId := I;

      { Now extract the desired speed and check if it's a valid input. }
      val(copy(S, 6, length(S) - 5), Speed, J);
      if (J > 0) then
        begin
          writeln('Error in speed specifier.');
          halt;
        end;

      { At last, check if the desired speed is supported. }
      if (not IsAllowedSpeed(Speed)) then
        begin
          writeln('The speed you selected is not supported by this TERMINAL.');
          halt;
        end;
    end;

    procedure EnableIRQ(IRQ: byte); assembler;
    { Enable a given IRQ from 0 to 7 }
    asm
            mov     cl, IRQ
            mov     bl, 1
            shl     bl, cl
            mov     ah, 255
            sub     ah, bl
            in      al, 21h
            and     al, ah
            out     21h, al
    end;

    procedure DisableIRQ(IRQ: byte); assembler;
    { Disable a given IRQ from 0 to 7 }
    asm
            mov     cl, IRQ
            mov     bl, 1
            shl     bl, cl
            in      al, 21h
            or      al, bl
            out     21h, al
    end;

    procedure PrintChar(Character: char); assembler;
    { Print a character on the screen - fast }
    asm
            mov     ah, 0Eh
            mov     al, Character
            xor     bh, bh
            mov     bl, 07h
            int     10h
    end;

    var
      OldInterruptVec: pointer;

    procedure SetupPort(PortBase: word; Speed: longint; IRQ: byte);
    { Setup the UART and prepare for communication. }
    var
      D: word;
      B: byte;
    begin
      { For startup, disable the IRQ for the UART. }
      DisableIRQ(IRQ);

      { Get the address of the old interrupt handler and set the vector }
      { to our won interrupt handling procedure ("SerialInterrupt")     }
      OldInterruptVec := GetIntVec($08 + IRQ);
      SetIntVec($08 + IRQ, @SerialInterrupt);

      { Enable the "Recieved Data avaliable" interrupt so we can }
      { read all data out of the UART's RxD register.            }
      Port[PortBase + IntrEnable] := $01;

      { Now clear all pending interrupts - if any }
      repeat
        { Read all important registers to clear any interrupt types, }
        { B is just used for temporary result storage                }
        B := Port[PortBase + RxDataReg];
        B := Port[PortBase + LineStatus];
        B := Port[PortBase + ModemStatus];

        { Just repeat until no more interrupts are pending. }
      until ((Port[PortBase + IntrId] and 1) = 1);

      { Enable the IRQ line for the UART after all pending interrupts }
      { have been cleared.                                            }
      EnableIRQ(IRQ);

      { Calculate the divisor latch contents for the desired baud rate }
      D := (115200 div Speed);

      { Set the DLAB bit to 1, then write the divisor latch low and high bytes }
      Port[PortBase + LineCtrl] := $80;
      Port[PortBase + DivLow] := Lo(D);
      Port[PortBase + DivHigh] := Hi(D);

      { Now set the divisor latch bit to 0 and write all other values }
      Port[PortBase + LineCtrl] := $03;
      Port[PortBase + ModemCtrl] := $0B;
      Port[PortBase + IntrEnable] := $0F;

      { Check if a 16550A UART is present... }
      if (UARTType = UART_16550A) then
        begin
          { Clear the FIFO queues }
          Port[PortBase + FifoCtrl] := $07;

          { Enable the FIFO queues }
          Port[PortBase + FifoCtrl] := $C1;

          { Print a message so the user recognizes the FIFO queues are on }
          writeln('Enabling 16550A FIFO queues...');
        end;
    end;

    procedure RunTerminal(PortBase: word);
    { Run the Terminal }
    var
      B: char;
    begin
      { Just print a free line }
      Writeln;

      repeat
        { Was a key pressed ? If yes, the character is written }
        { into the outgoing queue.                             }
        if (KeyPressed) then
          begin
            { Read the key. If it was , the terminal session will }
            { be aborted, else the character will be sent out.         }
            B := ReadKey;
            if (B = #27) then
              SendChar(B);
          end
        { Is there any character in the incoming queue ? }
        else if (GetQueueByte(InQueue, byte(B))) then
          { If yes, just get the character and write it onto screen. }
          PrintChar(B);

        { Repeat this loop until the  key was pressed. }
      until (B = #27);
    end;

    procedure ResetPort(PortBase: word; IRQ: byte);
    { Reset UART and reset interrupt vectors }
    begin
      { Reset the DLAB bit. Clear all other registers. }
      Port[PortBase + LineCtrl] := Port[PortBase + LineCtrl] and $7F;
      Port[PortBase + ModemCtrl] := 0;
      Port[PortBase + IntrEnable] := 0;

      { Disable the IRQ for the UART, then restore the old interrupt vector. }
      DisableIRQ(IRQ);
      SetIntVec($08 + IRQ, OldInterruptVec);

      { Inform the user that the terminal session was aborted. }
      Writeln;
      Writeln('Port closed.');
    end;

    function Hex(W: word): TQuadString;
    { Convert a number into hexadecimal outfit }
    const
      HexChars: array[0..15] of char = '0123456789ABCDEF';
    begin
      Hex := HexChars[W shr 12] +
             HexChars[(W shr 8) and 15] +
             HexChars[(W shr 4) and 15] +
             HexChars[W and 15];
    end;

    procedure WritePortInfo;
    { Output some info about the selected port }
    begin
      write('Using COM', PortNr, ' (base address ', Hex(PortBase), ', IRQ ', UsedIRQ);
      write(', UART is a ');

      { Print the detected UART type }
      case UARTType of
        UART_8250:
          write('8250');
        UART_16450:
          write('16450');
        UART_16550:
          write('16550');
        UART_16550A:
          write('16550A');
        end;

      writeln(')...');
    end;

    {--- Main Routine ---}
    begin
      { Just output some information. }
      writeln;
      writeln('TERMINAL     Version 1.00     Written 1995 by Stephan A. Maciej');
      writeln('Internet: stephan@maciej.muc.de     http://www.muc.de/~stephanm');
      writeln;

      { Check for some correct parameters on the command line. }
      GetCommandLine(PortNr, Speed);
      PortBase := GetPortBase(PortNr);
      if (PortBase = 0) then
        begin
          writeln('COM', PortNr, ': no such port !');
          halt;
        end;
      UsedIRQ := 4 - ((PortNr - 1) and 1);
      UARTType := GetUARTType(PortBase);

      { Reset both the incoming as well as the outgoing Queue. }
      ResetQueue(InQueue);
      ResetQueue(OutQueue);

      { Write some information about the selected port. }
      WritePortInfo;

      { Setup the port, run the terminal and reset the port when ready. }
      SetupPort(PortBase, Speed, UsedIRQ);
      RunTerminal(PortBase);
      ResetPort(PortBase, UsedIRQ);
    end.

[Back to COMM SWAG index] [Back to Main SWAG index] [Original]